From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id 0E7XMS/jWF/3KQAA0tVLHw (envelope-from ) for ; Wed, 09 Sep 2020 14:14:07 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id aOW2LS/jWF8jDQAA1q6Kng (envelope-from ) for ; Wed, 09 Sep 2020 14:14:07 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id C6BB89404D2 for ; Wed, 9 Sep 2020 14:14:06 +0000 (UTC) Received: from localhost ([::1]:47832 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kG0rN-0000Zs-C4 for larch@yhetil.org; Wed, 09 Sep 2020 10:14:05 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:45060) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kG0mx-0003xu-Mm for emacs-orgmode@gnu.org; Wed, 09 Sep 2020 10:09:31 -0400 Received: from mail-qk1-x743.google.com ([2607:f8b0:4864:20::743]:43735) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kG0mt-0001tq-B9; Wed, 09 Sep 2020 10:09:31 -0400 Received: by mail-qk1-x743.google.com with SMTP id o16so2488157qkj.10; Wed, 09 Sep 2020 07:09:26 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:in-reply-to:references:date:message-id :mime-version; bh=JpXba4fLdWz2CzdkYtWI2CUi8EdY78rDIuUce7h3qGI=; b=egrk9lvzUSFREwSKCo2AJSdrN/xuizMol5kHr+xRvmtE5EYcpxEA66uW5U7CSFd1gm p4Y43awDJYcrlfmzulDf6BR/XQY/g0NDVeDFIExamQI9uczY90JX+KqmomebUshTObc7 c/6cdH5xYw2CzbcmGA0Ry8pWjttupFjpjhkhKqGKBuuBIEq2ZwKwF8Q1dNJtKyNQTqyy 1t18vM8ZSvCfDWOGs4VRZ5yWJ3ZFJODcZwTJpf0NVDl8rQhBaWkCz8D0vhl+iC/aPRDN IstGvIRZnaEJPJJRw3FMRcLCG/eimJG+QwqzUGXxl6thgxh5rmXT/F+i3nb8oF9uIl22 lcow== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references:date :message-id:mime-version; bh=JpXba4fLdWz2CzdkYtWI2CUi8EdY78rDIuUce7h3qGI=; b=VAt7Gqz7eRy4+BU0JPkMJ+tdDfns/T14xIg9wt3RKwWzGR+nc65FPQF6lwtiu+ZgHN 6mzJ/iWQRlOqDqcrFdBxkQLKhB2b9HxLrlIlgaO9ExJP+uZ0Bblxwc4UGefJ7qkaLZ2J jD2Jzuwd1H//pS0nm5hxy9NzYwYeV05KY/fKvIsnFxIw0hxfPUs0OC4d3VvmhYfcxSlQ 6BbLmIYrAEjOA80vaogwowKUcfLR4FYk6KyS8Meuye+X2QqQlQmLVFfriAx6gHuc0UnT NcUrVcWZAa9v0pawvbfLegYmnfmkLc634QSsEB1JOWd1/ulaLERu8r5UwC8QsXnJGfbC QGJw== X-Gm-Message-State: AOAM5335COojj7wZfPawv1LYf7EuxRwSrgRCpTQRQMNsa+MwPKamzx/5 nB7NsvLjpnKGzU7aB6QUzYn/uIp0qzXT1g== X-Google-Smtp-Source: ABdhPJzkpL1yxkk+QbkCuGr3w3Rivrx6u+a3f6nVYYLzGmhHxRDNYctW3pFo/3VBTn2urYGbvcQm4Q== X-Received: by 2002:a05:620a:148:: with SMTP id e8mr3525368qkn.186.1599660565450; Wed, 09 Sep 2020 07:09:25 -0700 (PDT) Received: from localhost (wholesomeserver.media.mit.edu. [18.27.197.252]) by smtp.googlemail.com with ESMTPSA id k20sm3107696qtb.34.2020.09.09.07.09.21 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 09 Sep 2020 07:09:24 -0700 (PDT) From: akater To: Bastien Subject: Re: [PATCH] org-element: Hide parsers boilerplate into plist-creating macros In-Reply-To: <87r1rbl4ll.fsf@gnu.org> References: <87imco6vaj.fsf@gmail.com> <87r1rbl4ll.fsf@gnu.org> Date: Wed, 09 Sep 2020 13:59:20 +0000 Message-ID: <87eenb6og7.fsf@gmail.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=2607:f8b0:4864:20::743; envelope-from=nuclearspace@gmail.com; helo=mail-qk1-x743.google.com X-detected-operating-system: by eggs.gnu.org: No matching host in p0f cache. That's all we know. X-Spam_score_int: -7 X-Spam_score: -0.8 X-Spam_bar: / X-Spam_report: (-0.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_BL_SPAMCOP_NET=1.347, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=no autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: emacs-orgmode@gnu.org Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20161025 header.b=egrk9lvz; dmarc=pass (policy=none) header.from=gmail.com; spf=pass (aspmx1.migadu.com: domain of emacs-orgmode-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=emacs-orgmode-bounces@gnu.org X-Spam-Score: 0.19 X-TUID: cYZtzHjFs2Fo --=-=-= Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" --==-=-= Content-Type: text/plain Bastien writes: > IIUC this is a refactoring, it does not add or remove functionalities? Yes, just a refactoring. A typo crept into comments and help pages, so here's an update. --==-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIcBAEBCgAGBQJfWN/EAAoJELK+sWGx7H9E/9EQAMpRcsauEQU1w3sqb3gpyIP4 J0u/KQ40PwQQ9qWqgRMpCSYz5SPBrDTj7op680murVdErVzjIIuqi0PW8OFB2WgG SbtbniJVeahgSqC/AVYOecl3eQ4ekotkbY2fCAx0YsY6wwKAqskxO9lR7Wgba4kY GPwVJGJOTu/475VWfBwHTZQc26zwuXHWGeJYFJ2Z8wSW9247jxvyjoqipMVd4T5F gTc4Wk1WixfArq7kn/9qKY3elU3yvAB1hG/ELJ/7LFR2F5Z8DkKOZEfYDGY2th4F z5S6gYaTHuoA4xHqzYHg/fGQgY/N23oWWnqgeCPaMPdbGJZHp/3VGaCvj3tvehLI Hh3e6izQDdlUr0hNllkg/gSy7iEvAcvUhRHOVLDHE/tKayM8kDDX+cqJQnM8sq0A xiNSnEp5K9I+7JElKwwMdZr2c1ZicDj3fb9bhgMJ7cn8yUoGyR7jEjtZxWP6jVtf f1coAVzeayCvym8r5zoNIF5MF+A/KlCkWvqBsP3NeyxQcR3ppOCP8m7ybdFDzZr4 lAN/11hcFtpidWpMHCQRW+u/+2dOIzcrpzXeMWfGRLuIxGSNr/1BpxVwTM7hi9X0 GTasfyIegXkQq+LRoTutHv6dQPSC1TyXoLq22AuM4rJ7mXXWf8dttH9DdqKo4sCW VHTNjgFTd5QJ4LpmAdpJ =AoFe -----END PGP SIGNATURE----- --==-=-=-- --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-org-element-Hide-parsers-boilerplate-into-plist-crea.patch Content-Description: org-element boilerplate removal, with typo fixed >From 0636f032b3c7e60221c28aeea91cce58376561dd Mon Sep 17 00:00:00 2001 From: akater Date: Thu, 16 Apr 2020 02:25:59 +0000 Subject: [PATCH] org-element: Hide parsers boilerplate into plist-creating macros * lisp/org-element.el (org-prog-plist, org-let*-prog-plists) (org-let*-prog-plist): New macros. Build plists without boilerplate. (org-fold, org-dekeyword): New functions. Dependencies for the above. * lisp/org-element.el (org-element-center-block-parser) (org-element-drawer-parser, org-element-dynamic-block-parser) (org-element-footnote-definition-parser) (org-element-plain-list-parser, org-element-property-drawer-parser) (org-element-quote-block-parser, org-element-section-parser) (org-element-special-block-parser, org-element-babel-call-parser) (org-element-clock-parser, org-element-comment-parser) (org-element-comment-block-parser, org-element-diary-sexp-parser) (org-element-example-block-parser, org-element-export-block-parser) (org-element-fixed-width-parser, org-element-horizontal-rule-parser) (org-element-keyword-parser, org-element-latex-environment-parser) (org-element-node-property-parser, org-element-paragraph-parser) (org-element-planning-parser, org-element-src-block-parser) (org-element-table-parser, org-element-table-row-parser) (org-element-verse-block-parser, org-element-entity-parser) (org-element-footnote-reference-parser, org-element-inline-babel-call-parser) (org-element-inline-src-block-parser, org-element-latex-fragment-parser) (org-element-link-parser): Use org-prog-plist to build plist (org-element-headline-parser, org-element-inlinetask-parser) (org-element-item-parser, org-element-timestamp-parser): Use org-let*-prog-plist to build plist (org-element-radio-target-parser, org-element-statistics-cookie-parser) (org-element-subscript-parser, org-element-superscript-parser) (org-element-table-cell-parser, org-element-target-parser) (org-element-underline-parser, org-element-verbatim-parser): Use just #'list to build plist (org-element-comment-block-parser): Fix a typo in docstring. --- lisp/org-element.el | 2584 +++++++++++++++++++------------------------ lisp/org-macs.el | 259 +++++ 2 files changed, 1421 insertions(+), 1422 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index a693cb68d..e40f881b9 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -691,29 +691,26 @@ Assume point is at the beginning of the block." (re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (let ((block-end-line (match-beginning 0))) - (let* ((begin (car affiliated)) - (post-affiliated (point)) + (list 'center-block + (nconc + (org-prog-plist + block-end-line (match-beginning 0) + :begin (car affiliated) + :post-affiliated (point) ;; Empty blocks have no contents. - (contents-begin (progn (forward-line) + :contents-begin (progn (forward-line) (and (< (point) block-end-line) - (point)))) - (contents-end (and contents-begin block-end-line)) - (pos-before-blank (progn (goto-char block-end-line) - (forward-line) - (point))) - (end (save-excursion + (point))) + :contents-end (and contents-begin block-end-line) + pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point)) + :end (save-excursion (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'center-block - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))))) + (if (eobp) (point) + (line-beginning-position))) + :post-blank (count-lines pos-before-blank end)) + (cdr affiliated)))))) (defun org-element-center-block-interpreter (_ contents) "Interpret a center-block element as Org syntax. @@ -740,32 +737,28 @@ Assume point is at beginning of drawer." (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) ;; Incomplete drawer: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (save-excursion - (let* ((drawer-end-line (match-beginning 0)) - (name (progn (looking-at org-drawer-regexp) - (match-string-no-properties 1))) - (begin (car affiliated)) - (post-affiliated (point)) - ;; Empty drawers have no contents. - (contents-begin (progn (forward-line) - (and (< (point) drawer-end-line) - (point)))) - (contents-end (and contents-begin drawer-end-line)) - (pos-before-blank (progn (goto-char drawer-end-line) - (forward-line) + (list + 'drawer + (nconc + (save-excursion + (org-prog-plist + drawer-end-line (match-beginning 0) + :drawer-name (progn (looking-at org-drawer-regexp) + (match-string-no-properties 1)) + :begin (car affiliated) + :post-affiliated (point) + ;; Empty drawers have no contents. + :contents-begin (progn (forward-line) + (and (< (point) drawer-end-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'drawer - (nconc - (list :begin begin - :end end - :drawer-name name - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))))) + :contents-end (and contents-begin drawer-end-line) + pos-before-blank (progn (goto-char drawer-end-line) + (forward-line) + (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines pos-before-blank end))) + (cdr affiliated)))))) (defun org-element-drawer-interpreter (drawer contents) "Interpret DRAWER element as Org syntax. @@ -796,34 +789,28 @@ Assume point is at beginning of dynamic block." (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (let ((block-end-line (match-beginning 0))) - (save-excursion - (let* ((name (progn (looking-at org-dblock-start-re) - (match-string-no-properties 1))) - (arguments (match-string-no-properties 3)) - (begin (car affiliated)) - (post-affiliated (point)) + (list 'dynamic-block + (nconc + (save-excursion + (org-prog-plist + block-end-line (match-beginning 0) + :block-name (progn (looking-at org-dblock-start-re) + (match-string-no-properties 1)) + :arguments (match-string-no-properties 3) + :begin (car affiliated) + :post-affiliated (point) ;; Empty blocks have no contents. - (contents-begin (progn (forward-line) + :contents-begin (progn (forward-line) (and (< (point) block-end-line) - (point)))) - (contents-end (and contents-begin block-end-line)) - (pos-before-blank (progn (goto-char block-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'dynamic-block - (nconc - (list :begin begin - :end end - :block-name name - :arguments arguments - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (point))) + :contents-end (and contents-begin block-end-line) + pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines pos-before-blank end))) + (cdr affiliated)))))) (defun org-element-dynamic-block-interpreter (dynamic-block contents) "Interpret DYNAMIC-BLOCK element as Org syntax. @@ -857,54 +844,49 @@ a plist containing `:label', `:begin' `:end', `:contents-begin', `:post-affiliated' keywords. Assume point is at the beginning of the footnote definition." - (save-excursion - (let* ((label (progn (looking-at org-footnote-definition-re) - (match-string-no-properties 1))) - (begin (car affiliated)) - (post-affiliated (point)) - (end - (save-excursion - (end-of-line) - (cond - ((not - (re-search-forward org-element--footnote-separator limit t)) - limit) - ((eq ?\[ (char-after (match-beginning 0))) - ;; At a new footnote definition, make sure we end - ;; before any affiliated keyword above. - (forward-line -1) - (while (and (> (point) post-affiliated) - (looking-at-p org-element--affiliated-re)) - (forward-line -1)) - (line-beginning-position 2)) - ((eq ?* (char-after (match-beginning 0))) (match-beginning 0)) - (t (skip-chars-forward " \r\t\n" limit) - (if (= limit (point)) limit (line-beginning-position)))))) - (pre-blank 0) - (contents-begin - (progn (search-forward "]") - (skip-chars-forward " \r\t\n" end) - (cond ((= (point) end) nil) - ((= (line-beginning-position) post-affiliated) (point)) - (t - (setq pre-blank - (count-lines (line-beginning-position) begin)) - (line-beginning-position))))) - (contents-end - (progn (goto-char end) - (skip-chars-backward " \r\t\n") - (line-beginning-position 2)))) - (list 'footnote-definition - (nconc - (list :label label - :begin begin - :end end - :contents-begin contents-begin - :contents-end (and contents-begin contents-end) - :pre-blank pre-blank - :post-blank (count-lines contents-end end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (list + 'footnote-definition + (nconc + (save-excursion + (org-prog-plist + :label (progn (looking-at org-footnote-definition-re) + (match-string-no-properties 1)) + :begin (car affiliated) + :post-affiliated (point) + :end + (save-excursion + (end-of-line) + (cond + ((not + (re-search-forward org-element--footnote-separator limit t)) + limit) + ((eq ?\[ (char-after (match-beginning 0))) + ;; At a new footnote definition, make sure we end + ;; before any affiliated keyword above. + (forward-line -1) + (while (and (> (point) post-affiliated) + (looking-at-p org-element--affiliated-re)) + (forward-line -1)) + (line-beginning-position 2)) + ((eq ?* (char-after (match-beginning 0))) (match-beginning 0)) + (t (skip-chars-forward " \r\t\n" limit) + (if (= limit (point)) limit (line-beginning-position))))) + :pre-blank 0 + :contents-begin + (progn (search-forward "]") + (skip-chars-forward " \r\t\n" end) + (cond ((= (point) end) nil) + ((= (line-beginning-position) post-affiliated) (point)) + (t + (setq pre-blank + (count-lines (line-beginning-position) begin)) + (line-beginning-position)))) + :contents-end (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)) + :contents-end (and contents-begin contents-end) + :post-blank (count-lines contents-end end))) + (cdr affiliated)))) (defun org-element-footnote-definition-interpreter (footnote-definition contents) "Interpret FOOTNOTE-DEFINITION element as Org syntax. @@ -983,72 +965,59 @@ parsed as a secondary string, but as a plain string instead. Assume point is at beginning of the headline." (save-excursion - (let* ((begin (point)) - (level (prog1 (org-reduced-level (skip-chars-forward "*")) - (skip-chars-forward " \t"))) - (todo (and org-todo-regexp - (let (case-fold-search) (looking-at (concat org-todo-regexp " "))) - (progn (goto-char (match-end 0)) - (skip-chars-forward " \t") - (match-string 1)))) - (todo-type - (and todo (if (member todo org-done-keywords) 'done 'todo))) - (priority (and (looking-at "\\[#.\\][ \t]*") - (progn (goto-char (match-end 0)) - (aref (match-string 0) 2)))) - (commentedp - (and (let (case-fold-search) (looking-at org-comment-string)) - (goto-char (match-end 0)))) - (title-start (point)) - (tags (when (re-search-forward - "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" - (line-end-position) - 'move) - (goto-char (match-beginning 0)) - (org-split-string (match-string 1) ":"))) - (title-end (point)) - (raw-value (org-trim - (buffer-substring-no-properties title-start title-end))) - (archivedp (member org-archive-tag tags)) - (footnote-section-p (and org-footnote-section - (string= org-footnote-section raw-value))) - (standard-props (org-element--get-node-properties)) - (time-props (org-element--get-time-properties)) - (end (min (save-excursion (org-end-of-subtree t t)) limit)) - (contents-begin (save-excursion - (forward-line) - (skip-chars-forward " \r\t\n" end) - (and (/= (point) end) (line-beginning-position)))) - (contents-end (and contents-begin - (progn (goto-char end) - (skip-chars-backward " \r\t\n") - (line-beginning-position 2))))) + (org-let*-prog-plist + (plist + :begin (point) + :level (prog1 (org-reduced-level (skip-chars-forward "*")) + (skip-chars-forward " \t")) + todo (and org-todo-regexp + (let (case-fold-search) + (looking-at (concat org-todo-regexp " "))) + (progn (goto-char (match-end 0)) + (skip-chars-forward " \t") + (match-string 1))) + :todo-type + (and todo (if (member todo org-done-keywords) 'done 'todo)) + :priority (and (looking-at "\\[#.\\][ \t]*") + (progn (goto-char (match-end 0)) + (aref (match-string 0) 2))) + :commentedp + (and (let (case-fold-search) (looking-at org-comment-string)) + (goto-char (match-end 0))) + title-start (point) + :tags (when (re-search-forward + "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" + (line-end-position) + 'move) + (goto-char (match-beginning 0)) + (org-split-string (match-string 1) ":")) + title-end (point) + :raw-value (org-trim + (buffer-substring-no-properties title-start title-end)) + :archivedp (member org-archive-tag tags) + :footnote-section-p (and org-footnote-section + (string= org-footnote-section raw-value)) + standard-props (org-element--get-node-properties) + time-props (org-element--get-time-properties) + :end (min (save-excursion (org-end-of-subtree t t)) limit) + :contents-begin (save-excursion + (forward-line) + (skip-chars-forward " \r\t\n" end) + (and (/= (point) end) + (line-beginning-position))) + :contents-end (and contents-begin + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2))) + :pre-blank (if (not contents-begin) 0 + (1- (count-lines begin contents-begin))) + :todo-keyword todo + :post-blank (if contents-end + (count-lines contents-end end) + (1- (count-lines begin end))) + :post-affiliated begin) (let ((headline - (list 'headline - (nconc - (list :raw-value raw-value - :begin begin - :end end - :pre-blank - (if (not contents-begin) 0 - (1- (count-lines begin contents-begin))) - :contents-begin contents-begin - :contents-end contents-end - :level level - :priority priority - :tags tags - :todo-keyword todo - :todo-type todo-type - :post-blank - (if contents-end - (count-lines contents-end end) - (1- (count-lines begin end))) - :footnote-section-p footnote-section-p - :archivedp archivedp - :commentedp commentedp - :post-affiliated begin) - time-props - standard-props)))) + (list 'headline (nconc plist time-props standard-props)))) (org-element-put-property headline :title (if raw-secondary-p raw-value @@ -1129,80 +1098,70 @@ string instead. Assume point is at beginning of the inline task." (save-excursion - (let* ((begin (point)) - (level (prog1 (org-reduced-level (skip-chars-forward "*")) - (skip-chars-forward " \t"))) - (todo (and org-todo-regexp - (let (case-fold-search) (looking-at org-todo-regexp)) - (progn (goto-char (match-end 0)) - (skip-chars-forward " \t") - (match-string 0)))) - (todo-type (and todo - (if (member todo org-done-keywords) 'done 'todo))) - (priority (and (looking-at "\\[#.\\][ \t]*") - (progn (goto-char (match-end 0)) - (aref (match-string 0) 2)))) - (title-start (point)) - (tags (when (re-search-forward - "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" - (line-end-position) - 'move) - (goto-char (match-beginning 0)) - (org-split-string (match-string 1) ":"))) - (title-end (point)) - (raw-value (org-trim - (buffer-substring-no-properties title-start title-end))) - (task-end (save-excursion - (end-of-line) - (and (re-search-forward org-outline-regexp-bol limit t) - (looking-at-p "[ \t]*END[ \t]*$") - (line-beginning-position)))) - (standard-props (and task-end (org-element--get-node-properties))) - (time-props (and task-end (org-element--get-time-properties))) - (contents-begin (and task-end - (< (point) task-end) - (progn - (forward-line) - (skip-chars-forward " \t\n") - (line-beginning-position)))) - (contents-end (and contents-begin task-end)) - (end (progn (when task-end (goto-char task-end)) - (forward-line) - (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position)))) - (inlinetask - (list 'inlinetask - (nconc - (list :raw-value raw-value - :begin begin - :end end - :pre-blank - (if (not contents-begin) 0 - (1- (count-lines begin contents-begin))) - :contents-begin contents-begin - :contents-end contents-end - :level level - :priority priority - :tags tags - :todo-keyword todo - :todo-type todo-type - :post-blank (1- (count-lines (or task-end begin) end)) - :post-affiliated begin) - time-props - standard-props)))) - (org-element-put-property - inlinetask :title - (if raw-secondary-p raw-value - (org-element--parse-objects - (progn (goto-char title-start) - (skip-chars-forward " \t") - (point)) - (progn (goto-char title-end) - (skip-chars-backward " \t") - (point)) - nil - (org-element-restriction 'inlinetask) - inlinetask)))))) + (org-let*-prog-plist + (plist + :begin (point) + :level (prog1 (org-reduced-level (skip-chars-forward "*")) + (skip-chars-forward " \t")) + :todo (and org-todo-regexp + (let (case-fold-search) (looking-at org-todo-regexp)) + (progn (goto-char (match-end 0)) + (skip-chars-forward " \t") + (match-string 0))) + :todo-type (and todo + (if (member todo org-done-keywords) 'done 'todo)) + :priority (and (looking-at "\\[#.\\][ \t]*") + (progn (goto-char (match-end 0)) + (aref (match-string 0) 2))) + title-start (point) + :tags (when (re-search-forward + "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" + (line-end-position) + 'move) + (goto-char (match-beginning 0)) + (org-split-string (match-string 1) ":")) + title-end (point) + :raw-value (org-trim + (buffer-substring-no-properties title-start title-end)) + :task-end (save-excursion + (end-of-line) + (and (re-search-forward org-outline-regexp-bol limit t) + (looking-at-p "[ \t]*END[ \t]*$") + (line-beginning-position))) + standard-props (and task-end + (org-element--get-node-properties)) + time-props (and task-end (org-element--get-time-properties)) + :contents-begin (and task-end + (< (point) task-end) + (progn + (forward-line) + (skip-chars-forward " \t\n") + (line-beginning-position))) + :contents-end (and contents-begin task-end) + :end (progn (when task-end (goto-char task-end)) + (forward-line) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :pre-blank (if (not contents-begin) 0 + (1- (count-lines begin contents-begin))) + :todo-keyword todo + :post-blank (1- (count-lines (or task-end begin) end)) + :post-affiliated begin) + (let ((inlinetask + (list 'inlinetask (nconc plist time-props standard-props)))) + (org-element-put-property + inlinetask :title + (if raw-secondary-p raw-value + (org-element--parse-objects + (progn (goto-char title-start) + (skip-chars-forward " \t") + (point)) + (progn (goto-char title-end) + (skip-chars-backward " \t") + (point)) + nil + (org-element-restriction 'inlinetask) + inlinetask))))))) (defun org-element-inlinetask-interpreter (inlinetask contents) "Interpret INLINETASK element as Org syntax. @@ -1262,68 +1221,61 @@ Assume point is at the beginning of the item." (save-excursion (beginning-of-line) (looking-at org-list-full-item-re) - (let* ((begin (point)) - (bullet (match-string-no-properties 1)) - (checkbox (let ((box (match-string 3))) - (cond ((equal "[ ]" box) 'off) - ((equal "[X]" box) 'on) - ((equal "[-]" box) 'trans)))) - (counter (let ((c (match-string 2))) - (save-match-data - (cond - ((not c) nil) - ((string-match "[A-Za-z]" c) - (- (string-to-char (upcase (match-string 0 c))) - 64)) - ((string-match "[0-9]+" c) - (string-to-number (match-string 0 c))))))) - (end (progn (goto-char (nth 6 (assq (point) struct))) - (if (bolp) (point) (line-beginning-position 2)))) - (pre-blank 0) - (contents-begin - (progn - (goto-char - ;; Ignore tags in un-ordered lists: they are just - ;; a part of item's body. - (if (and (match-beginning 4) - (save-match-data (string-match "[.)]" bullet))) - (match-beginning 4) - (match-end 0))) - (skip-chars-forward " \r\t\n" end) - (cond ((= (point) end) nil) - ;; If first line isn't empty, contents really - ;; start at the text after item's meta-data. - ((= (line-beginning-position) begin) (point)) - (t - (setq pre-blank - (count-lines (line-beginning-position) begin)) - (line-beginning-position))))) - (contents-end (and contents-begin - (progn (goto-char end) - (skip-chars-backward " \r\t\n") - (line-beginning-position 2)))) - (item - (list 'item - (list :bullet bullet - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :checkbox checkbox - :counter counter - :structure struct - :pre-blank pre-blank - :post-blank (count-lines (or contents-end begin) end) - :post-affiliated begin)))) - (org-element-put-property - item :tag - (let ((raw (org-list-get-tag begin struct))) - (when raw - (if raw-secondary-p raw - (org-element--parse-objects - (match-beginning 4) (match-end 4) nil - (org-element-restriction 'item) - item)))))))) + (org-let*-prog-plist + (plist + :begin (point) + :bullet (match-string-no-properties 1) + :checkbox (let ((box (match-string 3))) + (cond ((equal "[ ]" box) 'off) + ((equal "[X]" box) 'on) + ((equal "[-]" box) 'trans))) + :counter (let ((c (match-string 2))) + (save-match-data + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string 0 c)))))) + :end (progn (goto-char (nth 6 (assq (point) struct))) + (if (bolp) (point) (line-beginning-position 2))) + :pre-blank 0 + :contents-begin + (progn + (goto-char + ;; Ignore tags in un-ordered lists: they are just + ;; a part of item's body. + (if (and (match-beginning 4) + (save-match-data (string-match "[.)]" bullet))) + (match-beginning 4) + (match-end 0))) + (skip-chars-forward " \r\t\n" end) + (cond ((= (point) end) nil) + ;; If first line isn't empty, contents really + ;; start at the text after item's meta-data. + ((= (line-beginning-position) begin) (point)) + (t + (setq pre-blank + (count-lines (line-beginning-position) begin)) + (line-beginning-position)))) + :contents-end (and contents-begin + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2))) + :structure struct + :post-blank (count-lines (or contents-end begin) end) + :post-affiliated begin) + (let ((item (list 'item plist))) + (org-element-put-property + item :tag + (let ((raw (org-list-get-tag begin struct))) + (when raw + (if raw-secondary-p raw + (org-element--parse-objects + (match-beginning 4) (match-end 4) nil + (org-element-restriction 'item) + item))))))))) (defun org-element-item-interpreter (item contents) "Interpret ITEM element as Org syntax. @@ -1463,35 +1415,30 @@ containing `:type', `:begin', `:end', `:contents-begin' and `:post-affiliated' keywords. Assume point is at the beginning of the list." - (save-excursion - (let* ((struct (or structure (org-element--list-struct limit))) - (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered) - ((nth 5 (assq (point) struct)) 'descriptive) - (t 'unordered))) - (contents-begin (point)) - (begin (car affiliated)) - (contents-end (let* ((item (assq contents-begin struct)) - (ind (nth 1 item)) - (pos (nth 6 item))) - (while (and (setq item (assq pos struct)) - (= (nth 1 item) ind)) - (setq pos (nth 6 item))) - pos)) - (end (progn (goto-char contents-end) - (skip-chars-forward " \r\t\n" limit) - (if (= (point) limit) limit (line-beginning-position))))) - ;; Return value. - (list 'plain-list - (nconc - (list :type type - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :structure struct - :post-blank (count-lines contents-end end) - :post-affiliated contents-begin) - (cdr affiliated)))))) + (list 'plain-list + (nconc + (save-excursion + (org-prog-plist + struct (or structure (org-element--list-struct limit)) + :type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered) + ((nth 5 (assq (point) struct)) 'descriptive) + (t 'unordered)) + :contents-begin (point) + :begin (car affiliated) + :contents-end (let* ((item (assq contents-begin struct)) + (ind (nth 1 item)) + (pos (nth 6 item))) + (while (and (setq item (assq pos struct)) + (= (nth 1 item) ind)) + (setq pos (nth 6 item))) + pos) + :end (progn (goto-char contents-end) + (skip-chars-forward " \r\t\n" limit) + (if (= (point) limit) limit (line-beginning-position))) + :structure struct + :post-blank (count-lines contents-end end) + :post-affiliated contents-begin)) + (cdr affiliated)))) (defun org-element-plain-list-interpreter (_ contents) "Interpret plain-list element as Org syntax. @@ -1515,23 +1462,21 @@ containing `:begin', `:end', `:contents-begin', `:contents-end', `:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the property drawer." - (save-excursion - (let ((case-fold-search t) - (begin (point)) - (contents-begin (line-beginning-position 2))) - (re-search-forward "^[ \t]*:END:[ \t]*$" limit t) - (let ((contents-end (and (> (match-beginning 0) contents-begin) - (match-beginning 0))) - (before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'property-drawer - (list :begin begin - :end end - :contents-begin (and contents-end contents-begin) - :contents-end contents-end - :post-blank (count-lines before-blank end) - :post-affiliated begin)))))) + (list 'property-drawer + (save-excursion + (org-prog-plist + case-fold-search t + :begin (point) + contents-begin (line-beginning-position 2) + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t) + :contents-end (and (> (match-beginning 0) contents-begin) + (match-beginning 0)) + before-blank (progn (forward-line) (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :contents-begin (and contents-end contents-begin) + :post-blank (count-lines before-blank end) + :post-affiliated begin)))) (defun org-element-property-drawer-interpreter (_ contents) "Interpret property-drawer element as Org syntax. @@ -1559,29 +1504,25 @@ Assume point is at the beginning of the block." (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (let ((block-end-line (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - ;; Empty blocks have no contents. - (contents-begin (progn (forward-line) - (and (< (point) block-end-line) - (point)))) - (contents-end (and contents-begin block-end-line)) - (pos-before-blank (progn (goto-char block-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'quote-block - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (list 'quote-block + (nconc + (let ((block-end-line (match-beginning 0))) + (save-excursion + (org-prog-plist + :begin (car affiliated) + :post-affiliated (point) + ;; Empty blocks have no contents. + :contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point))) + :contents-end (and contents-begin block-end-line) + pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines pos-before-blank end)))) + (cdr affiliated)))))) (defun org-element-quote-block-interpreter (_ contents) "Interpret quote-block element as Org syntax. @@ -1597,21 +1538,21 @@ CONTENTS is the contents of the element." Return a list whose CAR is `section' and CDR is a plist containing `:begin', `:end', `:contents-begin', `contents-end', `:post-blank' and `:post-affiliated' keywords." - (save-excursion - ;; Beginning of section is the beginning of the first non-blank - ;; line after previous headline. - (let ((begin (point)) - (end (progn (org-with-limited-levels (outline-next-heading)) - (point))) - (pos-before-blank (progn (skip-chars-backward " \r\t\n") - (line-beginning-position 2)))) - (list 'section - (list :begin begin - :end end - :contents-begin begin - :contents-end pos-before-blank - :post-blank (count-lines pos-before-blank end) - :post-affiliated begin))))) + (list 'section + (save-excursion + (org-prog-plist + ;; Beginning of section is the beginning of the first non-blank + ;; line after previous headline + :begin (point) + :end (progn + (org-with-limited-levels (outline-next-heading)) + (point)) + pos-before-blank (progn (skip-chars-backward " \r\t\n") + (line-beginning-position 2)) + :contents-begin begin + :contents-end pos-before-blank + :post-blank (count-lines pos-before-blank end) + :post-affiliated begin)))) (defun org-element-section-interpreter (_ contents) "Interpret section element as Org syntax. @@ -1644,29 +1585,25 @@ Assume point is at the beginning of the block." ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) (let ((block-end-line (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - ;; Empty blocks have no contents. - (contents-begin (progn (forward-line) - (and (< (point) block-end-line) - (point)))) - (contents-end (and contents-begin block-end-line)) - (pos-before-blank (progn (goto-char block-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'special-block - (nconc - (list :type type - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (list 'special-block + (nconc + (save-excursion + (org-prog-plist + :type type + :begin (car affiliated) + :post-affiliated (point) + ;; Empty blocks have no contents. + :contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point))) + :contents-end (and contents-begin block-end-line) + pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines pos-before-blank end))) + (cdr affiliated))))))) (defun org-element-special-block-interpreter (special-block contents) "Interpret SPECIAL-BLOCK element as Org syntax. @@ -1701,42 +1638,36 @@ Return a list whose car is `babel-call' and cdr is a plist containing `:call', `:inside-header', `:arguments', `:end-header', `:begin', `:end', `:value', `:post-blank' and `:post-affiliated' as keywords." - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - (before-blank (line-beginning-position 2)) - (value (progn (search-forward ":" before-blank t) - (skip-chars-forward " \t") - (org-trim - (buffer-substring-no-properties - (point) (line-end-position))))) - (call - (or (org-string-nw-p - (buffer-substring-no-properties - (point) (progn (skip-chars-forward "^[]()" before-blank) - (point)))))) - (inside-header (org-element--parse-paired-brackets ?\[)) - (arguments (org-string-nw-p - (org-element--parse-paired-brackets ?\())) - (end-header - (org-string-nw-p - (org-trim - (buffer-substring-no-properties (point) (line-end-position))))) - (end (progn (forward-line) - (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'babel-call - (nconc - (list :call call - :inside-header inside-header - :arguments arguments - :end-header end-header - :begin begin - :end end - :value value - :post-blank (count-lines before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (list 'babel-call + (nconc + (save-excursion + (org-prog-plist + :begin (car affiliated) + :post-affiliated (point) + before-blank (line-beginning-position 2) + :value (progn (search-forward ":" before-blank t) + (skip-chars-forward " \t") + (org-trim + (buffer-substring-no-properties + (point) (line-end-position)))) + :call + (or (org-string-nw-p + (buffer-substring-no-properties + (point) (progn (skip-chars-forward "^[]()" before-blank) + (point))))) + :inside-header (org-element--parse-paired-brackets ?\[) + :arguments (org-string-nw-p + (org-element--parse-paired-brackets ?\()) + :end-header + (org-string-nw-p + (org-trim + (buffer-substring-no-properties (point) (line-end-position)))) + :end (progn (forward-line) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) + (line-beginning-position))) + :post-blank (count-lines before-blank end))) + (cdr affiliated)))) (defun org-element-babel-call-interpreter (babel-call _) "Interpret BABEL-CALL element as Org syntax." @@ -1759,31 +1690,26 @@ LIMIT bounds the search. Return a list whose CAR is `clock' and CDR is a plist containing `:status', `:value', `:time', `:begin', `:end', `:post-blank' and `:post-affiliated' as keywords." - (save-excursion - (let* ((case-fold-search nil) - (begin (point)) - (value (progn (search-forward "CLOCK:" (line-end-position) t) - (skip-chars-forward " \t") - (org-element-timestamp-parser))) - (duration (and (search-forward " => " (line-end-position) t) - (progn (skip-chars-forward " \t") - (looking-at "\\(\\S-+\\)[ \t]*$")) - (match-string-no-properties 1))) - (status (if duration 'closed 'running)) - (post-blank (let ((before-blank (progn (forward-line) (point)))) - (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (unless (bolp) (end-of-line)) - (count-lines before-blank (point)))) - (end (point))) - (list 'clock - (list :status status - :value value - :duration duration - :begin begin - :end end - :post-blank post-blank - :post-affiliated begin))))) + (list 'clock + (save-excursion + (org-prog-plist + case-fold-search nil + :begin (point) + :value (progn (search-forward "CLOCK:" (line-end-position) t) + (skip-chars-forward " \t") + (org-element-timestamp-parser)) + :duration (and (search-forward " => " (line-end-position) t) + (progn (skip-chars-forward " \t") + (looking-at "\\(\\S-+\\)[ \t]*$")) + (match-string-no-properties 1)) + :status (if duration 'closed 'running) + :post-blank (let ((before-blank (progn (forward-line) (point)))) + (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (unless (bolp) (end-of-line)) + (count-lines before-blank (point))) + :end (point) + :post-affiliated begin)))) (defun org-element-clock-interpreter (clock _) "Interpret CLOCK element as Org syntax." @@ -1810,13 +1736,15 @@ containing `:begin', `:end', `:value', `:post-blank', `:post-affiliated' keywords. Assume point is at comment beginning." - (save-excursion - (let* ((begin (point)) - (value (prog2 (looking-at "[ \t]*# ?") - (buffer-substring-no-properties - (match-end 0) (line-end-position)) - (forward-line))) - (com-end + (list 'comment + (save-excursion + (org-prog-plist + :begin (point) + :value (prog2 (looking-at "[ \t]*# ?") + (buffer-substring-no-properties + (match-end 0) (line-end-position)) + (forward-line)) + com-end ;; Get comments ending. (progn (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)")) @@ -1828,16 +1756,12 @@ Assume point is at comment beginning." (buffer-substring-no-properties (match-end 0) (line-end-position)))) (forward-line)) - (point))) - (end (progn (goto-char com-end) - (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'comment - (list :begin begin - :end end - :value value - :post-blank (count-lines com-end end) - :post-affiliated begin))))) + (point)) + :end (progn (goto-char com-end) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines com-end end) + :post-affiliated begin)))) (defun org-element-comment-interpreter (comment _) "Interpret COMMENT element as Org syntax. @@ -1848,7 +1772,7 @@ CONTENTS is nil." ;;;; Comment Block (defun org-element-comment-block-parser (limit affiliated) - "Parse an export block. + "Parse a comment block. LIMIT bounds the search. AFFILIATED is a list of which CAR is the buffer position at the beginning of the first affiliated @@ -1865,26 +1789,23 @@ Assume point is at comment block beginning." (re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - (contents-begin (progn (forward-line) (point))) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position)))) - (value (buffer-substring-no-properties - contents-begin contents-end))) - (list 'comment-block - (nconc - (list :begin begin - :end end - :value value - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (list 'comment-block + (nconc + (let ((contents-end (match-beginning 0))) + (save-excursion + (org-prog-plist + :begin (car affiliated) + :post-affiliated (point) + contents-begin (progn (forward-line) (point)) + pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :value (buffer-substring-no-properties + contents-begin contents-end) + :post-blank (count-lines pos-before-blank end)))) + (cdr affiliated)))))) (defun org-element-comment-block-interpreter (comment-block _) "Interpret COMMENT-BLOCK element as Org syntax." @@ -1907,22 +1828,19 @@ their value. Return a list whose CAR is `diary-sexp' and CDR is a plist containing `:begin', `:end', `:value', `:post-blank' and `:post-affiliated' keywords." - (save-excursion - (let ((begin (car affiliated)) - (post-affiliated (point)) - (value (progn (looking-at "\\(%%(.*\\)[ \t]*$") - (match-string-no-properties 1))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'diary-sexp - (nconc - (list :value value - :begin begin - :end end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (list 'diary-sexp + (nconc + (save-excursion + (org-prog-plist + :begin (car affiliated) + :post-affiliated (point) + :value (progn (looking-at "\\(%%(.*\\)[ \t]*$") + (match-string-no-properties 1)) + pos-before-blank (progn (forward-line) (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines pos-before-blank end))) + (cdr affiliated)))) (defun org-element-diary-sexp-interpreter (diary-sexp _) "Interpret DIARY-SEXP as Org syntax." @@ -1948,69 +1866,61 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((switches - (progn - (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") - (match-string-no-properties 1))) - ;; Switches analysis. - (number-lines - (and switches - (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" - switches) - (cons - (if (equal (match-string 1 switches) "-") - 'new - 'continued) - (if (not (match-end 2)) 0 - ;; Subtract 1 to give number of lines before - ;; first line. - (1- (string-to-number (match-string 2 switches))))))) - (preserve-indent - (and switches (string-match "-i\\>" switches))) - ;; Should labels be retained in (or stripped from) example - ;; blocks? - (retain-labels - (or (not switches) - (not (string-match "-r\\>" switches)) - (and number-lines (string-match "-k\\>" switches)))) - ;; What should code-references use - labels or - ;; line-numbers? - (use-labels - (or (not switches) - (and retain-labels - (not (string-match "-k\\>" switches))))) - (label-fmt - (and switches - (string-match "-l +\"\\([^\"\n]+\\)\"" switches) - (match-string 1 switches))) - ;; Standard block parsing. - (begin (car affiliated)) - (post-affiliated (point)) - (contents-begin (line-beginning-position 2)) - (value (org-unescape-code-in-string - (buffer-substring-no-properties - contents-begin contents-end))) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'example-block - (nconc - (list :begin begin - :end end - :value value - :switches switches - :number-lines number-lines - :preserve-indent preserve-indent - :retain-labels retain-labels - :use-labels use-labels - :label-fmt label-fmt - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (list 'example-block + (nconc + (let ((contents-end (match-beginning 0))) + (save-excursion + (org-prog-plist + :switches + (progn + (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") + (match-string-no-properties 1)) + ;; Switches analysis. + :number-lines + (and switches + (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" + switches) + (cons + (if (equal (match-string 1 switches) "-") + 'new + 'continued) + (if (not (match-end 2)) 0 + ;; Subtract 1 to give number of lines before + ;; first line. + (1- (string-to-number (match-string 2 switches)))))) + :preserve-indent + (and switches (string-match "-i\\>" switches)) + ;; Should labels be retained in (or stripped from) example + ;; blocks? + :retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches))) + ;; What should code-references use - labels or + ;; line-numbers? + :use-labels + (or (not switches) + (and retain-labels + (not (string-match "-k\\>" switches)))) + :label-fmt + (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches)) + ;; Standard block parsing. + :begin (car affiliated) + :post-affiliated (point) + contents-begin (line-beginning-position 2) + :value (org-unescape-code-in-string + (buffer-substring-no-properties + contents-begin contents-end)) + pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) + (line-beginning-position))) + :post-blank (count-lines pos-before-blank end)))) + (cdr affiliated)))))) (defun org-element-example-block-interpreter (example-block _) "Interpret EXAMPLE-BLOCK element as Org syntax." @@ -2053,33 +1963,30 @@ Assume point is at export-block beginning." (re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (save-excursion - (let* ((contents-end (match-beginning 0)) - (backend - (progn - (looking-at - "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$") - (match-string-no-properties 1))) - (begin (car affiliated)) - (post-affiliated (point)) - (contents-begin (progn (forward-line) (point))) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position)))) - (value (org-unescape-code-in-string - (buffer-substring-no-properties contents-begin - contents-end)))) - (list 'export-block - (nconc - (list :type (and backend (upcase backend)) - :begin begin - :end end - :value value - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))))) + (list 'export-block + (nconc + (save-excursion + (org-prog-plist + contents-end (match-beginning 0) + backend + (progn + (looking-at + "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$") + (match-string-no-properties 1)) + :begin (car affiliated) + :post-affiliated (point) + contents-begin (progn (forward-line) (point)) + pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :value (org-unescape-code-in-string + (buffer-substring-no-properties contents-begin + contents-end)) + :type (and backend (upcase backend)) + :post-blank (count-lines pos-before-blank end))) + (cdr affiliated)))))) (defun org-element-export-block-interpreter (export-block _) "Interpret EXPORT-BLOCK element as Org syntax." @@ -2103,28 +2010,25 @@ containing `:begin', `:end', `:value', `:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the fixed-width area." - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - (end-area - (progn - (while (and (< (point) limit) - (looking-at "[ \t]*:\\( \\|$\\)")) - (forward-line)) - (if (bolp) (line-end-position 0) (point)))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'fixed-width - (nconc - (list :begin begin - :end end - :value (replace-regexp-in-string - "^[ \t]*: ?" "" - (buffer-substring-no-properties post-affiliated - end-area)) - :post-blank (count-lines end-area end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (list 'fixed-width + (nconc + (save-excursion + (org-prog-plist + :begin (car affiliated) + :post-affiliated (point) + end-area (progn + (while (and (< (point) limit) + (looking-at "[ \t]*:\\( \\|$\\)")) + (forward-line)) + (if (bolp) (line-end-position 0) (point))) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :value (replace-regexp-in-string + "^[ \t]*: ?" "" + (buffer-substring-no-properties post-affiliated + end-area)) + :post-blank (count-lines end-area end))) + (cdr affiliated)))) (defun org-element-fixed-width-interpreter (fixed-width _) "Interpret FIXED-WIDTH element as Org syntax." @@ -2145,19 +2049,16 @@ their value. Return a list whose CAR is `horizontal-rule' and CDR is a plist containing `:begin', `:end', `:post-blank' and `:post-affiliated' keywords." - (save-excursion - (let ((begin (car affiliated)) - (post-affiliated (point)) - (post-hr (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'horizontal-rule - (nconc - (list :begin begin - :end end - :post-blank (count-lines post-hr end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (list 'horizontal-rule + (nconc (save-excursion + (org-prog-plist + :begin (car affiliated) + :post-affiliated (point) + post-hr (progn (forward-line) (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines post-hr end))) + (cdr affiliated)))) (defun org-element-horizontal-rule-interpreter (&rest _) "Interpret HORIZONTAL-RULE element as Org syntax." @@ -2177,28 +2078,24 @@ their value. Return a list whose CAR is a normalized `keyword' (uppercase) and CDR is a plist containing `:key', `:value', `:begin', `:end', `:post-blank' and `:post-affiliated' keywords." - (save-excursion - ;; An orphaned affiliated keyword is considered as a regular - ;; keyword. In this case AFFILIATED is nil, so we take care of - ;; this corner case. - (let ((begin (or (car affiliated) (point))) - (post-affiliated (point)) - (key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):") - (upcase (match-string-no-properties 1)))) - (value (org-trim (buffer-substring-no-properties - (match-end 0) (point-at-eol)))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'keyword - (nconc - (list :key key - :value value - :begin begin - :end end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (list 'keyword + (nconc + (save-excursion + ;; An orphaned affiliated keyword is considered as a regular + ;; keyword. In this case AFFILIATED is nil, so we take care of + ;; this corner case. + (org-prog-plist + :begin (or (car affiliated) (point)) + :post-affiliated (point) + :key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):") + (upcase (match-string-no-properties 1))) + :value (org-trim (buffer-substring-no-properties + (match-end 0) (point-at-eol))) + pos-before-blank (progn (forward-line) (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines pos-before-blank end))) + (cdr affiliated)))) (defun org-element-keyword-interpreter (keyword _) "Interpret KEYWORD element as Org syntax." @@ -2243,19 +2140,17 @@ Assume point is at the beginning of the latex environment." limit t)) ;; Incomplete latex environment: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (let* ((code-end (progn (forward-line) (point))) - (begin (car affiliated)) - (value (buffer-substring-no-properties code-begin code-end)) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'latex-environment - (nconc - (list :begin begin - :end end - :value value - :post-blank (count-lines code-end end) - :post-affiliated code-begin) - (cdr affiliated)))))))) + (list 'latex-environment + (nconc + (org-prog-plist + code-end (progn (forward-line) (point)) + :begin (car affiliated) + :value (buffer-substring-no-properties code-begin code-end) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines code-end end) + :post-affiliated code-begin) + (cdr affiliated))))))) (defun org-element-latex-environment-interpreter (latex-environment _) "Interpret LATEX-ENVIRONMENT element as Org syntax." @@ -2273,22 +2168,18 @@ Return a list whose CAR is `node-property' and CDR is a plist containing `:key', `:value', `:begin', `:end', `:post-blank' and `:post-affiliated' keywords." (looking-at org-property-re) - (let ((case-fold-search t) - (begin (point)) - (key (match-string-no-properties 2)) - (value (match-string-no-properties 3)) - (end (save-excursion - (end-of-line) - (if (re-search-forward org-property-re limit t) - (line-beginning-position) - limit)))) - (list 'node-property - (list :key key - :value value - :begin begin - :end end - :post-blank 0 - :post-affiliated begin)))) + (list 'node-property + (org-prog-plist case-fold-search t + :begin (point) + :key (match-string-no-properties 2) + :value (match-string-no-properties 3) + :end (save-excursion + (end-of-line) + (if (re-search-forward org-property-re limit t) + (line-beginning-position) + limit)) + :post-blank 0 + :post-affiliated begin))) (defun org-element-node-property-interpreter (node-property _) "Interpret NODE-PROPERTY element as Org syntax." @@ -2312,59 +2203,56 @@ containing `:begin', `:end', `:contents-begin' and `:contents-end', `:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the paragraph." - (save-excursion - (let* ((begin (car affiliated)) - (contents-begin (point)) - (before-blank - (let ((case-fold-search t)) - (end-of-line) - ;; A matching `org-element-paragraph-separate' is not - ;; necessarily the end of the paragraph. In particular, - ;; drawers, blocks or LaTeX environments opening lines - ;; must be closed. Moreover keywords with a secondary - ;; value must belong to "dual keywords". - (while (not - (cond - ((not (and (re-search-forward - org-element-paragraph-separate limit 'move) - (progn (beginning-of-line) t)))) - ((looking-at org-drawer-regexp) - (save-excursion - (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) - ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") - (save-excursion - (re-search-forward - (format "^[ \t]*#\\+END_%s[ \t]*$" - (regexp-quote (match-string 1))) - limit t))) - ((looking-at org-element--latex-begin-environment) - (save-excursion - (re-search-forward - (format org-element--latex-end-environment - (regexp-quote (match-string 1))) - limit t))) - ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:") - (member-ignore-case (match-string 1) - org-element-dual-keywords)) - ;; Everything else is unambiguous. - (t))) - (end-of-line)) - (if (= (point) limit) limit - (goto-char (line-beginning-position))))) - (contents-end (save-excursion - (skip-chars-backward " \r\t\n" contents-begin) - (line-beginning-position 2))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'paragraph - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines before-blank end) - :post-affiliated contents-begin) - (cdr affiliated)))))) + (list 'paragraph + (nconc + (save-excursion + (org-prog-plist + :begin (car affiliated) + :contents-begin (point) + before-blank + (let ((case-fold-search t)) + (end-of-line) + ;; A matching `org-element-paragraph-separate' is not + ;; necessarily the end of the paragraph. In particular, + ;; drawers, blocks or LaTeX environments opening lines + ;; must be closed. Moreover keywords with a secondary + ;; value must belong to "dual keywords". + (while (not + (cond + ((not (and (re-search-forward + org-element-paragraph-separate limit 'move) + (progn (beginning-of-line) t)))) + ((looking-at org-drawer-regexp) + (save-excursion + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) + ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") + (save-excursion + (re-search-forward + (format "^[ \t]*#\\+END_%s[ \t]*$" + (regexp-quote (match-string 1))) + limit t))) + ((looking-at org-element--latex-begin-environment) + (save-excursion + (re-search-forward + (format org-element--latex-end-environment + (regexp-quote (match-string 1))) + limit t))) + ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:") + (member-ignore-case (match-string 1) + org-element-dual-keywords)) + ;; Everything else is unambiguous. + (t))) + (end-of-line)) + (if (= (point) limit) limit + (goto-char (line-beginning-position)))) + :contents-end (save-excursion + (skip-chars-backward " \r\t\n" contents-begin) + (line-beginning-position 2)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines before-blank end) + :post-affiliated contents-begin)) + (cdr affiliated)))) (defun org-element-paragraph-interpreter (_ contents) "Interpret paragraph element as Org syntax. @@ -2383,32 +2271,27 @@ Return a list whose CAR is `planning' and CDR is a plist containing `:closed', `:deadline', `:scheduled', `:begin', `:end', `:post-blank' and `:post-affiliated' keywords." (save-excursion - (let* ((case-fold-search nil) - (begin (point)) - (post-blank (let ((before-blank (progn (forward-line) (point)))) - (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (unless (bolp) (end-of-line)) - (count-lines before-blank (point)))) - (end (point)) - closed deadline scheduled) - (goto-char begin) - (while (re-search-forward org-keyword-time-not-clock-regexp end t) - (goto-char (match-end 1)) - (skip-chars-forward " \t" end) - (let ((keyword (match-string 1)) - (time (org-element-timestamp-parser))) - (cond ((equal keyword org-closed-string) (setq closed time)) - ((equal keyword org-deadline-string) (setq deadline time)) - (t (setq scheduled time))))) - (list 'planning - (list :closed closed - :deadline deadline - :scheduled scheduled - :begin begin - :end end - :post-blank post-blank - :post-affiliated begin))))) + (list 'planning + (org-prog-plist + case-fold-search nil + :begin (point) + :post-blank (let ((before-blank (progn (forward-line) (point)))) + (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (unless (bolp) (end-of-line)) + (count-lines before-blank (point))) + :end (point) + :closed nil :deadline nil :scheduled nil + (goto-char begin) + (while (re-search-forward org-keyword-time-not-clock-regexp end t) + (goto-char (match-end 1)) + (skip-chars-forward " \t" end) + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) + (cond ((equal keyword org-closed-string) (setq closed time)) + ((equal keyword org-deadline-string) (setq deadline time)) + (t (setq scheduled time))))) + :post-affiliated begin)))) (defun org-element-planning-interpreter (planning _) "Interpret PLANNING element as Org syntax." @@ -2452,82 +2335,75 @@ Assume point is at the beginning of the block." limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - ;; Get language as a string. - (language - (progn - (looking-at - "^[ \t]*#\\+BEGIN_SRC\ + (list 'src-block + (nconc + (let ((contents-end (match-beginning 0))) + (save-excursion + (org-prog-plist + :begin (car affiliated) + :post-affiliated (point) + ;; Get language as a string. + :language + (progn + (looking-at + "^[ \t]*#\\+BEGIN_SRC\ \\(?: +\\(\\S-+\\)\\)?\ \\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\ \\(.*\\)[ \t]*$") - (match-string-no-properties 1))) - ;; Get switches. - (switches (match-string-no-properties 2)) - ;; Get parameters. - (parameters (match-string-no-properties 3)) - ;; Switches analysis. - (number-lines - (and switches - (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" - switches) - (cons - (if (equal (match-string 1 switches) "-") - 'new - 'continued) - (if (not (match-end 2)) 0 - ;; Subtract 1 to give number of lines before - ;; first line. - (1- (string-to-number (match-string 2 switches))))))) - (preserve-indent (and switches - (string-match "-i\\>" switches))) - (label-fmt - (and switches - (string-match "-l +\"\\([^\"\n]+\\)\"" switches) - (match-string 1 switches))) - ;; Should labels be retained in (or stripped from) - ;; source blocks? - (retain-labels - (or (not switches) - (not (string-match "-r\\>" switches)) - (and number-lines (string-match "-k\\>" switches)))) - ;; What should code-references use - labels or - ;; line-numbers? - (use-labels - (or (not switches) - (and retain-labels - (not (string-match "-k\\>" switches))))) - ;; Retrieve code. - (value (org-unescape-code-in-string - (buffer-substring-no-properties - (line-beginning-position 2) contents-end))) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - ;; Get position after ending blank lines. - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'src-block - (nconc - (list :language language - :switches (and (org-string-nw-p switches) - (org-trim switches)) - :parameters (and (org-string-nw-p parameters) - (org-trim parameters)) - :begin begin - :end end - :number-lines number-lines - :preserve-indent preserve-indent - :retain-labels retain-labels - :use-labels use-labels - :label-fmt label-fmt - :value value - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (match-string-no-properties 1)) + ;; Get switches. + switches (match-string-no-properties 2) + ;; Get parameters. + parameters (match-string-no-properties 3) + ;; Switches analysis. + :number-lines + (and switches + (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" + switches) + (cons + (if (equal (match-string 1 switches) "-") + 'new + 'continued) + (if (not (match-end 2)) 0 + ;; Subtract 1 to give number of lines before + ;; first line. + (1- (string-to-number (match-string 2 switches)))))) + :preserve-indent (and switches + (string-match "-i\\>" switches)) + :label-fmt + (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches)) + ;; Should labels be retained in (or stripped from) + ;; source blocks? + :retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches))) + ;; What should code-references use - labels or + ;; line-numbers? + :use-labels + (or (not switches) + (and retain-labels + (not (string-match "-k\\>" switches)))) + ;; Retrieve code. + :value (org-unescape-code-in-string + (buffer-substring-no-properties + (line-beginning-position 2) contents-end)) + pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point)) + ;; Get position after ending blank lines. + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) + (line-beginning-position))) + ;; Update switches and parameters + :switches (and (org-string-nw-p switches) + (org-trim switches)) + :parameters (and (org-string-nw-p parameters) + (org-trim parameters)) + :post-blank (count-lines pos-before-blank end)))) + (cdr affiliated)))))) (defun org-element-src-block-interpreter (src-block _) "Interpret SRC-BLOCK element as Org syntax." @@ -2570,42 +2446,37 @@ Return a list whose CAR is `table' and CDR is a plist containing keywords. Assume point is at the beginning of the table." - (save-excursion - (let* ((case-fold-search t) - (table-begin (point)) - (type (if (looking-at "[ \t]*|") 'org 'table.el)) - (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)" - (if (eq type 'org) "" "+"))) - (begin (car affiliated)) - (table-end - (if (re-search-forward end-re limit 'move) - (goto-char (match-beginning 0)) - (point))) - (tblfm (let (acc) - (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") - (push (match-string-no-properties 1) acc) - (forward-line)) - acc)) - (pos-before-blank (point)) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'table - (nconc - (list :begin begin - :end end - :type type - :tblfm tblfm - ;; Only `org' tables have contents. `table.el' tables - ;; use a `:value' property to store raw table as - ;; a string. - :contents-begin (and (eq type 'org) table-begin) - :contents-end (and (eq type 'org) table-end) - :value (and (eq type 'table.el) - (buffer-substring-no-properties - table-begin table-end)) - :post-blank (count-lines pos-before-blank end) - :post-affiliated table-begin) - (cdr affiliated)))))) + (list 'table + (nconc + (save-excursion + (org-prog-plist + case-fold-search t + table-begin (point) + :type (if (looking-at "[ \t]*|") 'org 'table.el) + end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)" + (if (eq type 'org) "" "+")) + :begin (car affiliated) + table-end (if (re-search-forward end-re limit 'move) + (goto-char (match-beginning 0)) + (point)) + :tblfm (let (acc) + (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") + (push (match-string-no-properties 1) acc) + (forward-line)) + acc) + pos-before-blank (point) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + ;; Only `org' tables have contents. `table.el' tables + ;; use a `:value' property to store raw table as + ;; a string. + :contents-begin (and (eq type 'org) table-begin) + :contents-end (and (eq type 'org) table-end) + :value (and (eq type 'table.el) + (buffer-substring-no-properties table-begin table-end)) + :post-blank (count-lines pos-before-blank end) + :post-affiliated table-begin)) + (cdr affiliated)))) (defun org-element-table-interpreter (table contents) "Interpret TABLE element as Org syntax. @@ -2628,26 +2499,21 @@ CONTENTS is a string, if table's type is `org', or nil." Return a list whose CAR is `table-row' and CDR is a plist containing `:begin', `:end', `:contents-begin', `:contents-end', `:type', `:post-blank' and `:post-affiliated' keywords." - (save-excursion - (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard)) - (begin (point)) - ;; A table rule has no contents. In that case, ensure - ;; CONTENTS-BEGIN matches CONTENTS-END. - (contents-begin (and (eq type 'standard) (search-forward "|"))) - (contents-end (and (eq type 'standard) - (progn - (end-of-line) - (skip-chars-backward " \t") - (point)))) - (end (line-beginning-position 2))) - (list 'table-row - (list :type type - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank 0 - :post-affiliated begin))))) + (list 'table-row + (save-excursion + (org-prog-plist + :type (if (looking-at "^[ \t]*|-") 'rule 'standard) + :begin (point) + ;; A table rule has no contents. In that case, ensure + ;; CONTENTS-BEGIN matches CONTENTS-END. + :contents-begin (and (eq type 'standard) (search-forward "|")) + :contents-end (and (eq type 'standard) + (progn (end-of-line) + (skip-chars-backward " \t") + (point))) + :end (line-beginning-position 2) + :post-blank 0 + :post-affiliated begin)))) (defun org-element-table-row-interpreter (table-row contents) "Interpret TABLE-ROW element as Org syntax. @@ -2676,25 +2542,21 @@ Assume point is at beginning of the block." (re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - (contents-begin (progn (forward-line) (point))) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'verse-block - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (list 'verse-block + (nconc + (save-excursion + (org-prog-plist + :begin (car affiliated) + :post-affiliated (point) + :contents-begin (progn (forward-line) (point)) + :contents-end (match-beginning 0) + pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point)) + :end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))) + :post-blank (count-lines pos-before-blank end))) + (cdr affiliated)))))) (defun org-element-verse-block-interpreter (_ contents) "Interpret verse-block element as Org syntax. @@ -2732,18 +2594,12 @@ Assume point is at the first star marker." (save-excursion (unless (bolp) (backward-char 1)) (when (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'bold - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank)))))) + (list 'bold (list :begin (match-beginning 2) + :contents-begin (match-beginning 4) + :contents-end (match-end 4) + :post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t")) + :end (point)))))) (defun org-element-bold-interpreter (_ contents) "Interpret bold object as Org syntax. @@ -2764,16 +2620,11 @@ Assume point is at the first tilde marker." (save-excursion (unless (bolp) (backward-char 1)) (when (looking-at org-verbatim-re) - (let ((begin (match-beginning 2)) - (value (match-string-no-properties 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'code - (list :value value - :begin begin - :end end - :post-blank post-blank)))))) + (list 'code (list :value (match-string-no-properties 4) + :begin (match-beginning 2) + :post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t")) + :end (point)))))) (defun org-element-code-interpreter (code _) "Interpret CODE object as Org syntax." @@ -2793,27 +2644,25 @@ a plist with `:begin', `:end', `:latex', `:latex-math-p', Assume point is at the beginning of the entity." (catch 'no-object (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)") - (save-excursion - (let* ((value (or (org-entity-get (match-string 1)) - (throw 'no-object nil))) - (begin (match-beginning 0)) - (bracketsp (string= (match-string 2) "{}")) - (post-blank (progn (goto-char (match-end 1)) - (when bracketsp (forward-char 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'entity - (list :name (car value) - :latex (nth 1 value) - :latex-math-p (nth 2 value) - :html (nth 3 value) - :ascii (nth 4 value) - :latin1 (nth 5 value) - :utf-8 (nth 6 value) - :begin begin - :end end - :use-brackets-p bracketsp - :post-blank post-blank))))))) + (list 'entity + (save-excursion + (org-prog-plist + value (or (org-entity-get (match-string 1)) + (throw 'no-object nil)) + :begin (match-beginning 0) + bracketsp (string= (match-string 2) "{}") + :post-blank (progn (goto-char (match-end 1)) + (when bracketsp (forward-char 2)) + (skip-chars-forward " \t")) + :end (point) + :name (car value) + :latex (nth 1 value) + :latex-math-p (nth 2 value) + :html (nth 3 value) + :ascii (nth 4 value) + :latin1 (nth 5 value) + :utf-8 (nth 6 value) + :use-brackets-p bracketsp)))))) (defun org-element-entity-interpreter (entity _) "Interpret ENTITY object as Org syntax." @@ -2840,18 +2689,12 @@ Assume point is at the beginning of the snippet." (save-match-data (goto-char (match-end 0)) (re-search-forward "@@" nil t) (match-beginning 0)))) - (let* ((begin (match-beginning 0)) - (back-end (match-string-no-properties 1)) - (value (buffer-substring-no-properties - (match-end 0) contents-end)) - (post-blank (skip-chars-forward " \t")) - (end (point))) - (list 'export-snippet - (list :back-end back-end - :value value - :begin begin - :end end - :post-blank post-blank))))))) + (list 'export-snippet (list :begin (match-beginning 0) + :back-end (match-string-no-properties 1) + :value (buffer-substring-no-properties + (match-end 0) contents-end) + :post-blank (skip-chars-forward " \t") + :end (point))))))) (defun org-element-export-snippet-interpreter (export-snippet _) "Interpret EXPORT-SNIPPET object as Org syntax." @@ -2873,23 +2716,19 @@ When at a footnote reference, return a list whose car is (let ((closing (with-syntax-table org-element--pair-square-table (ignore-errors (scan-lists (point) 1 0))))) (when closing - (save-excursion - (let* ((begin (point)) - (label (match-string-no-properties 1)) - (inner-begin (match-end 0)) - (inner-end (1- closing)) - (type (if (match-end 2) 'inline 'standard)) - (post-blank (progn (goto-char closing) - (skip-chars-forward " \t"))) - (end (point))) - (list 'footnote-reference - (list :label label - :type type - :begin begin - :end end - :contents-begin (and (eq type 'inline) inner-begin) - :contents-end (and (eq type 'inline) inner-end) - :post-blank post-blank)))))))) + (list 'footnote-reference + (save-excursion + (org-prog-plist + :label (match-string-no-properties 1) + :begin (point) + inner-begin (match-end 0) + inner-end (1- closing) + :type (if (match-end 2) 'inline 'standard) + :post-blank (progn (goto-char closing) + (skip-chars-forward " \t")) + :end (point) + :contents-begin (and (eq type 'inline) inner-begin) + :contents-end (and (eq type 'inline) inner-end)))))))) (defun org-element-footnote-reference-interpreter (footnote-reference contents) "Interpret FOOTNOTE-REFERENCE object as Org syntax. @@ -2915,32 +2754,25 @@ Assume point is at the beginning of the babel call." (when (let ((case-fold-search nil)) (looking-at "\\. Unlike to - ;; bracket links, follow RFC 3986 and remove any extra - ;; whitespace in URI. - ((looking-at org-link-angle-re) - (setq format 'angle) - (setq type (match-string-no-properties 1)) - (setq link-end (match-end 0)) - (setq raw-link - (buffer-substring-no-properties - (match-beginning 1) (match-end 2))) - (setq path (replace-regexp-in-string - "[ \t]*\n[ \t]*" "" (match-string-no-properties 2)))) - (t (throw 'no-object nil))) - ;; In any case, deduce end point after trailing white space from - ;; LINK-END variable. - (save-excursion - (setq post-blank - (progn (goto-char link-end) (skip-chars-forward " \t"))) - (setq end (point))) - ;; Special "file"-type link processing. Extract opening - ;; application and search option, if any. Also normalize URI. - (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type) - (setq application (match-string 1 type)) - (setq type "file") - (when (string-match "::\\(.*\\)\\'" path) - (setq search-option (match-string 1 path)) - (setq path (replace-match "" nil nil path))) - (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path))) - ;; Translate link, if `org-link-translation-function' is set. - (let ((trans (and (functionp org-link-translation-function) - (funcall org-link-translation-function type path)))) - (when trans - (setq type (car trans)) - (setq path (cdr trans)))) - (list 'link - (list :type type - :path path - :format format - :raw-link (or raw-link path) - :application application - :search-option search-option - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) + (list 'link + (org-prog-plist + :begin (point) + :end nil :contents-begin nil :contents-end nil + :link-end nil :post-blank nil :path nil :type nil :format nil + raw-link nil + :search-option nil :application nil + (cond + ;; Type 1: Text targeted from a radio target. + ((and org-target-link-regexp + (save-excursion (or (bolp) (backward-char)) + (looking-at org-target-link-regexp))) + (setq type "radio") + (setq format 'plain) + (setq link-end (match-end 1)) + (setq path (match-string-no-properties 1)) + (setq contents-begin (match-beginning 1)) + (setq contents-end (match-end 1))) + ;; Type 2: Standard link, i.e. [[https://orgmode.org][homepage]] + ((looking-at org-link-bracket-re) + (setq format 'bracket) + (setq contents-begin (match-beginning 2)) + (setq contents-end (match-end 2)) + (setq link-end (match-end 0)) + ;; RAW-LINK is the original link. Decode any encoding. + ;; Expand any abbreviation in it. + ;; + ;; Also treat any newline character and associated + ;; indentation as a single space character. This is not + ;; compatible with RFC 3986, which requires to ignore + ;; them altogether. However, doing so would require + ;; users to encode spaces on the fly when writing links + ;; (e.g., insert [[shell:ls%20*.org]] instead of + ;; [[shell:ls *.org]], which defeats Org's focus on + ;; simplicity. + (setq raw-link (org-link-expand-abbrev + (org-link-unescape + (replace-regexp-in-string + "[ \t]*\n[ \t]*" " " + (match-string-no-properties 1))))) + ;; Determine TYPE of link and set PATH accordingly. According + ;; to RFC 3986, remove whitespaces from URI in external links. + ;; In internal ones, treat indentation as a single space. + (cond + ;; File type. + ((or (file-name-absolute-p raw-link) + (string-match "\\`\\.\\.?/" raw-link)) + (setq type "file") + (setq path raw-link)) + ;; Explicit type (http, irc, bbdb...). + ((string-match org-link-types-re raw-link) + (setq type (match-string 1 raw-link)) + (setq path (substring raw-link (match-end 0)))) + ;; Code-ref type: PATH is the name of the reference. + ((and (string-match-p "\\`(" raw-link) + (string-match-p ")\\'" raw-link)) + (setq type "coderef") + (setq path (substring raw-link 1 -1))) + ;; Custom-id type: PATH is the name of the custom id. + ((= (string-to-char raw-link) ?#) + (setq type "custom-id") + (setq path (substring raw-link 1))) + ;; Fuzzy type: Internal link either matches a target, an + ;; headline name or nothing. PATH is the target or + ;; headline's name. + (t + (setq type "fuzzy") + (setq path raw-link)))) + ;; Type 3: Plain link, e.g., https://orgmode.org + ((looking-at org-link-plain-re) + (setq format 'plain) + (setq raw-link (match-string-no-properties 0)) + (setq type (match-string-no-properties 1)) + (setq link-end (match-end 0)) + (setq path (match-string-no-properties 2))) + ;; Type 4: Angular link, e.g., . Unlike to + ;; bracket links, follow RFC 3986 and remove any extra + ;; whitespace in URI. + ((looking-at org-link-angle-re) + (setq format 'angle) + (setq type (match-string-no-properties 1)) + (setq link-end (match-end 0)) + (setq raw-link + (buffer-substring-no-properties + (match-beginning 1) (match-end 2))) + (setq path (replace-regexp-in-string + "[ \t]*\n[ \t]*" "" (match-string-no-properties 2)))) + (t (throw 'no-object nil))) + ;; In any case, deduce end point after trailing white space from + ;; LINK-END variable. + (save-excursion + (setq post-blank + (progn (goto-char link-end) (skip-chars-forward " \t"))) + (setq end (point))) + ;; Special "file" type link processing. Extract opening + ;; application and search option, if any. Also normalize URI. + (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type) + (setq application (match-string 1 type) type "file") + (when (string-match "::\\(.*\\)\\'" path) + (setq search-option (match-string 1 path)) + (setq path (replace-match "" nil nil path))) + (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path))) + ;; Translate link, if `org-link-translation-function' is set. + (let ((trans (and (functionp org-link-translation-function) + (funcall org-link-translation-function type path)))) + (when trans + (setq type (car trans)) + (setq path (cdr trans)))) + :raw-link (or raw-link path))))) (defun org-element-link-interpreter (link contents) "Interpret LINK object as Org syntax. @@ -3285,24 +3096,18 @@ a plist with `:key', `:args', `:begin', `:end', `:value' and Assume point is at the macro." (save-excursion (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\([^\000]*?\\))\\)?}}}") - (let ((begin (point)) - (key (downcase (match-string-no-properties 1))) - (value (match-string-no-properties 0)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point)) - (args (pcase (match-string-no-properties 3) - (`nil nil) - (a (org-macro-extract-arguments - (replace-regexp-in-string - "[ \t\r\n]+" " " (org-trim a))))))) - (list 'macro - (list :key key - :value value - :args args - :begin begin - :end end - :post-blank post-blank)))))) + (list 'macro + (list :begin (point) + :key (downcase (match-string-no-properties 1)) + :value (match-string-no-properties 0) + :post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t")) + :end (point) + :args (pcase (match-string-no-properties 3) + (`nil nil) + (a (org-macro-extract-arguments + (replace-regexp-in-string + "[ \t\r\n]+" " " (org-trim a)))))))))) (defun org-element-macro-interpreter (macro _) "Interpret MACRO object as Org syntax." @@ -3326,20 +3131,14 @@ Otherwise, return nil. Assume point is at the radio target." (save-excursion (when (looking-at org-radio-target-regexp) - (let ((begin (point)) - (contents-begin (match-beginning 1)) - (contents-end (match-end 1)) - (value (match-string-no-properties 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'radio-target - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank - :value value)))))) + (list 'radio-target + (list :begin (point) + :contents-begin (match-beginning 1) + :contents-end (match-end 1) + :value (match-string-no-properties 1) + :post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t")) + :end (point)))))) (defun org-element-radio-target-interpreter (_ contents) "Interpret target object as Org syntax. @@ -3359,17 +3158,13 @@ When at a statistics cookie, return a list whose car is Assume point is at the beginning of the statistics-cookie." (save-excursion (when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") - (let* ((begin (point)) - (value (buffer-substring-no-properties - (match-beginning 0) (match-end 0))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'statistics-cookie - (list :begin begin - :end end - :value value - :post-blank post-blank)))))) + (list 'statistics-cookie + (list :begin (point) + :value (buffer-substring-no-properties + (match-beginning 0) (match-end 0)) + :post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t")) + :end (point)))))) (defun org-element-statistics-cookie-interpreter (statistics-cookie _) "Interpret STATISTICS-COOKIE object as Org syntax." @@ -3390,18 +3185,13 @@ Assume point is at the first plus sign marker." (save-excursion (unless (bolp) (backward-char 1)) (when (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'strike-through - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank)))))) + (list 'strike-through + (list :begin (match-beginning 2) + :contents-begin (match-beginning 4) + :contents-end (match-end 4) + :post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t")) + :end (point)))))) (defun org-element-strike-through-interpreter (_ contents) "Interpret strike-through object as Org syntax. @@ -3423,21 +3213,14 @@ Assume point is at the underscore." (save-excursion (unless (bolp) (backward-char)) (when (looking-at org-match-substring-regexp) - (let ((bracketsp (match-beginning 4)) - (begin (match-beginning 2)) - (contents-begin (or (match-beginning 4) - (match-beginning 3))) - (contents-end (or (match-end 4) (match-end 3))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'subscript - (list :begin begin - :end end - :use-brackets-p bracketsp - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank)))))) + (list 'subscript + (list :use-brackets-p (match-beginning 4) + :begin (match-beginning 2) + :contents-begin (or (match-beginning 4) (match-beginning 3)) + :contents-end (or (match-end 4) (match-end 3)) + :post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t")) + :end (point)))))) (defun org-element-subscript-interpreter (subscript contents) "Interpret SUBSCRIPT object as Org syntax. @@ -3461,21 +3244,14 @@ Assume point is at the caret." (save-excursion (unless (bolp) (backward-char)) (when (looking-at org-match-substring-regexp) - (let ((bracketsp (match-beginning 4)) - (begin (match-beginning 2)) - (contents-begin (or (match-beginning 4) - (match-beginning 3))) - (contents-end (or (match-end 4) (match-end 3))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'superscript - (list :begin begin - :end end - :use-brackets-p bracketsp - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank)))))) + (list 'superscript + (list :use-brackets-p (match-beginning 4) + :begin (match-beginning 2) + :contents-begin (or (match-beginning 4) (match-beginning 3)) + :contents-end (or (match-end 4) (match-end 3)) + :post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t")) + :end (point)))))) (defun org-element-superscript-interpreter (superscript contents) "Interpret SUPERSCRIPT object as Org syntax. @@ -3493,16 +3269,11 @@ Return a list whose car is `table-cell' and cdr is a plist containing `:begin', `:end', `:contents-begin', `:contents-end' and `:post-blank' keywords." (looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)") - (let* ((begin (match-beginning 0)) - (end (match-end 0)) - (contents-begin (match-beginning 1)) - (contents-end (match-end 1))) - (list 'table-cell - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank 0)))) + (list 'table-cell (list :begin (match-beginning 0) + :end (match-end 0) + :contents-begin (match-beginning 1) + :contents-end (match-end 1) + :post-blank 0))) (defun org-element-table-cell-interpreter (_ contents) "Interpret table-cell element as Org syntax. @@ -3522,16 +3293,11 @@ keywords. Otherwise, return nil. Assume point is at the target." (save-excursion (when (looking-at org-target-regexp) - (let ((begin (point)) - (value (match-string-no-properties 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'target - (list :begin begin - :end end - :value value - :post-blank post-blank)))))) + (list 'target (list :begin (point) + :value (match-string-no-properties 1) + :post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t")) + :end (point)))))) (defun org-element-target-interpreter (target _) "Interpret TARGET object as Org syntax." @@ -3563,91 +3329,76 @@ Otherwise, return nil. Assume point is at the beginning of the timestamp." (when (looking-at-p org-element--timestamp-regexp) (save-excursion - (let* ((begin (point)) - (activep (eq (char-after) ?<)) - (raw-value - (progn - (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?") - (match-string-no-properties 0))) - (date-start (match-string-no-properties 1)) - (date-end (match-string 3)) - (diaryp (match-beginning 2)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point)) - (time-range - (and (not diaryp) - (string-match - "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" - date-start) - (cons (string-to-number (match-string 2 date-start)) - (string-to-number (match-string 3 date-start))))) - (type (cond (diaryp 'diary) - ((and activep (or date-end time-range)) 'active-range) - (activep 'active) - ((or date-end time-range) 'inactive-range) - (t 'inactive))) - (repeater-props - (and (not diaryp) - (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)" - raw-value) - (list - :repeater-type - (let ((type (match-string 1 raw-value))) - (cond ((equal "++" type) 'catch-up) - ((equal ".+" type) 'restart) - (t 'cumulate))) - :repeater-value (string-to-number (match-string 2 raw-value)) - :repeater-unit - (pcase (string-to-char (match-string 3 raw-value)) - (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) - (warning-props - (and (not diaryp) - (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) - (list - :warning-type (if (match-string 1 raw-value) 'first 'all) - :warning-value (string-to-number (match-string 2 raw-value)) - :warning-unit - (pcase (string-to-char (match-string 3 raw-value)) - (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) - year-start month-start day-start hour-start minute-start year-end - month-end day-end hour-end minute-end) - ;; Parse date-start. - (unless diaryp - (let ((date (org-parse-time-string date-start t))) - (setq year-start (nth 5 date) - month-start (nth 4 date) - day-start (nth 3 date) - hour-start (nth 2 date) - minute-start (nth 1 date)))) - ;; Compute date-end. It can be provided directly in time-stamp, - ;; or extracted from time range. Otherwise, it defaults to the - ;; same values as date-start. - (unless diaryp - (let ((date (and date-end (org-parse-time-string date-end t)))) - (setq year-end (or (nth 5 date) year-start) - month-end (or (nth 4 date) month-start) - day-end (or (nth 3 date) day-start) - hour-end (or (nth 2 date) (car time-range) hour-start) - minute-end (or (nth 1 date) (cdr time-range) minute-start)))) - (list 'timestamp - (nconc (list :type type - :raw-value raw-value - :year-start year-start - :month-start month-start - :day-start day-start - :hour-start hour-start - :minute-start minute-start - :year-end year-end - :month-end month-end - :day-end day-end - :hour-end hour-end - :minute-end minute-end - :begin begin - :end end - :post-blank post-blank) - repeater-props - warning-props)))))) + (org-let*-prog-plist + (plist + :begin (point) + activep (eq (char-after) ?<) + :raw-value + (progn + (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?") + (match-string-no-properties 0)) + date-start (match-string-no-properties 1) + date-end (match-string 3) + diaryp (match-beginning 2) + :post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t")) + :end (point) + time-range + (and (not diaryp) + (string-match + "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" + date-start) + (cons (string-to-number (match-string 2 date-start)) + (string-to-number (match-string 3 date-start)))) + :type (cond (diaryp 'diary) + ((and activep (or date-end time-range)) 'active-range) + (activep 'active) + ((or date-end time-range) 'inactive-range) + (t 'inactive)) + repeater-props + (and (not diaryp) + (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)" + raw-value) + (list + :repeater-type + (let ((type (match-string 1 raw-value))) + (cond ((equal "++" type) 'catch-up) + ((equal ".+" type) 'restart) + (t 'cumulate))) + :repeater-value (string-to-number (match-string 2 raw-value)) + :repeater-unit + (pcase (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))) + warning-props + (and (not diaryp) + (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) + (list + :warning-type (if (match-string 1 raw-value) 'first 'all) + :warning-value (string-to-number (match-string 2 raw-value)) + :warning-unit + (pcase (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))) + :year-start nil :month-start nil :day-start nil :hour-start nil :minute-start nil + :year-end nil :month-end nil :day-end nil :hour-end nil :minute-end nil + ;; Parse date-start. + (unless diaryp + (let ((date (org-parse-time-string date-start t))) + (setq year-start (nth 5 date) + month-start (nth 4 date) + day-start (nth 3 date) + hour-start (nth 2 date) + minute-start (nth 1 date)))) + ;; Compute date-end. It can be provided directly in time-stamp, + ;; or extracted from time range. Otherwise, it defaults to the + ;; same values as date-start. + (unless diaryp + (let ((date (and date-end (org-parse-time-string date-end t)))) + (setq year-end (or (nth 5 date) year-start) + month-end (or (nth 4 date) month-start) + day-end (or (nth 3 date) day-start) + hour-end (or (nth 2 date) (car time-range) hour-start) + minute-end (or (nth 1 date) (cdr time-range) minute-start))))) + (list 'timestamp (nconc plist repeater-props warning-props)))))) (defun org-element-timestamp-interpreter (timestamp _) "Interpret TIMESTAMP object as Org syntax." @@ -3758,18 +3509,12 @@ Assume point is at the first underscore marker." (save-excursion (unless (bolp) (backward-char 1)) (when (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'underline - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank)))))) + (list 'underline (list :begin (match-beginning 2) + :contents-begin (match-beginning 4) + :contents-end (match-end 4) + :post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t")) + :end (point)))))) (defun org-element-underline-interpreter (_ contents) "Interpret underline object as Org syntax. @@ -3790,16 +3535,11 @@ Assume point is at the first equal sign marker." (save-excursion (unless (bolp) (backward-char 1)) (when (looking-at org-verbatim-re) - (let ((begin (match-beginning 2)) - (value (match-string-no-properties 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'verbatim - (list :value value - :begin begin - :end end - :post-blank post-blank)))))) + (list 'verbatim (list :begin (match-beginning 2) + :value (match-string-no-properties 4) + :post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t")) + :end (point)))))) (defun org-element-verbatim-interpreter (verbatim _) "Interpret VERBATIM object as Org syntax." diff --git a/lisp/org-macs.el b/lisp/org-macs.el index f25efe07f..8c43601eb 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -33,6 +33,8 @@ (require 'cl-lib) (require 'format-spec) +(eval-when-compile (require 'cl-macs)) +(require 'cl-seq) ; cl-reduce (declare-function org-show-context "org" (&optional key)) (declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case)) @@ -49,6 +51,263 @@ symbols) ,@body)) +(when (version< emacs-version "28") + ;; Should be removed once Org drops support for Emacs 27 and older. + ;; `keyword' type is provided natively in `cl-macs' since 2020-07-06 + (cl-deftype keyword () '(satisfies keywordp))) + +(eval-when-compile + (defun org-dekeyword (symbol) + ;; There is nothing org-specific about this definition. It better be moved. + "Given SYMBOL, return symbol with name as in SYMBOL but normalized: namely, without the leading colon, if it is present. + +Examples: + +ELISP> (org-dekeyword :x) +x + +ELISP> (org-dekeyword 'x) +x" + (cl-etypecase symbol + (keyword (intern (substring (symbol-name symbol) 1))) + (symbol symbol)))) + +(eval-when-compile + (defun org-fold (f x seq) + "Reduce F over SEQ with obligatory initial value X." + ;; There is nothing org-specific about this definition. It better be moved. + (cl-reduce f seq :initial-value x))) + +(defmacro org-prog-plist (&rest bindings-and-compound-forms) + ;; There is nothing org-specific about this definition. It better be moved. + ;; + ;; TODO: maybe support positions, absolute or relative (or both): + ;; sometimes one wants pairs to be in plist in specific order + ;; since numbers self-evaluate and are useless as code, + ;; + ;; one could have e.g. + ;; (org-prog-plist + ;; :p a + ;; 0 :q b + ;; :r c + ;; 1 :s d) + ;; specify that q property should be plisted first, s property second, + ;; + ;; and e.g. + ;; (org-prog-plist + ;; :p a + ;; (0) :q b + ;; :r c + ;; (1) :s d) + ;; specify that s property should be plisted after q property. + ;; + ;; However, one could imagine some similar prog-ptree macro + ;; that arranges results at different depth, in which case + ;; (0), ((0)) and deeper specs should probably be reserved for level specs + "Construct a plist, imperatively (hence prog- prefix) and conveniently. + +Examples: + +Trivial plist: +ELISP> (org-prog-plist + :x 1 + :z 2) +(:x 1 :z 2) + +Evaluate arbitrary compound forms between key-value pairs: +ELISP> (macroexpand-1 + `(org-prog-plist + :x 1 + (message \"Building rest of plist\") + :z 2)) +(let* ((x 1)) + (message \"Building rest of plist\") + (let* ((z 2)) + (list :x x :z z))) + +Reference previous values when building subsequent ones: +ELISP> (org-prog-plist + :x 1 + :z (+ x 40 x)) +(:x 1 :z 42) + +Modify previous values when building subsequent ones: +ELISP> (org-prog-plist + :x 1 + :z (+ (cl-incf x) 40)) +(:x 2 :z 42) + +Bind temporary variables omitted from the resulting plist: +ELISP> (macroexpand-1 + `(org-prog-plist + :x 1 + y 40 + (incf y) + :z (+ x y))) +(let* ((x 1) + (y 40)) + (incf y) + (let* ((z (+ x y))) + (list :x x :z z))) + +Note: to reuse temporary variables, please employ `org-let*-prog-plist', `org-let*-prog-plists'." + (declare (indent 0)) + (let ((headers (list (list 'progn))) bindings plist-form + (reading 'symbol-or-compound-form)) + (cl-symbol-macrolet ((maybe-push-bindings-to-headers + (if bindings + (prog1 (push (list (nreverse bindings) 'let*) + headers) + (setf bindings nil)) + headers)) + (setf-form-in-current-binding + (setf (cadar bindings) it + reading 'symbol-or-compound-form))) + (cl-flet ((cleanup (form) (if (and (consp (cadar form)) + (eq 'let* (caadar form))) + (cadar form) + (car form)))) + (dolist (it bindings-and-compound-forms + (cleanup + (org-fold (lambda (form header) + (dolist (e header (list form)) + (push e form))) + (list (cons 'list (nreverse plist-form))) + maybe-push-bindings-to-headers))) + (cl-ecase reading + (keyword-form (push (org-dekeyword (car plist-form)) plist-form) + setf-form-in-current-binding) + (variable-form setf-form-in-current-binding) + (symbol-or-compound-form + (cl-etypecase it + (keyword (if (cl-loop for (_value key) on plist-form by #'cddr + do (when (eq it key) (cl-return t))) + (setf reading 'repeated-keyword-form) + (push it plist-form) + (setf reading 'keyword-form)) + (push (list (org-dekeyword it) nil) bindings)) + (symbol (push (list it nil) bindings) + (setf reading 'variable-form)) + ;; it might be better to write compound-form instead of cons + ;; however, lack of namespaces means it'd be org-compound-form + ;; which we deemed obnoxious + ;; anyway, conses here are meant to be compound forms + (cons maybe-push-bindings-to-headers + (push it (car headers)) + (setf reading 'symbol-or-compound-form)))) + (repeated-keyword-form setf-form-in-current-binding))))))) + +(defmacro org-let*-prog-plists (plist-specs &rest body) + ;; Lots of code from org-prog-plist is reused verbatim. + ;; The point of org-let*-prog-plists is + ;; to be able to reuse temporary variables used during plist construction. + ;; We thus do not expand org-let*-prog-plists forms into org-prog-plist forms + ;; which discard those variables, but rather produce the code manually. + ;; It might be suboptimal but it works. Duplication twice is not that bad. + ;; TODO: consider other names + ;; - org-prog-plists-let* + ;; - org-with-prog-plists + "Construct plists in PLIST-SPECS as in `org-prog-plist'; bind them to variables. All intermediate variables from PLIST-SPECS, including temporary ones, are available in BODY. + +PLIST-SPECS is a binding spec of the form +((VAR-1 . BINDINGS-AND-COMPOUND-FORMS-1) + (VAR-2 . BINDINGS-AND-COMPOUND-FORMS-2) + ... + (VAR-n . BINDINGS-AND-COMPOUND-FORMS-n)) + +where VAR-i is bound to plist specified by BINDINGS-AND-COMPOUND-FORMS-i, right after it is constructed. + +Examples: + +Construct multiple plists imperatively, reuse temporary bindings: +ELISP> (macroexpand-1 + `(org-let*-prog-plists ((plist1 :x 1 + y 40 + (incf y) + :z (incf y)) + (plist2 :x y)) + (list plist1 y plist2))) +(let* ((x 1) + (y 40)) + (incf y) + (let* ((z (incf y)) + (plist1 (list :x x :z z)) + (x y) + (plist2 (list :x x))) + (list plist1 y plist2))) + +Once plist is constructed, its places are lost; values are still available: +ELISP> (macroexpand-1 + `(org-let*-prog-plists ((plist1 :x 1) + (plist2 (incf x) + :z (+ x 40))) + (list plist1 x plist2))) +(let* ((x 1) + (plist1 (list :x x))) + (incf x) + (let* ((z (+ x 40)) + (plist2 (list :z z))) + (list plist1 x plist2))) + +See Also: `org-prog-plist'" + (declare (indent 1)) + (let ((headers (list (list 'progn))) bindings plist-form + (reading 'symbol-or-compound-form)) + (cl-symbol-macrolet ((maybe-push-bindings-to-headers + (if bindings + (prog1 (push (list (nreverse bindings) 'let*) + headers) + (setf bindings nil)) + headers)) + (setf-form-in-current-binding + (setf (cadar bindings) it + reading 'symbol-or-compound-form))) + (cl-flet ((cleanup (form) (if (and (consp (cadar form)) + (eq 'let* (caadar form))) + (cadar form) + (car form)))) + (dolist (plist-spec plist-specs + (cleanup + (org-fold (lambda (form header) + (dolist (e header (list form)) + (push e form))) + body + maybe-push-bindings-to-headers))) + (setf plist-form nil) + (dolist (it (cdr plist-spec) + (let ((it (cons 'list (nreverse plist-form)))) + (push (list (car plist-spec) nil) bindings) + setf-form-in-current-binding)) + (cl-ecase reading + (keyword-form (push (org-dekeyword (car plist-form)) plist-form) + setf-form-in-current-binding) + (variable-form setf-form-in-current-binding) + (symbol-or-compound-form + (cl-etypecase it + (keyword (if (cl-loop for (_value key) on plist-form by #'cddr + do (when (eq it key) (cl-return t))) + (setf reading 'repeated-keyword-form) + (push it plist-form) + (setf reading 'keyword-form)) + (push (list (org-dekeyword it) nil) bindings)) + (symbol (push (list it nil) bindings) + (setf reading 'variable-form)) + ;; it might be better to write compound-form instead of cons + ;; however, lack of namespaces means it'd be org-compound-form + ;; which we deemed obnoxious + ;; anyway, conses here are meant to be compound forms + (cons maybe-push-bindings-to-headers + (push it (car headers)) + (setf reading 'symbol-or-compound-form)))) + (repeated-keyword-form setf-form-in-current-binding)))))))) + +(defmacro org-let*-prog-plist (plist-spec &rest body) + "Like `org-let*-prog-plists' but only supports a a single plist binding. + +Provided solely to reduce sexp depth when desired." + (declare (indent 1)) + `(org-let*-prog-plists (,plist-spec) ,@body)) + ;; Use `with-silent-modifications' to ignore cosmetic changes and ;; `org-unmodified' to ignore real text modifications. (defmacro org-unmodified (&rest body) -- 2.26.2 --=-=-=--