From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id 2PRrF8/rdWIZWQAAbAwnHQ (envelope-from ) for ; Sat, 07 May 2022 05:47:27 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id 4GN8F8/rdWJ6fQAAauVa8A (envelope-from ) for ; Sat, 07 May 2022 05:47:27 +0200 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 4647354A for ; Sat, 7 May 2022 05:47:26 +0200 (CEST) Received: from localhost ([::1]:60408 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nnBPh-0000Fb-CS for larch@yhetil.org; Fri, 06 May 2022 23:47:25 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:52022) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nnBOh-0000FT-5j for emacs-orgmode@gnu.org; Fri, 06 May 2022 23:46:23 -0400 Received: from mail-oi1-x230.google.com ([2607:f8b0:4864:20::230]:41595) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nnBOc-0003JK-KV for emacs-orgmode@gnu.org; Fri, 06 May 2022 23:46:22 -0400 Received: by mail-oi1-x230.google.com with SMTP id e189so9553887oia.8 for ; Fri, 06 May 2022 20:46:17 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:cc:subject:in-reply-to:references:date:message-id :mime-version; bh=iGdRP/YWKN9VHdPn9of/s7I+2HHPAmASrMU8EUsiKgI=; b=pCxX20N2JGVwkJRAW1FPpiKxtDty87lIpyc5Tc8bSbfSycerNWbu7iUtxGssqk5Km/ 1oezjT8ZxXM/Z7Qp6uPhgsgnkVEwwCu1OZGJzuRnpsVdsLa6JKVQVv7j6QxhT5QESIiS PJiCXPDSeAKEXWKnYIHnkFAVc3KKZWJ6UOZJtAVISXFXdMS9YFPzlC2rgbgC7jQyqrn3 Y7spQ6lW29aCFuZf/3DxF9BbTXzspJo5IzUev9N8F90H+P2PxwsZSMYkd3rdFf863DGi JnPyrfipOH8BPUdRS0+JBaZhrZUY4Pdge/qkQjrKlRDwt0u/LeJgIKnVa7SAPDqXEQIg e9QA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references:date :message-id:mime-version; bh=iGdRP/YWKN9VHdPn9of/s7I+2HHPAmASrMU8EUsiKgI=; b=nVFGmuEpeblLw61UhgKpiFdR5mL6moUkY0nHUqSn0CBoWiM6qoNU6YkJ63lZFqrmmi EXxpJVhcZanKjkhOHFsCl0Lj9Q9ZnNWLLSUkvRjKhsvhm82il9PCr9Xf/k+TIfR3yLZb zs0jYvbhdW/UliC8T9S+IAHU3lBuRBTzPs2qRR9MaYLo+wJPzpFCXs4x7g1PAVEEoCa5 +9bl5C+VsJlAgFW5yNThlj3L7/mN+SYN7R3+CfMGUCU5m6iQu2J2kHHbWi+L3KfFBNk6 t94fdk5baaJ0Beig+voPoXlH4Dq0M/41jKNZ+sAoCCDQT4+4+RPhxuXbyZX0oyHliLqa NkDQ== X-Gm-Message-State: AOAM530gfXfQTZNhKoaP8zCmQa5p1H7fh+PxwlwOjc2MOYb13gYLPSjq GDiV+OhYqYCP6iOazi113iY= X-Google-Smtp-Source: ABdhPJw1l4VqYuGPAHeRlBwTTutkgWeSHik6H4nHtbnlJ2qmsNDIELcOn/uty6RrMgyPf/XGiXDl6g== X-Received: by 2002:aca:abca:0:b0:325:b3f8:c778 with SMTP id u193-20020acaabca000000b00325b3f8c778mr3034347oie.189.1651895176682; Fri, 06 May 2022 20:46:16 -0700 (PDT) Received: from localhost ([104.223.98.2]) by smtp.gmail.com with ESMTPSA id c19-20020a4a3813000000b0035eb4e5a6cfsm2544148ooa.37.2022.05.06.20.46.09 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 06 May 2022 20:46:15 -0700 (PDT) From: Ihor Radchenko To: Anders Johansson Cc: org-mode-email Subject: [PATCH] Re: [Style] =?utf-8?Q?Shouldn=E2=80=99t?= the macros in org-fold-core have (indent 0) In-Reply-To: References: Date: Sat, 07 May 2022 11:46:29 +0800 Message-ID: <87r156ypgq.fsf@localhost> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=2607:f8b0:4864:20::230; envelope-from=yantar92@gmail.com; helo=mail-oi1-x230.google.com X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 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_ENVFROM_END_DIGIT=0.25, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Migadu-Flow: FLOW_IN X-Migadu-To: larch@yhetil.org X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1651895246; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=iGdRP/YWKN9VHdPn9of/s7I+2HHPAmASrMU8EUsiKgI=; b=AlHlcP1RIwKJL2oBooLtEGvZJ2rXLdUvO7chvfi6h97jpUcA3CV+6YMdEWBmyrOgvwfJNq fghy1WpcE357e/15KuiLni8K1fg9L80k1e02hhw7f0z3huL+odHnFvso3KDtMWMiyUX0FZ Ha22VnPWCt0cnSnvzppRshs9FPyuHLa013twg693bhejPmnk8LZ21I4CiRCoJg08CNZ2DN nFqQginW6qhFR3SsnHdyB77w2HFuEpQkR7D701ByjlAQJBbZaFruq4pwjaNl2vvSHOs4+O z1JB8U9HYX0wmluFHpVgpUujCWYoGHLQUnL7jjmKBIoAYzec0pZzY9y25TF8UA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1651895246; a=rsa-sha256; cv=none; b=FjDsSp2zRMHA6IJs/ArPlVpF1Fqdqiud5WSemJPgt96gZL6o/cHukS9SZTQ/TcVuJNg1zw PkLI32/OCo21gsQGbIZ4R2qfwNhNh6uTzgNosfmQSE/BXutp7glbO9LI395yc7GB6pbqRU xik3QUOlLBkIbrEDUF9NJPzGmwTlAlMzPy7yiyYciJ1TeX57Pj3lcAUMtPxftbKli1PeyY PXc72tXW8t30QY6s4wxUkNPa4SO8xbIsRFn3pr9gY+13tNPUwj0mSTX3knrZPbZzxT1MfG MGgm3HWhYlWZfP8BCcuVmVbfOLi9/l61NFajCZfKFmMVn+ee2MI+ffjy7yLroQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20210112 header.b=pCxX20N2; dmarc=pass (policy=none) header.from=gmail.com; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -3.93 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20210112 header.b=pCxX20N2; dmarc=pass (policy=none) header.from=gmail.com; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: 4647354A X-Spam-Score: -3.93 X-Migadu-Scanner: scn1.migadu.com X-TUID: LU4XdiAxW1iT --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Anders Johansson writes: > When looking through the code in org-fold-core (while debugging a tricky > problem that seems to be an interaction with org-modern, I may get back to > it) I noticed that all the macros that wrap a =E2=80=9Cbody=E2=80=9D argu= ment have (indent > 1), but I gather that they should have (indent 0), similar to for example > `with-silent-modifications`. Thanks for the heads up! This was just a blind kill-yank from a macro with extra arg. > I didn=E2=80=99t want to create a patch, since it would involve whitespac= e changes > on quite a lot of places, but I thought it could be good to highlight now > that org-fold just got merged. Still, it needs to be done. Attaching the patch with fixed indent statements and reindented code. Best, Ihor --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0001-Fix-macro-indentation-and-re-indent-code-misindented.patch Content-Transfer-Encoding: quoted-printable >From 6412cc974afa3a4701a784f331b7182278ba5bef Mon Sep 17 00:00:00 2001 Message-Id: <6412cc974afa3a4701a784f331b7182278ba5bef.1651895053.git.yantar= 92@gmail.com> From: Ihor Radchenko Date: Sat, 7 May 2022 11:34:10 +0800 Subject: [PATCH] Fix macro indentation and re-indent code misindented by nameless * lisp/org-fold-core.el (org-fold-core-cycle-over-indirect-buffers): (org-fold-core-ignore-modifications): (org-fold-core-ignore-fragility-checks): * lisp/org-macs.el (org-element-with-disabled-cache): Fix incorrect indentation declare statement. Body-only macros should use (indent 0) to avoid indenting first line differently from other body. * lisp/org-capture.el: * lisp/org-clock.el: * lisp/org-fold-core.el: * lisp/org-fold.el: * lisp/org-id.el: * lisp/org-list.el: * lisp/org-macs.el: * lisp/org.el: Reindent. Reported in https://orgmode.org/list/CAKJdtO_Z4LBGek3SUc6-a_Z0-dDd6L26_YfMY= pZTn7F92uxXJQ@mail.gmail.com --- lisp/org-capture.el | 2 +- lisp/org-clock.el | 58 ++-- lisp/org-element.el | 458 +++++++++++++++------------- lisp/org-fold-core.el | 140 ++++----- lisp/org-fold.el | 91 +++--- lisp/org-id.el | 48 +-- lisp/org-list.el | 90 +++--- lisp/org-macs.el | 2 +- lisp/org.el | 688 +++++++++++++++++++++--------------------- 9 files changed, 812 insertions(+), 765 deletions(-) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 068e3eda2..5ca4e1f2f 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -1174,7 +1174,7 @@ (defun org-capture-place-entry () (t (goto-char (point-max)) ;; Make sure that last point is not folded. (org-fold-core-cycle-over-indirect-buffers - (org-fold-region (max 1 (1- (point-max))) (point-max) nil)))) + (org-fold-region (max 1 (1- (point-max))) (point-max) nil)))) (let ((origin (point))) (unless (bolp) (insert "\n")) (org-capture-empty-lines-before) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index ec87aaf8a..e2c2688e1 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1582,8 +1582,8 @@ (defun org-clock-find-position (find-unclosed) (cond ((null positions) (org-fold-core-ignore-modifications - ;; Skip planning line and property drawer, if any. - (org-end-of-meta-data) + ;; Skip planning line and property drawer, if any. + (org-end-of-meta-data) (unless (bolp) (insert-and-inherit "\n")) ;; Create a new drawer if necessary. (when (and org-clock-into-drawer @@ -1607,28 +1607,28 @@ (defun org-clock-find-position (find-unclosed) ;; Skip planning line and property drawer, if any. (org-end-of-meta-data) (org-fold-core-ignore-modifications - (let ((beg (point))) - (insert-and-inherit - (mapconcat - (lambda (p) - (save-excursion - (goto-char p) - (org-trim (delete-and-extract-region - (save-excursion (skip-chars-backward " \r\t\n") - (line-beginning-position 2)) - (line-beginning-position 2))))) - positions "\n") - "\n:END:\n") - (let ((end (point-marker))) - (goto-char beg) - (save-excursion (insert-and-inherit ":" drawer ":\n")) - (org-fold-region (line-end-position) (1- end) t 'outline) - (org-indent-region (point) end) - (forward-line) - (unless org-log-states-order-reversed - (goto-char end) - (beginning-of-line -1)) - (set-marker end nil))))) + (let ((beg (point))) + (insert-and-inherit + (mapconcat + (lambda (p) + (save-excursion + (goto-char p) + (org-trim (delete-and-extract-region + (save-excursion (skip-chars-backward " \r\t\n") + (line-beginning-position 2)) + (line-beginning-position 2))))) + positions "\n") + "\n:END:\n") + (let ((end (point-marker))) + (goto-char beg) + (save-excursion (insert-and-inherit ":" drawer ":\n")) + (org-fold-region (line-end-position) (1- end) t 'outline) + (org-indent-region (point) end) + (forward-line) + (unless org-log-states-order-reversed + (goto-char end) + (beginning-of-line -1)) + (set-marker end nil))))) (org-log-states-order-reversed (goto-char (car (last positions)))) (t (goto-char (car positions)))))))) =20 @@ -1678,7 +1678,7 @@ (defun org-clock-out (&optional switch-to-state fail-= quietly at-time) (goto-char (match-end 0)) (delete-region (point) (point-at-eol)) (org-fold-core-ignore-modifications - (insert-and-inherit "--") + (insert-and-inherit "--") (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'ina= ctive)) (setq s (org-time-convert-to-integer (time-subtract @@ -1717,9 +1717,11 @@ (defun org-clock-out (&optional switch-to-state fail= -quietly at-time) (match-string 2)))) (when newstate (org-todo newstate)))) ((and org-clock-out-switch-to-state - (not (looking-at (concat org-outline-regexp "[ \t]*" - org-clock-out-switch-to-state - "\\>")))) + (not (looking-at + (concat + org-outline-regexp "[ \t]*" + org-clock-out-switch-to-state + "\\>")))) (org-todo org-clock-out-switch-to-state)))))) (force-mode-line-update) (message (if remove diff --git a/lisp/org-element.el b/lisp/org-element.el index 3856079aa..14c657287 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -646,8 +646,9 @@ (defun org-element-insert-before (element location) ;; Set appropriate :parent property. (org-element-put-property element :parent parent))) =20 -(defconst org-element--cache-element-properties '(:cached - :org-element--cache-sync-key) +(defconst org-element--cache-element-properties + '(:cached + :org-element--cache-sync-key) "List of element properties used internally by cache.") =20 (defun org-element-set-element (old new) @@ -1291,10 +1292,10 @@ (defun org-element-org-data-parser (&optional _) (let ((org-element-org-data-parser--recurse t)) (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (po= int-min) t) (org-element-with-disabled-cache - (let ((element (org-element-at-point-no-context= ))) - (when (eq (org-element-type element) 'keyword) - (throw 'buffer-category - (org-element-property :value element)))))))= )) + (let ((element (org-element-at-point-no-context))) + (when (eq (org-element-type element) 'keyword) + (throw 'buffer-category + (org-element-property :value element))))))))) category)) (properties (org-element--get-global-node-properties))) (unless (plist-get properties :CATEGORY) @@ -5416,18 +5417,19 @@ (defvar-local org-element--cache-sync-keys-value nil (defvar-local org-element--cache-change-tic nil "Last `buffer-chars-modified-tick' for registered changes.") =20 -(defvar org-element--cache-non-modifying-commands '(org-agenda - org-agenda-redo - org-sparse-tree - org-occur - org-columns - org-columns-redo - org-columns-new - org-columns-delete - org-columns-compute - org-columns-insert-dblock - org-agenda-columns - org-ctrl-c-ctrl-c) +(defvar org-element--cache-non-modifying-commands + '(org-agenda + org-agenda-redo + org-sparse-tree + org-occur + org-columns + org-columns-redo + org-columns-new + org-columns-delete + org-columns-compute + org-columns-insert-dblock + org-agenda-columns + org-ctrl-c-ctrl-c) "List of commands that are not expected to change the cache state. =20 This variable is used to determine when re-parsing buffer is not going @@ -5541,9 +5543,10 @@ (defsubst org-element--cache-key (element) (- begin 2) begin))))) (when org-element--cache-sync-requests - (org-element-put-property element - :org-element--cache-sync-key - (cons org-element--cache-sync-keys-value key))) + (org-element-put-property + element + :org-element--cache-sync-key + (cons org-element--cache-sync-keys-value key))) key))) =20 (defun org-element--cache-generate-key (lower upper) @@ -5698,7 +5701,7 @@ (defun org-element--cache-find (pos &optional side) (cond ((and limit (not (org-element--cache-key-less-p - (org-element--cache-key element) limit))) + (org-element--cache-key element) limit))) (setq node (avl-tree--node-left node))) ((> begin pos) (setq upper element @@ -5751,13 +5754,15 @@ (defun org-element--cache-put (element) (cond ((cdr keys) (org-element--cache-key (cdr keys))) (org-element--cache-sync-requests (org-element--request-key (car org-element--cache-sync-requests))= ))))) - (org-element-put-property element - :org-element--cache-sync-key - (cons org-element--cache-sync-keys-value new-key)))) + (org-element-put-property + element + :org-element--cache-sync-key + (cons org-element--cache-sync-keys-value new-key)))) (when (>=3D org-element--cache-diagnostics-level 2) - (org-element--cache-log-message "Added new element with %S key: %S" - (org-element-property :org-element--cache-sync-= key element) - (org-element--format-element element))) + (org-element--cache-log-message + "Added new element with %S key: %S" + (org-element-property :org-element--cache-sync-key element) + (org-element--format-element element))) (org-element-put-property element :cached t) (when (memq (org-element-type element) '(headline inlinetask)) (cl-incf org-element--headline-cache-size) @@ -5781,12 +5786,13 @@ (defsubst org-element--cache-remove (element) (progn ;; This should not happen, but if it is, would be better to know ;; where it happens. - (org-element--cache-warn "Failed to delete %S element in %S at %S.= The element cache key was %S. + (org-element--cache-warn + "Failed to delete %S element in %S at %S. The element cache key w= as %S. If this warning appears regularly, please report the warning text to Org m= ode mailing list (M-x org-submit-bug-report)." - (org-element-type element) - (current-buffer) - (org-element-property :begin element) - (org-element-property :org-element--cache-sync-key e= lement)) + (org-element-type element) + (current-buffer) + (org-element-property :begin element) + (org-element-property :org-element--cache-sync-key element)) (org-element-cache-reset) (throw 'quit nil)))) =20 @@ -5873,7 +5879,7 @@ (defun org-element--cache-sync (buffer &optional thre= shold future-change offset) ;; Check if the buffer have been changed outside visibility of ;; `org-element--cache-before-change' and `org-element--cache-after-= change'. (if (and (/=3D org-element--cache-change-tic - (buffer-chars-modified-tick)) + (buffer-chars-modified-tick)) org-element--cache-silent-modification-check ;; FIXME: Below is a heuristics noticed by observation. ;; quail.el with non-latin input does silent @@ -5901,16 +5907,17 @@ (defun org-element--cache-sync (buffer &optional th= reshold future-change offset) ;; warning to not irritate the users.) (not (version< emacs-version "28"))) (and (boundp 'org-batch-test) org-batch-test)) - (org-element--cache-warn "Unregistered buffer modifications = detected. Resetting. + (org-element--cache-warn + "Unregistered buffer modifications detected. Resetting. If this warning appears regularly, please report the warning text to Org m= ode mailing list (M-x org-submit-bug-report). The buffer is: %s\n Current command: %S\n Chars modified: %S\n Buffer modi= fied: %S\n Backtrace:\n%S" - (buffer-name (current-buffer)) - (list this-command (buffer-chars-modified-tick= ) (buffer-modified-tick)) - (buffer-chars-modified-tick) - (buffer-modified-tick) - (when (and (fboundp 'backtrace-get-frames) - (fboundp 'backtrace-to-string)) - (backtrace-to-string (backtrace-get-frames '= backtrace))))) + (buffer-name (current-buffer)) + (list this-command (buffer-chars-modified-tick) (buffer-mod= ified-tick)) + (buffer-chars-modified-tick) + (buffer-modified-tick) + (when (and (fboundp 'backtrace-get-frames) + (fboundp 'backtrace-to-string)) + (backtrace-to-string (backtrace-get-frames 'backtrace))))) (org-element-cache-reset)) (let ((inhibit-quit t) request next) (setq org-element--cache-interrupt-C-g-count 0) @@ -5941,9 +5948,10 @@ (defun org-element--cache-sync (buffer &optional thr= eshold future-change offset) ;; or phase 2 requests. We need to let them know ;; that additional shifting happened ahead of them. (cl-incf (org-element--request-offset next) (org-element--reque= st-offset request)) - (org-element--cache-log-message "Updating next request o= ffset to %S: %s" - (org-element--request-offset next) - (let ((print-length 10) (print-leve= l 3)) (prin1-to-string next))) + (org-element--cache-log-message + "Updating next request offset to %S: %s" + (org-element--request-offset next) + (let ((print-length 10) (print-level 3)) (prin1-to-stri= ng next))) ;; FIXME: END part of the request only matters for ;; phase 0 requests. However, the only possible ;; phase 0 request must be the first request in the @@ -5981,11 +5989,12 @@ (defun org-element--cache-process-request =20 Throw `org-element--cache-interrupt' if the process stops before completing the request." - (org-element--cache-log-message "org-element-cache: Processing request %= s up to %S-%S, next: %S" - (let ((print-length 10) (print-level 3)) (prin1-to-= string request)) - future-change - threshold - next-request-key) + (org-element--cache-log-message + "org-element-cache: Processing request %s up to %S-%S, next: %S" + (let ((print-length 10) (print-level 3)) (prin1-to-string request)) + future-change + threshold + next-request-key) (catch 'org-element--cache-quit (when (=3D (org-element--request-phase request) 0) ;; Phase 0. @@ -6045,18 +6054,20 @@ (defun org-element--cache-process-request ;; Done deleting everthing starting before END. ;; DATA-KEY is the first known element after END. ;; Move on to phase 1. - (org-element--cache-log-message "found element after= %S: %S::%S" - end - (org-element-property :org-elem= ent--cache-sync-key data) - (org-element--format-element da= ta)) + (org-element--cache-log-message + "found element after %S: %S::%S" + end + (org-element-property :org-element--cache-sync-key = data) + (org-element--format-element data)) (setf (org-element--request-key request) data-key) (setf (org-element--request-beg request) pos) (setf (org-element--request-phase request) 1) (throw 'org-element--cache-end-phase nil))) ;; No element starting after modifications left in ;; cache: further processing is futile. - (org-element--cache-log-message "Phase 0 deleted all eleme= nts in cache after %S!" - request-key) + (org-element--cache-log-message + "Phase 0 deleted all elements in cache after %S!" + request-key) (throw 'org-element--cache-quit t))))))) (when (=3D (org-element--request-phase request) 1) ;; Phase 1. @@ -6161,10 +6172,11 @@ (defun org-element--cache-process-request '(:contents-end :end :robust-end) '(:contents-end :end)))) (setq up (org-element-property :parent up))))) - (org-element--cache-log-message "New parent at %S: %S::%S" - limit - (org-element-property :org-element--= cache-sync-key parent) - (org-element--format-element parent)) + (org-element--cache-log-message + "New parent at %S: %S::%S" + limit + (org-element-property :org-element--cache-sync-key paren= t) + (org-element--format-element parent)) (setf (org-element--request-parent request) parent) (setf (org-element--request-phase request) 2)))))) ;; Phase 2. @@ -6284,19 +6296,21 @@ (defun org-element--cache-process-request (not (org-element-property :cached p)) ;; (not (avl-tree-member-p org-element= --cache p)) )))) - (org-element--cache-log-message "Updating parent in= %S\n Old parent: %S\n New parent: %S" - (org-element--format-element d= ata) - (org-element--format-element (= org-element-property :parent data)) - (org-element--format-element p= arent)) + (org-element--cache-log-message + "Updating parent in %S\n Old parent: %S\n New pare= nt: %S" + (org-element--format-element data) + (org-element--format-element (org-element-property= :parent data)) + (org-element--format-element parent)) (when (and (eq 'org-data (org-element-type parent)) (not (eq 'headline (org-element-type dat= a)))) ;; FIXME: This check is here to see whether ;; such error happens within ;; `org-element--cache-process-request' or somewh= ere ;; else. - (org-element--cache-warn "Added org-data parent t= o non-headline element: %S + (org-element--cache-warn + "Added org-data parent to non-headline element: = %S If this warning appears regularly, please report the warning text to Org m= ode mailing list (M-x org-submit-bug-report)." - data) + data) (org-element-cache-reset) (throw 'org-element--cache-quit t)) (org-element-put-property data :parent parent) @@ -6317,9 +6331,10 @@ (defun org-element--cache-process-request (pop stack))))))) ;; We reached end of tree: synchronization complete. t)) - (org-element--cache-log-message "org-element-cache: Finished process. Th= e cache size is %S. The remaining sync requests: %S" - org-element--cache-size - (let ((print-level 2)) (prin1-to-string org-element= --cache-sync-requests)))) + (org-element--cache-log-message + "org-element-cache: Finished process. The cache size is %S. The remaini= ng sync requests: %S" + org-element--cache-size + (let ((print-level 2)) (prin1-to-string org-element--cache-sync-request= s)))) =20 (defsubst org-element--open-end-p (element) "Check if ELEMENT in current buffer contains extra blank lines after @@ -6368,8 +6383,9 @@ (defun org-element--parse-to (pos &optional syncp tim= e-limit) (setq element (org-element-org-data-parser)) (unless (org-element-property :begin element) (org-element--cache-warn "Error parsing org-data. Got %S\nPle= ase report to Org mode mailing list (M-x org-submit-bug-report)." element)) - (org-element--cache-log-message "Nothing in cache. Adding org-d= ata: %S" - (org-element--format-element element)) + (org-element--cache-log-message + "Nothing in cache. Adding org-data: %S" + (org-element--format-element element)) (org-element--cache-put element) (goto-char (org-element-property :contents-begin element)) (setq mode 'org-data)) @@ -6441,9 +6457,9 @@ (defun org-element--parse-to (pos &optional syncp tim= e-limit) (org-skip-whitespace) (eobp)) (org-element-with-disabled-cache - (setq element (org-element--current-element - end 'element mode - (org-element-property :structure parent))))) + (setq element (org-element--current-element + end 'element mode + (org-element-property :structure parent))))) ;; Make sure that we return referenced element in cache ;; that can be altered directly. (if element @@ -6451,12 +6467,13 @@ (defun org-element--parse-to (pos &optional syncp t= ime-limit) ;; Nothing to parse (i.e. empty file). (throw 'exit parent)) (unless (or (not (org-element--cache-active-p)) parent) - (org-element--cache-warn "Got empty parent while parsing.= Please report it to Org mode mailing list (M-x org-submit-bug-report).\n B= acktrace:\n%S" - (when (and (fboundp 'backtrace-get-frames) - (fboundp 'backtrace-to-string)) - (backtrace-to-string (backtrace-get-frame= s 'backtrace)) - (org-element-cache-reset) - (error "org-element--cache: Emergency exi= t")))) + (org-element--cache-warn + "Got empty parent while parsing. Please report it to Org= mode mailing list (M-x org-submit-bug-report).\n Backtrace:\n%S" + (when (and (fboundp 'backtrace-get-frames) + (fboundp 'backtrace-to-string)) + (backtrace-to-string (backtrace-get-frames 'backtrace)) + (org-element-cache-reset) + (error "org-element--cache: Emergency exit")))) (org-element-put-property element :parent parent)) (let ((elem-end (org-element-property :end element)) (type (org-element-type element))) @@ -6645,9 +6662,10 @@ (defun org-element--cache-before-change (beg end) org-element--cache-change-warning-after) (t (or org-element--cache-change-warning-after org-element--cache-change-warning-before))))) - (org-element--cache-log-message "%S is about to modify text: wa= rning %S" - this-command - org-element--cache-change-warning))))))) + (org-element--cache-log-message + "%S is about to modify text: warning %S" + this-command + org-element--cache-change-warning))))))) =20 (defun org-element--cache-after-change (beg end pre) "Update buffer modifications for current buffer. @@ -6791,8 +6809,9 @@ (defun org-element--cache-for-removal (beg end offset) (org-element-property :robust-end up)) '(:contents-end :end :robust-end) '(:contents-end :end))) - (org-element--cache-log-message "Shifting end positions of= robust parent: %S" - (org-element--format-element up))) + (org-element--cache-log-message + "Shifting end positions of robust parent: %S" + (org-element--format-element up))) (unless (or ;; UP is non-robust. Yet, if UP is headline, flagging ;; everything inside for removal may be to @@ -6809,10 +6828,11 @@ (defun org-element--cache-for-removal (beg end offs= et) (not (> end (org-element-property :end up))) (let ((current (org-with-point-at (org-element-p= roperty :begin up) (org-element-with-disabled-cache - (org-element--current-eleme= nt (point-max)))))) + (org-element--current-element= (point-max)))))) (when (eq 'headline (org-element-type current)) - (org-element--cache-log-message "Found non-r= obust headline that can be updated individually: %S" - (org-element--format-el= ement current)) + (org-element--cache-log-message + "Found non-robust headline that can be upda= ted individually: %S" + (org-element--format-element current)) (org-element-set-element up current) t))) ;; If UP is org-data, the situation is similar to @@ -6823,11 +6843,13 @@ (defun org-element--cache-for-removal (beg end offs= et) (when (and (eq 'org-data (org-element-type up)) (>=3D beg (org-element-property :contents-= begin up))) (org-element-set-element up (org-with-point-at 1 (o= rg-element-org-data-parser))) - (org-element--cache-log-message "Found non-robust c= hange invalidating org-data. Re-parsing: %S" - (org-element--format-element u= p)) + (org-element--cache-log-message + "Found non-robust change invalidating org-data. Re= -parsing: %S" + (org-element--format-element up)) t)) - (org-element--cache-log-message "Found non-robust element: %= S" - (org-element--format-element up)) + (org-element--cache-log-message + "Found non-robust element: %S" + (org-element--format-element up)) (setq before up) (when robust-flag (setq robust-flag nil)))) (unless (or (org-element-property :parent up) @@ -6851,8 +6873,9 @@ (defun org-element--cache-submit-request (beg end off= set) BEG and END are buffer positions delimiting the minimal area where cache data should be removed. OFFSET is the size of the change, as an integer." - (org-element--cache-log-message "Submitting new synchronization request = for [%S..%S]=F0=9D=9D=99%S" - beg end offset) + (org-element--cache-log-message + "Submitting new synchronization request for [%S..%S]=F0=9D=9D=99%S" + beg end offset) (with-current-buffer (or (buffer-base-buffer (current-buffer)) (current-buffer)) (let ((next (car org-element--cache-sync-requests)) @@ -6885,38 +6908,49 @@ (defun org-element--cache-submit-request (beg end o= ffset) ;; also need to update the request. (let ((first (org-element--cache-for-removal delete-from e= nd offset) ; Shift as needed. )) - (org-element--cache-log-message "Current request is insi= de next. Candidate parent: %S" - (org-element--format-element first)) + (org-element--cache-log-message + "Current request is inside next. Candidate parent: %S" + (org-element--format-element first)) (when ;; Non-robust element is now before NEXT. Need to ;; update. (and first - (org-element--cache-key-less-p (org-element--ca= che-key first) - (org-element--request-key n= ext))) - (org-element--cache-log-message "Current request is in= side next. New parent: %S" - (org-element--format-element firs= t)) - (setf (org-element--request-key next) (org-element--ca= che-key first)) - (setf (org-element--request-beg next) (org-element-pro= perty :begin first)) - (setf (org-element--request-end next) (max (org-elemen= t-property :end first) - (org-element--request-= end next))) - (setf (org-element--request-parent next) (org-element-= property :parent first)))) + (org-element--cache-key-less-p + (org-element--cache-key first) + (org-element--request-key next))) + (org-element--cache-log-message + "Current request is inside next. New parent: %S" + (org-element--format-element first)) + (setf (org-element--request-key next) + (org-element--cache-key first)) + (setf (org-element--request-beg next) + (org-element-property :begin first)) + (setf (org-element--request-end next) + (max (org-element-property :end first) + (org-element--request-end next))) + (setf (org-element--request-parent next) + (org-element-property :parent first)))) ;; The current and NEXT modifications are intersecting ;; with current modification starting before NEXT and NEXT ;; ending after current. We need to update the common ;; non-robust parent for the new extended modification ;; region. (let ((first (org-element--cache-for-removal beg delete-to offset))) - (org-element--cache-log-message "Current request intersect= s with next. Candidate parent: %S" - (org-element--format-element first)) + (org-element--cache-log-message + "Current request intersects with next. Candidate parent: = %S" + (org-element--format-element first)) (when (and first - (org-element--cache-key-less-p (org-element--ca= che-key first) - (org-element--request-key n= ext))) - (org-element--cache-log-message "Current request interse= cts with next. Updating. New parent: %S" - (org-element--format-element first)) + (org-element--cache-key-less-p + (org-element--cache-key first) + (org-element--request-key next))) + (org-element--cache-log-message + "Current request intersects with next. Updating. New pa= rent: %S" + (org-element--format-element first)) (setf (org-element--request-key next) (org-element--cach= e-key first)) (setf (org-element--request-beg next) (org-element-prope= rty :begin first)) - (setf (org-element--request-end next) (max (org-element-= property :end first) - (org-element--request-en= d next))) + (setf (org-element--request-end next) + (max (org-element-property :end first) + (org-element--request-end next))) (setf (org-element--request-parent next) (org-element-pr= operty :parent first)))))) ;; Ensure cache is correct up to END. Also make sure that NEXT, ;; if any, is no longer a 0-phase request, thus ensuring that @@ -6974,23 +7008,26 @@ (defun org-element--cache-submit-request (beg end o= ffset) ;; element starting before END but after ;; beginning of first. ;; of the FIRST. - (org-element--cache-log-message "Extending to al= l elements between:\n 1: %S\n 2: %S" - (org-element--format-elemen= t first) - (org-element--format-elemen= t element)) + (org-element--cache-log-message + "Extending to all elements between:\n 1: %S\n 2= : %S" + (org-element--format-element first) + (org-element--format-element element)) (vector key first-beg element-end offset up 0))))) org-element--cache-sync-requests) ;; No element to remove. No need to re-parent either. ;; Simply shift additional elements, if any, by OFFSET. (if org-element--cache-sync-requests (progn - (org-element--cache-log-message "Nothing to remove. Upda= ting offset of the next request by =F0=9D=9D=99%S: %S" - offset - (let ((print-level 3)) - (car org-element--cache-sync-requ= ests))) + (org-element--cache-log-message + "Nothing to remove. Updating offset of the next request= by =F0=9D=9D=99%S: %S" + offset + (let ((print-level 3)) + (car org-element--cache-sync-requests))) (cl-incf (org-element--request-offset (car org-element--cache-s= ync-requests)) offset)) - (org-element--cache-log-message "Nothing to remove. No eleme= nts in cache after %S. Terminating." - end)))))) + (org-element--cache-log-message + "Nothing to remove. No elements in cache after %S. Terminat= ing." + end)))))) (setq org-element--cache-change-warning nil))) =20 (defun org-element--cache-verify-element (element) @@ -7002,11 +7039,13 @@ (defun org-element--cache-verify-element (element) (eq 'org-data (org-element-type element))) (org-element--cache-warn "Got element without parent (cache active?: %= S). Please report it to Org mode mailing list (M-x org-submit-bug-report).\= n%S" (org-element--cache-active-p) element) (org-element-cache-reset)) - (let ((org-element--cache-self-verify (or org-element--cache-self-verify - (and (boundp 'org-batch-test) org-batch-t= est))) - (org-element--cache-self-verify-frequency (if (and (boundp 'org-ba= tch-test) org-batch-test) - 1 - org-element--cache-self-verify-fr= equency))) + (let ((org-element--cache-self-verify + (or org-element--cache-self-verify + (and (boundp 'org-batch-test) org-batch-test))) + (org-element--cache-self-verify-frequency + (if (and (boundp 'org-batch-test) org-batch-test) + 1 + org-element--cache-self-verify-frequency))) (when (and org-element--cache-self-verify (org-element--cache-active-p) (derived-mode-p 'org-mode) @@ -7018,13 +7057,14 @@ (defun org-element--cache-verify-element (element) (org-element-with-disabled-cache (org-up-heading-or-point-min)) (unless (or (=3D (point) (org-element-property :begin (org-element= -property :parent element))) (eq (point) (point-min))) - (org-element--cache-warn "Cached element has wrong parent in %s.= Resetting. + (org-element--cache-warn + "Cached element has wrong parent in %s. Resetting. If this warning appears regularly, please report the warning text to Org m= ode mailing list (M-x org-submit-bug-report). The element is: %S\n The parent is: %S\n The real parent is: %S" - (buffer-name (current-buffer)) - (org-element--format-element element) - (org-element--format-element (org-element-property= :parent element)) - (org-element--format-element (org-element--current= -element (org-element-property :end (org-element-property :parent element))= ))) + (buffer-name (current-buffer)) + (org-element--format-element element) + (org-element--format-element (org-element-property :parent elem= ent)) + (org-element--format-element (org-element--current-element (org= -element-property :end (org-element-property :parent element))))) (org-element-cache-reset)) (org-element--cache-verify-element (org-element-property :parent e= lement)))) ;; Verify the element itself. @@ -7049,16 +7089,16 @@ (defun org-element--cache-verify-element (element) (org-element--cache-warn "(%S) Cached element is incorrect in %s= . (Cache tic up to date: %S) Resetting. If this warning appears regularly, please report the warning text to Org m= ode mailing list (M-x org-submit-bug-report). The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%= S\n%S" - this-command - (buffer-name (current-buffer)) - (if (/=3D org-element--cache-change-tic - (buffer-chars-modified-tick)) - "no" "yes") - (org-element--format-element element) - (org-element--format-element real-element) - (org-element--cache-find (1- (org-element-property= :begin real-element))) - (car (org-element--cache-find (org-element-propert= y :begin real-element) 'both)) - (cdr (org-element--cache-find (org-element-propert= y :begin real-element) 'both))) + this-command + (buffer-name (current-buffer)) + (if (/=3D org-element--cache-change-tic + (buffer-chars-modified-tick)) + "no" "yes") + (org-element--format-element element) + (org-element--format-element real-eleme= nt) + (org-element--cache-find (1- (org-eleme= nt-property :begin real-element))) + (car (org-element--cache-find (org-elem= ent-property :begin real-element) 'both)) + (cdr (org-element--cache-find (org-elem= ent-property :begin real-element) 'both))) (org-element-cache-reset)))))) =20 ;;; Cache persistance @@ -7174,8 +7214,8 @@ (defvar org-element-cache-map-continue-from nil function modified the buffer.") ;;;###autoload (cl-defun org-element-cache-map (func &key (granularity 'headline+inlineta= sk) restrict-elements - next-re fail-re from-pos (to-pos (point-max-mar= ker)) after-element limit-count - narrow) + next-re fail-re from-pos (to-pos (po= int-max-marker)) after-element limit-count + narrow) "Map all elements in current buffer with FUNC according to GRANULARITY. Collect non-nil return values into result list. =20 @@ -7245,27 +7285,27 @@ (cl-defun org-element-cache-map (func &key (granula= rity 'headline+inlinetask) re ;; Synchronise cache up to the end of mapped region. (org-element-at-point to-pos) (cl-macrolet ((cache-root - ;; Use the most optimal version of cache available. - () `(if (memq granularity '(headline headline+inlin= etask)) - (org-element--headline-cache-root) - (org-element--cache-root))) + ;; Use the most optimal version of cache available. + () `(if (memq granularity '(headline headline+inli= netask)) + (org-element--headline-cache-root) + (org-element--cache-root))) (cache-size - ;; Use the most optimal version of cache available. - () `(if (memq granularity '(headline headline+inlin= etask)) - org-element--headline-cache-size - org-element--cache-size)) + ;; Use the most optimal version of cache available. + () `(if (memq granularity '(headline headline+inli= netask)) + org-element--headline-cache-size + org-element--cache-size)) (cache-walk-restart - ;; Restart tree traversal after AVL tree re-balance. - () `(when node - (org-element-at-point (point-max)) - (setq node (cache-root) - stack (list nil) - leftp t - continue-flag t))) + ;; Restart tree traversal after AVL tree re-balanc= e. + () `(when node + (org-element-at-point (point-max)) + (setq node (cache-root) + stack (list nil) + leftp t + continue-flag t))) (cache-walk-abort - ;; Abort tree traversal. - () `(setq continue-flag t - node nil)) + ;; Abort tree traversal. + () `(setq continue-flag t + node nil)) (element-match-at-point ;; Returning the first element to match around poi= nt. ;; For example, if point is inside headline and @@ -7306,14 +7346,15 @@ (cl-defun org-element-cache-map (func &key (granula= rity 'headline+inlinetask) re ;; point. (move-start-to-next-match (re) `(save-match-data - (if (or (not ,re) (if org-element--cache-m= ap-statistics - (progn - (setq before-time (f= loat-time)) - (re-search-forward (= or (car-safe ,re) ,re) nil 'move) - (cl-incf re-search-t= ime - (- (float-t= ime) - before-t= ime))) - (re-search-forward (or (= car-safe ,re) ,re) nil 'move))) + (if (or (not ,re) + (if org-element--cache-map-statist= ics + (progn + (setq before-time (float-tim= e)) + (re-search-forward (or (car-= safe ,re) ,re) nil 'move) + (cl-incf re-search-time + (- (float-time) + before-time))) + (re-search-forward (or (car-safe= ,re) ,re) nil 'move))) (unless (or (< (point) (or start -1)) (and data (< (point) (org-eleme= nt-property :begin data)))) @@ -7476,8 +7517,8 @@ (cl-defun org-element-cache-map (func &key (granulari= ty 'headline+inlinetask) re ;; PREV. (or (not prev) (not (org-element--cache-key-less-p - (org-element--cache-key data) - (org-element--cache-key prev)))) + (org-element--cache-key data) + (org-element--cache-key prev)))) ;; ... or when we are before START. (or (not start) (not (> start (org-element-property :begin da= ta))))) @@ -7497,8 +7538,8 @@ (cl-defun org-element-cache-map (func &key (granulari= ty 'headline+inlinetask) re ;; and need to fill it. (unless (or (and start (< (org-element-property :begin d= ata) start)) (and prev (not (org-element--cache-key-less-p - (org-element--cache-key prev) - (org-element--cache-key data))))) + (org-element--cache-key prev) + (org-element--cache-key data))))) ;; DATA is at of after START and PREV. (if (or (not start) (=3D (org-element-property :begin data) s= tart)) ;; DATA is at START. Match it. @@ -7711,13 +7752,14 @@ (defun org-element-at-point (&optional pom cached-o= nly) (condition-case err (org-element--parse-to pom) (error - (org-element--cache-warn "Org parser error in %s::%= S. Resetting.\n The error was: %S\n Backtrace:\n%S\n Please report this to = Org mode mailing list (M-x org-submit-bug-report)." - (buffer-name (current-buffer)) - pom - err - (when (and (fboundp 'backtrace-get-fr= ames) - (fboundp 'backtrace-to-str= ing)) - (backtrace-to-string (backtrace-get= -frames 'backtrace)))) + (org-element--cache-warn + "Org parser error in %s::%S. Resetting.\n The erro= r was: %S\n Backtrace:\n%S\n Please report this to Org mode mailing list (M= -x org-submit-bug-report)." + (buffer-name (current-buffer)) + pom + err + (when (and (fboundp 'backtrace-get-frames) + (fboundp 'backtrace-to-string)) + (backtrace-to-string (backtrace-get-frames 'back= trace)))) (org-element-cache-reset) (org-element--parse-to pom))))) (when (and (org-element--cache-active-p) @@ -7872,7 +7914,7 @@ (defun org-element-context (&optional element) (and (=3D pos cend) (or (=3D (point-max) pos) (not (memq (char-before pos) - '(?\s ?\t))))))) + '(?\s ?\t))))))) (goto-char cbeg) (narrow-to-region (point) cend) (setq parent next) @@ -7996,36 +8038,36 @@ (defun org-element-swap-A-B--text-properties (elem-= A elem-B) (when (and specialp (or (not (eq (org-element-type elem-B) 'paragraph)) (/=3D (org-element-property :begin elem-B) - (org-element-property :contents-begin elem-B)))) + (org-element-property :contents-begin elem-B)))) (error "Cannot swap elements")) ;; In a special situation, ELEM-A will have no indentation. We'll ;; give it ELEM-B's (which will in, in turn, have no indentation). (org-fold-core-ignore-modifications ;; Preserve folding state - (let* ((ind-B (when specialp - (goto-char (org-element-property :begin elem-B)) - (current-indentation))) - (beg-A (org-element-property :begin elem-A)) - (end-A (save-excursion - (goto-char (org-element-property :end elem-A)) - (skip-chars-backward " \r\t\n") - (point-at-eol))) - (beg-B (org-element-property :begin elem-B)) - (end-B (save-excursion - (goto-char (org-element-property :end elem-B)) - (skip-chars-backward " \r\t\n") - (point-at-eol))) - ;; Get contents. - (body-A (buffer-substring beg-A end-A)) - (body-B (delete-and-extract-region beg-B end-B))) - (goto-char beg-B) - (when specialp - (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) - (indent-to-column ind-B)) - (insert body-A) - (goto-char beg-A) - (delete-region beg-A end-A) - (insert body-B) - (goto-char (org-element-property :end elem-B)))))) + (let* ((ind-B (when specialp + (goto-char (org-element-property :begin elem-B)) + (current-indentation))) + (beg-A (org-element-property :begin elem-A)) + (end-A (save-excursion + (goto-char (org-element-property :end elem-A)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + (beg-B (org-element-property :begin elem-B)) + (end-B (save-excursion + (goto-char (org-element-property :end elem-B)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + ;; Get contents. + (body-A (buffer-substring beg-A end-A)) + (body-B (delete-and-extract-region beg-B end-B))) + (goto-char beg-B) + (when specialp + (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) + (indent-to-column ind-B)) + (insert body-A) + (goto-char beg-A) + (delete-region beg-A end-A) + (insert body-B) + (goto-char (org-element-property :end elem-B)))))) (defsubst org-element-swap-A-B (elem-A elem-B) "Swap elements ELEM-A and ELEM-B. Assume ELEM-B is after ELEM-A in the buffer. Leave point at the diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index 6786009ec..be2b044ff 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -365,7 +365,7 @@ ;;; Core functionality ;;;; Folding specs =20 (defvar-local org-fold-core--specs '((org-fold-visible - (:visible . t) + (:visible . t) (:alias . (visible))) (org-fold-hidden (:ellipsis . "...") @@ -512,7 +512,7 @@ (defmacro org-fold-core-cycle-over-indirect-buffers (&r= est body) =20 Also, make sure that folding properties from killed buffers are not hanging around." - (declare (debug (form body)) (indent 1)) + (declare (debug (form body)) (indent 0)) `(let (buffers dead-properties) (if (and (not (buffer-base-buffer)) (not (eq (current-buffer) (car org-fold-core--indirect-buffe= rs)))) @@ -590,7 +590,7 @@ (defun org-fold-core--property-symbol-get-create (spec = &optional buffer return-o (setq-local org-fold-core--indirect-buffers (let (bufs) (org-fold-core-cycle-over-indirect-buffe= rs - (push (current-buffer) bufs)) + (push (current-buffer) bufs)) (push buf bufs) (delete-dups bufs))))) ;; Copy all the old folding properties to preserve the fol= ding state @@ -623,25 +623,25 @@ (defun org-fold-core--property-symbol-get-create (spe= c &optional buffer return-o ;; parameters. (let (full-prop-list) (org-fold-core-cycle-over-indirect-buffers - (setq full-prop-list - (append full-prop-list - (delq nil - (mapcar (lambda (spec) - (cond - ((org-fold-core-get= -folding-spec-property spec :front-sticky) - (cons (org-fold-co= re--property-symbol-get-create spec nil 'return-only) - nil)) - ((org-fold-core-get= -folding-spec-property spec :rear-sticky) - nil) - (t - (cons (org-fold-co= re--property-symbol-get-create spec nil 'return-only) - t)))) - (org-fold-core-folding= -spec-list)))))) + (setq full-prop-list + (append full-prop-list + (delq nil + (mapcar (lambda (spec) + (cond + ((org-fold-core-get-f= olding-spec-property spec :front-sticky) + (cons (org-fold-core= --property-symbol-get-create spec nil 'return-only) + nil)) + ((org-fold-core-get-f= olding-spec-property spec :rear-sticky) + nil) + (t + (cons (org-fold-core= --property-symbol-get-create spec nil 'return-only) + t)))) + (org-fold-core-folding-s= pec-list)))))) (org-fold-core-cycle-over-indirect-buffers - (setq-local text-property-default-nonsticky - (delete-dups (append - text-property-default-no= nsticky - full-prop-list))))))))))= )))) + (setq-local text-property-default-nonsticky + (delete-dups (append + text-property-default-nons= ticky + full-prop-list))))))))))))= )) =20 (defun org-fold-core-decouple-indirect-buffer-folds () "Copy and decouple folding state in a newly created indirect buffer. @@ -1177,14 +1177,14 @@ (defvar org-fold-core--ignore-fragility-checks nil =20 (defmacro org-fold-core-ignore-modifications (&rest body) "Run BODY ignoring buffer modifications in `org-fold-core--fix-folded-re= gion'." - (declare (debug (form body)) (indent 1)) + (declare (debug (form body)) (indent 0)) `(let ((org-fold-core--ignore-modifications t)) (unwind-protect (progn ,@body) (setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-= modified-tick))))) =20 (defmacro org-fold-core-ignore-fragility-checks (&rest body) "Run BODY skipping :fragility checks in `org-fold-core--fix-folded-regio= n'." - (declare (debug (form body)) (indent 1)) + (declare (debug (form body)) (indent 0)) `(let ((org-fold-core--ignore-fragility-checks t)) (progn ,@body))) =20 @@ -1215,53 +1215,53 @@ (defun org-fold-core--fix-folded-region (from to _) ;; buffer. Work around Emacs bug#46982. (when (eq org-fold-core-style 'text-properties) (org-fold-core-cycle-over-indirect-buffers - ;; Re-hide text inserted in the middle/font/back of a folded - ;; region. - (unless (equal from to) ; Ignore deletions. - (dolist (spec (org-fold-core-folding-spec-list)) - ;; Reveal fully invisible text inserted in the middle - ;; of visible portion of the buffer. This is needed, - ;; for example, when there was a deletion in a folded - ;; heading, the heading was unfolded, end `undo' was - ;; called. The `undo' would insert the folded text. - (when (and (or (eq from (point-min)) - (not (org-fold-core-folded-p (1- from) spec= ))) - (or (eq to (point-max)) - (not (org-fold-core-folded-p to spec))) - (org-fold-core-region-folded-p from to spec)) - (org-fold-core-region from to nil spec)) - ;; Look around and fold the new text if the nearby folds a= re - ;; sticky. - (unless (org-fold-core-region-folded-p from to spec) - (let ((spec-to (org-fold-core-get-folding-spec spec (min to (1-= (point-max))))) - (spec-from (org-fold-core-get-folding-spec spec (max (point-min)= (1- from))))) - ;; Reveal folds around undoed deletion. - (when undo-in-progress - (let ((lregion (org-fold-core-get-region-at-point sp= ec (max (point-min) (1- from)))) - (rregion (org-fold-core-get-region-at-point sp= ec (min to (1- (point-max)))))) - (if (and lregion rregion) - (org-fold-core-region (car lregion) (cdr rregi= on) nil spec) - (when lregion - (org-fold-core-region (car lregion) (cdr lregi= on) nil spec)) - (when rregion - (org-fold-core-region (car rregion) (cdr rregi= on) nil spec))))) - ;; Hide text inserted in the middle of a fold. - (when (and (or spec-from (eq from (point-min))) - (or spec-to (eq to (point-max))) - (or spec-from spec-to) - (eq spec-to spec-from) - (or (org-fold-core-get-folding-spec-propert= y spec :front-sticky) - (org-fold-core-get-folding-spec-propert= y spec :rear-sticky))) - (unless (and (eq from (point-min)) (eq to (point-max= ))) ; Buffer content replaced. - (org-fold-core-region from to t (or spec-from spec-to)))) - ;; Hide text inserted at the end of a fold. - (when (and spec-from (org-fold-core-get-folding-spec-p= roperty spec-from :rear-sticky)) - (org-fold-core-region from to t spec-from)) - ;; Hide text inserted in front of a fold. - (when (and spec-to - (not (eq to (point-max))) ; Text inserted a= t the end of buffer is not prepended anywhere. - (org-fold-core-get-folding-spec-property sp= ec-to :front-sticky)) - (org-fold-core-region from to t spec-to)))))))) + ;; Re-hide text inserted in the middle/font/back of a folded + ;; region. + (unless (equal from to) ; Ignore deletions. + (dolist (spec (org-fold-core-folding-spec-list)) + ;; Reveal fully invisible text inserted in the middle + ;; of visible portion of the buffer. This is needed, + ;; for example, when there was a deletion in a folded + ;; heading, the heading was unfolded, end `undo' was + ;; called. The `undo' would insert the folded text. + (when (and (or (eq from (point-min)) + (not (org-fold-core-folded-p (1- from) spec))) + (or (eq to (point-max)) + (not (org-fold-core-folded-p to spec))) + (org-fold-core-region-folded-p from to spec)) + (org-fold-core-region from to nil spec)) + ;; Look around and fold the new text if the nearby folds are + ;; sticky. + (unless (org-fold-core-region-folded-p from to spec) + (let ((spec-to (org-fold-core-get-folding-spec spec (min to (1- (= point-max))))) + (spec-from (org-fold-core-get-folding-spec spec (max (point-min) (= 1- from))))) + ;; Reveal folds around undoed deletion. + (when undo-in-progress + (let ((lregion (org-fold-core-get-region-at-point spec= (max (point-min) (1- from)))) + (rregion (org-fold-core-get-region-at-point spec= (min to (1- (point-max)))))) + (if (and lregion rregion) + (org-fold-core-region (car lregion) (cdr rregion= ) nil spec) + (when lregion + (org-fold-core-region (car lregion) (cdr lregion= ) nil spec)) + (when rregion + (org-fold-core-region (car rregion) (cdr rregion= ) nil spec))))) + ;; Hide text inserted in the middle of a fold. + (when (and (or spec-from (eq from (point-min))) + (or spec-to (eq to (point-max))) + (or spec-from spec-to) + (eq spec-to spec-from) + (or (org-fold-core-get-folding-spec-property = spec :front-sticky) + (org-fold-core-get-folding-spec-property = spec :rear-sticky))) + (unless (and (eq from (point-min)) (eq to (point-max))= ) ; Buffer content replaced. + (org-fold-core-region from to t (or spec-from spec-to)))) + ;; Hide text inserted at the end of a fold. + (when (and spec-from (org-fold-core-get-folding-spec-pro= perty spec-from :rear-sticky)) + (org-fold-core-region from to t spec-from)) + ;; Hide text inserted in front of a fold. + (when (and spec-to + (not (eq to (point-max))) ; Text inserted at = the end of buffer is not prepended anywhere. + (org-fold-core-get-folding-spec-property spec= -to :front-sticky)) + (org-fold-core-region from to t spec-to)))))))) ;; Process all the folded text between `from' and `to'. Do it ;; only in current buffer to avoid verifying semantic structure ;; multiple times in indirect buffers that have exactly same diff --git a/lisp/org-fold.el b/lisp/org-fold.el index 5085778dc..afde89bed 100644 --- a/lisp/org-fold.el +++ b/lisp/org-fold.el @@ -215,34 +215,35 @@ (defun org-fold-initialize (ellipsis) ;; this until there will be no need to convert text properties to ;; overlays for isearch. (setq-local org-fold-core--isearch-special-specs '(org-link)) - (org-fold-core-initialize `((org-fold-outline - (:ellipsis . ,ellipsis) - (:fragile . ,#'org-fold--reveal-outline-maybe) - (:isearch-open . t) - ;; This is needed to make sure that inserting a - ;; new planning line in folded heading is not - ;; revealed. - (:front-sticky . t) - (:rear-sticky . t) - (:font-lock-skip . t) - (:alias . (headline heading outline inlinetask plai= n-list))) - (org-fold-block - (:ellipsis . ,ellipsis) - (:fragile . ,#'org-fold--reveal-drawer-or-block-may= be) - (:isearch-open . t) - (:front-sticky . t) - (:alias . ( block center-block comment-block - dynamic-block example-block export-block - quote-block special-block src-block - verse-block))) - (org-fold-drawer - (:ellipsis . ,ellipsis) - (:fragile . ,#'org-fold--reveal-drawer-or-block-may= be) - (:isearch-open . t) - (:front-sticky . t) - (:alias . (drawer property-drawer))) - ,org-link--description-folding-spec - ,org-link--link-folding-spec))) + (org-fold-core-initialize + `((org-fold-outline + (:ellipsis . ,ellipsis) + (:fragile . ,#'org-fold--reveal-outline-maybe) + (:isearch-open . t) + ;; This is needed to make sure that inserting a + ;; new planning line in folded heading is not + ;; revealed. + (:front-sticky . t) + (:rear-sticky . t) + (:font-lock-skip . t) + (:alias . (headline heading outline inlinetask plain-list))) + (org-fold-block + (:ellipsis . ,ellipsis) + (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe) + (:isearch-open . t) + (:front-sticky . t) + (:alias . ( block center-block comment-block + dynamic-block example-block export-block + quote-block special-block src-block + verse-block))) + (org-fold-drawer + (:ellipsis . ,ellipsis) + (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe) + (:isearch-open . t) + (:front-sticky . t) + (:alias . (drawer property-drawer))) + ,org-link--description-folding-spec + ,org-link--link-folding-spec))) =20 ;;;; Searching and examining folded text =20 @@ -461,10 +462,11 @@ (defun org-fold-hide-entry () (defun org-fold-subtree (flag) (save-excursion (org-back-to-heading t) - (org-fold-region (line-end-position) - (progn (org-end-of-subtree t) (point)) - flag - 'outline))) + (org-fold-region + (line-end-position) + (progn (org-end-of-subtree t) (point)) + flag + 'outline))) =20 ;; Replaces `outline-hide-subtree'. (defun org-fold-hide-subtree () @@ -940,18 +942,19 @@ (defun org-fold--reveal-outline-maybe (region _) (beginning-of-line) ;; Make sure that headline is not partially hidden (unless (org-fold-folded-p nil 'headline) - (org-fold-region (max (point-min) (1- (point))) - (let ((endl (line-end-position))) - (save-excursion - (goto-char endl) - (skip-chars-forward "\n\t\r ") - ;; Unfold blank lines. - (if (or (and (looking-at-p "\\*") - (> (point) (1+ endl))) - (eq (point) (point-max))) - (point) - endl))) - nil 'headline)) + (org-fold-region + (max (point-min) (1- (point))) + (let ((endl (line-end-position))) + (save-excursion + (goto-char endl) + (skip-chars-forward "\n\t\r ") + ;; Unfold blank lines. + (if (or (and (looking-at-p "\\*") + (> (point) (1+ endl))) + (eq (point) (point-max))) + (point) + endl))) + nil 'headline)) ;; Never hide level 1 headlines (save-excursion (goto-char (line-end-position)) diff --git a/lisp/org-id.el b/lisp/org-id.el index 0331b7c1d..42b165681 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -525,30 +525,30 @@ (defun org-id-update-id-locations (&optional files si= lent) (i 0)) (with-temp-buffer (org-element-with-disabled-cache - (delay-mode-hooks - (org-mode) - (dolist (file files) - (when (file-exists-p file) - (unless silent - (cl-incf i) - (message "Finding ID locations (%d/%d files): %s" i nfil= es file)) - (insert-file-contents file nil nil nil 'replace) - (let ((ids nil) - (case-fold-search t)) - (org-with-point-at 1 - (while (re-search-forward id-regexp nil t) - (when (org-at-property-p) - (push (org-entry-get (point) "ID") ids))) - (when ids - (push (cons (abbreviate-file-name file) ids) - org-id-locations) - (dolist (id ids) - (cond - ((not (member id seen-ids)) (push id seen-ids)) - (silent nil) - (t - (message "Duplicate ID %S" id) - (cl-incf ndup)))))))))))) + (delay-mode-hooks + (org-mode) + (dolist (file files) + (when (file-exists-p file) + (unless silent + (cl-incf i) + (message "Finding ID locations (%d/%d files): %s" i nfiles= file)) + (insert-file-contents file nil nil nil 'replace) + (let ((ids nil) + (case-fold-search t)) + (org-with-point-at 1 + (while (re-search-forward id-regexp nil t) + (when (org-at-property-p) + (push (org-entry-get (point) "ID") ids))) + (when ids + (push (cons (abbreviate-file-name file) ids) + org-id-locations) + (dolist (id ids) + (cond + ((not (member id seen-ids)) (push id seen-ids)) + (silent nil) + (t + (message "Duplicate ID %S" id) + (cl-incf ndup)))))))))))) (setq org-id-files (mapcar #'car org-id-locations)) (org-id-locations-save) ;; Now convert to a hash table. diff --git a/lisp/org-list.el b/lisp/org-list.el index f72151460..515763036 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1092,51 +1092,51 @@ (defun org-list-swap-items--text-properties (beg-A = beg-B struct) This function modifies STRUCT." (save-excursion (org-fold-core-ignore-modifications - (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A s= truct)) - (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) - (end-A (org-list-get-item-end beg-A struct)) - (end-B (org-list-get-item-end beg-B struct)) - (size-A (- end-A-no-blank beg-A)) - (size-B (- end-B-no-blank beg-B)) - (body-A (buffer-substring beg-A end-A-no-blank)) - (body-B (buffer-substring beg-B end-B-no-blank)) - (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)) - (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) - (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))) - ;; 1. Move effectively items in buffer. - (goto-char beg-A) - (delete-region beg-A end-B-no-blank) - (insert (concat body-B between-A-no-blank-and-B body-A)) - ;; 2. Now modify struct. No need to re-read the list, the - ;; transformation is just a shift of positions. Some special - ;; attention is required for items ending at END-A and END-B - ;; as empty spaces are not moved there. In others words, - ;; item BEG-A will end with whitespaces that were at the end - ;; of BEG-B and the same applies to BEG-B. - (dolist (e struct) - (let ((pos (car e))) - (cond - ((< pos beg-A)) - ((memq pos sub-A) - (let ((end-e (nth 6 e))) - (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) - (setcar (nthcdr 6 e) - (+ end-e (- end-B-no-blank end-A-no-blank))) - (when (=3D end-e end-A) (setcar (nthcdr 6 e) end-B)))) - ((memq pos sub-B) - (let ((end-e (nth 6 e))) - (setcar e (- (+ pos beg-A) beg-B)) - (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) - (when (=3D end-e end-B) - (setcar (nthcdr 6 e) - (+ beg-A size-B (- end-A end-A-no-blank)))))) - ((< pos beg-B) - (let ((end-e (nth 6 e))) - (setcar e (+ pos (- size-B size-A))) - (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) - (setq struct (sort struct #'car-less-than-car)) - ;; Return structure. - struct)))) + (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A str= uct)) + (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) + (end-A (org-list-get-item-end beg-A struct)) + (end-B (org-list-get-item-end beg-B struct)) + (size-A (- end-A-no-blank beg-A)) + (size-B (- end-B-no-blank beg-B)) + (body-A (buffer-substring beg-A end-A-no-blank)) + (body-B (buffer-substring beg-B end-B-no-blank)) + (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)) + (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) + (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))) + ;; 1. Move effectively items in buffer. + (goto-char beg-A) + (delete-region beg-A end-B-no-blank) + (insert (concat body-B between-A-no-blank-and-B body-A)) + ;; 2. Now modify struct. No need to re-read the list, the + ;; transformation is just a shift of positions. Some special + ;; attention is required for items ending at END-A and END-B + ;; as empty spaces are not moved there. In others words, + ;; item BEG-A will end with whitespaces that were at the end + ;; of BEG-B and the same applies to BEG-B. + (dolist (e struct) + (let ((pos (car e))) + (cond + ((< pos beg-A)) + ((memq pos sub-A) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) + (setcar (nthcdr 6 e) + (+ end-e (- end-B-no-blank end-A-no-blank))) + (when (=3D end-e end-A) (setcar (nthcdr 6 e) end-B)))) + ((memq pos sub-B) + (let ((end-e (nth 6 e))) + (setcar e (- (+ pos beg-A) beg-B)) + (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) + (when (=3D end-e end-B) + (setcar (nthcdr 6 e) + (+ beg-A size-B (- end-A end-A-no-blank)))))) + ((< pos beg-B) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- size-B size-A))) + (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) + (setq struct (sort struct #'car-less-than-car)) + ;; Return structure. + struct)))) (defun org-list-swap-items--overlays (beg-A beg-B struct) "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. =20 diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 8535bf2cd..10eed2686 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -181,7 +181,7 @@ (defmacro org-no-popups (&rest body) =20 (defmacro org-element-with-disabled-cache (&rest body) "Run BODY without active org-element-cache." - (declare (debug (form body)) (indent 1)) + (declare (debug (form body)) (indent 0)) `(cl-letf (((symbol-function #'org-element--cache-active-p) (lambda (&re= st _) nil))) ,@body)) =20 diff --git a/lisp/org.el b/lisp/org.el index 1d5fc3903..5601bcee8 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -6445,7 +6445,7 @@ (defun org-demote () (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) (diff (abs (- level (length down-head) -1)))) (org-fold-core-ignore-fragility-checks - (replace-match (apply #'propertize down-head (text-properties-at = (match-beginning 0))) t) + (replace-match (apply #'propertize down-head (text-properties-at (m= atch-beginning 0))) t) (when org-auto-align-tags (org-align-tags)) (when org-adapt-indentation (org-fixup-indentation diff))) (run-hooks 'org-after-demote-entry-hook)))) @@ -6859,81 +6859,81 @@ (defun org-paste-subtree (&optional level tree for-= yank remove) "The kill is not a (set of) tree(s). Use `\\[yank]' to yank anyway"= ))) (org-with-limited-levels (org-fold-core-ignore-fragility-checks - (let* ((visp (not (org-invisible-p))) - (txt tree) - (old-level (if (string-match org-outline-regexp-bol txt) - (- (match-end 0) (match-beginning 0) 1) - -1)) - (force-level - (cond - (level (prefix-numeric-value level)) - ;; When point is after the stars in an otherwise empty - ;; headline, use the number of stars as the forced level. - ((and (org-match-line "^\\*+[ \t]*$") - (not (eq ?* (char-after)))) - (org-outline-level)) - ((looking-at-p org-outline-regexp-bol) (org-outline-level)))) - (previous-level - (save-excursion - (org-previous-visible-heading 1) - (if (org-at-heading-p) (org-outline-level) 1))) - (next-level - (save-excursion - (if (org-at-heading-p) (org-outline-level) - (org-next-visible-heading 1) - (if (org-at-heading-p) (org-outline-level) 1)))) - (new-level (or force-level (max previous-level next-level))) - (shift (if (or (=3D old-level -1) - (=3D new-level -1) - (=3D old-level new-level)) - 0 - (- new-level old-level))) - (delta (if (> shift 0) -1 1)) - (func (if (> shift 0) #'org-demote #'org-promote)) - (org-odd-levels-only nil) - beg end newend) - ;; Remove the forced level indicator. - (when (and force-level (not level)) - (delete-region (line-beginning-position) (point))) - ;; Paste before the next visible heading or at end of buffer, - ;; unless point is at the beginning of a headline. - (unless (and (bolp) (org-at-heading-p)) - (org-next-visible-heading 1) - (unless (bolp) (insert "\n"))) + (let* ((visp (not (org-invisible-p))) + (txt tree) + (old-level (if (string-match org-outline-regexp-bol txt) + (- (match-end 0) (match-beginning 0) 1) + -1)) + (force-level + (cond + (level (prefix-numeric-value level)) + ;; When point is after the stars in an otherwise empty + ;; headline, use the number of stars as the forced level. + ((and (org-match-line "^\\*+[ \t]*$") + (not (eq ?* (char-after)))) + (org-outline-level)) + ((looking-at-p org-outline-regexp-bol) (org-outline-level)))) + (previous-level + (save-excursion + (org-previous-visible-heading 1) + (if (org-at-heading-p) (org-outline-level) 1))) + (next-level + (save-excursion + (if (org-at-heading-p) (org-outline-level) + (org-next-visible-heading 1) + (if (org-at-heading-p) (org-outline-level) 1)))) + (new-level (or force-level (max previous-level next-level))) + (shift (if (or (=3D old-level -1) + (=3D new-level -1) + (=3D old-level new-level)) + 0 + (- new-level old-level))) + (delta (if (> shift 0) -1 1)) + (func (if (> shift 0) #'org-demote #'org-promote)) + (org-odd-levels-only nil) + beg end newend) + ;; Remove the forced level indicator. + (when (and force-level (not level)) + (delete-region (line-beginning-position) (point))) + ;; Paste before the next visible heading or at end of buffer, + ;; unless point is at the beginning of a headline. + (unless (and (bolp) (org-at-heading-p)) + (org-next-visible-heading 1) + (unless (bolp) (insert "\n"))) + (setq beg (point)) + ;; Avoid re-parsing cache elements when i.e. level 1 heading + ;; is inserted and then promoted. + (combine-change-calls beg beg + (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) + (insert-before-markers txt) + (unless (string-suffix-p "\n" txt) (insert "\n")) + (setq newend (point)) + (org-reinstall-markers-in-region beg) + (setq end (point)) + (goto-char beg) + (skip-chars-forward " \t\n\r") (setq beg (point)) - ;; Avoid re-parsing cache elements when i.e. level 1 heading - ;; is inserted and then promoted. - (combine-change-calls beg beg - (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt= )) - (insert-before-markers txt) - (unless (string-suffix-p "\n" txt) (insert "\n")) - (setq newend (point)) - (org-reinstall-markers-in-region beg) - (setq end (point)) - (goto-char beg) - (skip-chars-forward " \t\n\r") - (setq beg (point)) - (when (and (org-invisible-p) visp) - (save-excursion (org-fold-heading nil))) - ;; Shift if necessary. - (unless (=3D shift 0) - (save-restriction - (narrow-to-region beg end) - (while (not (=3D shift 0)) - (org-map-region func (point-min) (point-max)) - (setq shift (+ delta shift))) - (goto-char (point-min)) - (setq newend (point-max))))) - (when (or for-yank (called-interactively-p 'interactive)) - (message "Clipboard pasted as level %d subtree" new-level)) - (when (and (not for-yank) ; in this case, org-yank will decide ab= out folding - kill-ring - (equal org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (org-fold-subtree t)) - (when for-yank (goto-char newend)) - (when remove (pop kill-ring)))))) + (when (and (org-invisible-p) visp) + (save-excursion (org-fold-heading nil))) + ;; Shift if necessary. + (unless (=3D shift 0) + (save-restriction + (narrow-to-region beg end) + (while (not (=3D shift 0)) + (org-map-region func (point-min) (point-max)) + (setq shift (+ delta shift))) + (goto-char (point-min)) + (setq newend (point-max))))) + (when (or for-yank (called-interactively-p 'interactive)) + (message "Clipboard pasted as level %d subtree" new-level)) + (when (and (not for-yank) ; in this case, org-yank will decide abou= t folding + kill-ring + (equal org-subtree-clip (current-kill 0)) + org-subtree-clip-folded) + ;; The tree was folded before it was killed/copied + (org-fold-subtree t)) + (when for-yank (goto-char newend)) + (when remove (pop kill-ring)))))) =20 (defun org-kill-is-subtree-p (&optional txt) "Check if the current kill is an outline subtree, or a set of trees. @@ -8905,16 +8905,16 @@ (defun org-todo (&optional arg) ((eq arg 'right) ;; Next state (if this - (if tail (car tail) nil) - (car org-todo-keywords-1))) + (if tail (car tail) nil) + (car org-todo-keywords-1))) ((eq arg 'left) ;; Previous state (unless (equal member org-todo-keywords-1) - (if this + (if this (nth (- (length org-todo-keywords-1) (length tail) 2) - org-todo-keywords-1) - (org-last org-todo-keywords-1)))) + org-todo-keywords-1) + (org-last org-todo-keywords-1)))) (arg ;; User or caller requests a specific state. (cond @@ -8922,15 +8922,15 @@ (defun org-todo (&optional arg) ((eq arg 'none) nil) ((eq arg 'done) (or done-word (car org-done-keywords))) ((eq arg 'nextset) - (or (car (cdr (member head org-todo-heads))) + (or (car (cdr (member head org-todo-heads))) (car org-todo-heads))) ((eq arg 'previousset) - (let ((org-todo-heads (reverse org-todo-heads))) - (or (car (cdr (member head org-todo-heads))) + (let ((org-todo-heads (reverse org-todo-heads))) + (or (car (cdr (member head org-todo-heads))) (car org-todo-heads)))) ((car (member arg org-todo-keywords-1))) ((stringp arg) - (user-error "State `%s' not valid in this file" arg)) + (user-error "State `%s' not valid in this file" arg)) ((nth (1- (prefix-numeric-value arg)) org-todo-keywords-1)))) ((and org-todo-key-trigger org-use-fast-todo-selection) @@ -8941,10 +8941,10 @@ (defun org-todo (&optional arg) ((null tail) nil) ;-> first entry ((memq interpret '(type priority)) (if (eq this-command last-command) - (car tail) - (if (> (length tail) 0) + (car tail) + (if (> (length tail) 0) (or done-word (car org-done-keywords)) - nil))) + nil))) (t (car tail)))) (org-state (or @@ -8976,7 +8976,7 @@ (defun org-todo (&optional arg) (throw 'exit nil))))) (store-match-data match-data) (org-fold-core-ignore-modifications - (goto-char (match-beginning 0)) + (goto-char (match-beginning 0)) (replace-match "") ;; We need to use `insert-before-markers-and-inherit' ;; because: (1) We want to preserve the folding state @@ -8987,8 +8987,8 @@ (defun org-todo (&optional arg) (insert-before-markers-and-inherit next) (unless (org-invisible-p (line-beginning-position)) (org-fold-region (line-beginning-position) - (line-end-position) - nil))) + (line-end-position) + nil))) (cond ((and org-state (equal this org-state)) (message "TODO state was already %s" (org-trim next))) ((not (pos-visible-in-window-p hl-pos)) @@ -9730,81 +9730,81 @@ (defun org--deadline-or-schedule (arg type time) TYPE is either `deadline' or `scheduled'. See `org-deadline' or `org-schedule' for information about ARG and TIME arguments." (org-fold-core-ignore-modifications - (let* ((deadline? (eq type 'deadline)) - (keyword (if deadline? org-deadline-string org-scheduled-string)) - (log (if deadline? org-log-redeadline org-log-reschedule)) - (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) - (old-date-time (and old-date (org-time-string-to-time old-date))) - ;; Save repeater cookie from either TIME or current scheduled - ;; time stamp. We are going to insert it back at the end of - ;; the process. - (repeater (or (and (org-string-nw-p time) - ;; We use `org-repeat-re' because we need - ;; to tell the difference between a real - ;; repeater and a time delta, e.g. "+2d". - (string-match org-repeat-re time) - (match-string 1 time)) - (and (org-string-nw-p old-date) - (string-match "\\([.+-]+[0-9]+[hdwmy]\ + (let* ((deadline? (eq type 'deadline)) + (keyword (if deadline? org-deadline-string org-scheduled-string)) + (log (if deadline? org-log-redeadline org-log-reschedule)) + (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) + (old-date-time (and old-date (org-time-string-to-time old-date))) + ;; Save repeater cookie from either TIME or current scheduled + ;; time stamp. We are going to insert it back at the end of + ;; the process. + (repeater (or (and (org-string-nw-p time) + ;; We use `org-repeat-re' because we need + ;; to tell the difference between a real + ;; repeater and a time delta, e.g. "+2d". + (string-match org-repeat-re time) + (match-string 1 time)) + (and (org-string-nw-p old-date) + (string-match "\\([.+-]+[0-9]+[hdwmy]\ \\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)" - old-date) - (match-string 1 old-date))))) - (pcase arg - (`(4) - (if (not old-date) - (message (if deadline? "Entry had no deadline to remove" - "Entry was not scheduled")) - (when (and old-date log) - (org-add-log-setup (if deadline? 'deldeadline 'delschedule) - nil old-date log)) - (org-remove-timestamp-with-keyword keyword) - (message (if deadline? "Entry no longer has a deadline." - "Entry is no longer scheduled.")))) - (`(16) - (save-excursion + old-date) + (match-string 1 old-date))))) + (pcase arg + (`(4) + (if (not old-date) + (message (if deadline? "Entry had no deadline to remove" + "Entry was not scheduled")) + (when (and old-date log) + (org-add-log-setup (if deadline? 'deldeadline 'delschedule) + nil old-date log)) + (org-remove-timestamp-with-keyword keyword) + (message (if deadline? "Entry no longer has a deadline." + "Entry is no longer scheduled.")))) + (`(16) + (save-excursion + (org-back-to-heading t) + (let ((regexp (if deadline? org-deadline-time-regexp + org-scheduled-time-regexp))) + (if (not (re-search-forward regexp (line-end-position 2) t)) + (user-error (if deadline? "No deadline information to update" + "No scheduled information to update")) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) + (msg (if deadline? "Warn starting from" "Delay until"))) + (replace-match + (concat keyword + " <" rpl + (format " -%dd" + (abs (- (time-to-days + (save-match-data + (org-read-date + nil t nil msg old-date-time))) + (time-to-days old-date-time)))) + ">") t t)))))) + (_ + (org-add-planning-info type time 'closed) + (when (and old-date + log + (not (equal old-date org-last-inserted-timestamp))) + (org-add-log-setup (if deadline? 'redeadline 'reschedule) + org-last-inserted-timestamp + old-date + log)) + (when repeater + (save-excursion (org-back-to-heading t) - (let ((regexp (if deadline? org-deadline-time-regexp - org-scheduled-time-regexp))) - (if (not (re-search-forward regexp (line-end-position 2) t)) - (user-error (if deadline? "No deadline information to update" - "No scheduled information to update")) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) - (msg (if deadline? "Warn starting from" "Delay until"))) - (replace-match - (concat keyword - " <" rpl - (format " -%dd" - (abs (- (time-to-days - (save-match-data - (org-read-date - nil t nil msg old-date-time))) - (time-to-days old-date-time)))) - ">") t t)))))) - (_ - (org-add-planning-info type time 'closed) - (when (and old-date - log - (not (equal old-date org-last-inserted-timestamp))) - (org-add-log-setup (if deadline? 'redeadline 'reschedule) - org-last-inserted-timestamp - old-date - log)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward - (concat keyword " " org-last-inserted-timestamp) - (line-end-position 2) - t) - (goto-char (1- (match-end 0))) - (insert-and-inherit " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message (if deadline? "Deadline on %s" "Scheduled to %s") - org-last-inserted-timestamp)))))) + (when (re-search-forward + (concat keyword " " org-last-inserted-timestamp) + (line-end-position 2) + t) + (goto-char (1- (match-end 0))) + (insert-and-inherit " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message (if deadline? "Deadline on %s" "Scheduled to %s") + org-last-inserted-timestamp)))))) =20 (defun org-deadline (arg &optional time) "Insert a \"DEADLINE:\" string with a timestamp to make a deadline. @@ -9910,101 +9910,101 @@ (defun org-add-planning-info (what &optional time= &rest remove) a date. REMOVE indicates what kind of entries to remove. An old WHAT entry will also be removed." (org-fold-core-ignore-modifications - (let (org-time-was-given org-end-time-was-given default-time default= -input) - (when (and (memq what '(scheduled deadline)) - (or (not time) - (and (stringp time) - (string-match "^[-+]+[0-9]" time)))) - ;; Try to get a default date/time from existing timestamp - (save-excursion - (org-back-to-heading t) - (let ((end (save-excursion (outline-next-heading) (point))) ts) - (when (re-search-forward (if (eq what 'scheduled) - org-scheduled-time-regexp - org-deadline-time-regexp) - end t) - (setq ts (match-string 1) - default-time (org-time-string-to-time ts) - default-input (and ts (org-get-compact-tod ts))))))) - (when what - (setq time - (if (stringp time) - ;; This is a string (relative or absolute), set - ;; proper date. - (apply #'encode-time - (org-read-date-analyze - time default-time (decode-time default-time))) - ;; If necessary, get the time from the user - (or time (org-read-date nil 'to-time nil - (cl-case what - (deadline "DEADLINE") - (scheduled "SCHEDULED") - (otherwise nil)) - default-time default-input))))) - (org-with-wide-buffer - (org-back-to-heading t) - (let ((planning? (save-excursion - (forward-line) - (looking-at-p org-planning-line-re)))) - (cond - (planning? - (forward-line) - ;; Move to current indentation. - (skip-chars-forward " \t") - ;; Check if we have to remove something. - (dolist (type (if what (cons what remove) remove)) + (let (org-time-was-given org-end-time-was-given default-time default-i= nput) + (when (and (memq what '(scheduled deadline)) + (or (not time) + (and (stringp time) + (string-match "^[-+]+[0-9]" time)))) + ;; Try to get a default date/time from existing timestamp + (save-excursion + (org-back-to-heading t) + (let ((end (save-excursion (outline-next-heading) (point))) ts) + (when (re-search-forward (if (eq what 'scheduled) + org-scheduled-time-regexp + org-deadline-time-regexp) + end t) + (setq ts (match-string 1) + default-time (org-time-string-to-time ts) + default-input (and ts (org-get-compact-tod ts))))))) + (when what + (setq time + (if (stringp time) + ;; This is a string (relative or absolute), set + ;; proper date. + (apply #'encode-time + (org-read-date-analyze + time default-time (decode-time default-time))) + ;; If necessary, get the time from the user + (or time (org-read-date nil 'to-time nil + (cl-case what + (deadline "DEADLINE") + (scheduled "SCHEDULED") + (otherwise nil)) + default-time default-input))))) + (org-with-wide-buffer + (org-back-to-heading t) + (let ((planning? (save-excursion + (forward-line) + (looking-at-p org-planning-line-re)))) + (cond + (planning? + (forward-line) + ;; Move to current indentation. + (skip-chars-forward " \t") + ;; Check if we have to remove something. + (dolist (type (if what (cons what remove) remove)) + (save-excursion + (when (re-search-forward + (cl-case type + (closed org-closed-time-regexp) + (deadline org-deadline-time-regexp) + (scheduled org-scheduled-time-regexp) + (otherwise (error "Invalid planning type: %s" type))) + (line-end-position) + t) + ;; Delete until next keyword or end of line. + (delete-region + (match-beginning 0) + (if (re-search-forward org-keyword-time-not-clock-regexp + (line-end-position) + t) + (match-beginning 0) + (line-end-position)))))) + ;; If there is nothing more to add and no more keyword is + ;; left, remove the line completely. + (if (and (looking-at-p "[ \t]*$") (not what)) + (delete-region (line-end-position 0) + (line-end-position)) + ;; If we removed last keyword, do not leave trailing white + ;; space at the end of line. + (let ((p (point))) (save-excursion - (when (re-search-forward - (cl-case type - (closed org-closed-time-regexp) - (deadline org-deadline-time-regexp) - (scheduled org-scheduled-time-regexp) - (otherwise (error "Invalid planning type: %s" type))) - (line-end-position) - t) - ;; Delete until next keyword or end of line. - (delete-region - (match-beginning 0) - (if (re-search-forward org-keyword-time-not-clock-regexp - (line-end-position) - t) - (match-beginning 0) - (line-end-position)))))) - ;; If there is nothing more to add and no more keyword is - ;; left, remove the line completely. - (if (and (looking-at-p "[ \t]*$") (not what)) - (delete-region (line-end-position 0) - (line-end-position)) - ;; If we removed last keyword, do not leave trailing white - ;; space at the end of line. - (let ((p (point))) - (save-excursion - (end-of-line) - (unless (=3D (skip-chars-backward " \t" p) 0) - (delete-region (point) (line-end-position))))))) - (what - (end-of-line) - (insert-and-inherit "\n") - (when org-adapt-indentation - (indent-to-column (1+ (org-outline-level))))) - (t nil))) - (when what - ;; Insert planning keyword. - (insert-and-inherit (cl-case what - (closed org-closed-string) - (deadline org-deadline-string) - (scheduled org-scheduled-string) - (otherwise (error "Invalid planning type: %s" what))) - " ") - ;; Insert associated timestamp. - (let ((ts (org-insert-time-stamp - time - (or org-time-was-given - (and (eq what 'closed) org-log-done-with-time)) - (eq what 'closed) - nil nil (list org-end-time-was-given)))) - (unless (eolp) (insert " ")) - ts)))))) + (end-of-line) + (unless (=3D (skip-chars-backward " \t" p) 0) + (delete-region (point) (line-end-position))))))) + (what + (end-of-line) + (insert-and-inherit "\n") + (when org-adapt-indentation + (indent-to-column (1+ (org-outline-level))))) + (t nil))) + (when what + ;; Insert planning keyword. + (insert-and-inherit (cl-case what + (closed org-closed-string) + (deadline org-deadline-string) + (scheduled org-scheduled-string) + (otherwise (error "Invalid planning type: %s" what))) + " ") + ;; Insert associated timestamp. + (let ((ts (org-insert-time-stamp + time + (or org-time-was-given + (and (eq what 'closed) org-log-done-with-time)) + (eq what 'closed) + nil nil (list org-end-time-was-given)))) + (unless (eolp) (insert " ")) + ts)))))) =20 (defvar org-log-note-marker (make-marker) "Marker pointing at the entry where the note is to be inserted.") @@ -10061,7 +10061,7 @@ (defun org-log-beginning (&optional create) ;; continuity. (when (org-at-heading-p) (backward-char)) (org-fold-core-ignore-modifications - (unless (bolp) (insert-and-inherit "\n")) + (unless (bolp) (insert-and-inherit "\n")) (let ((beg (point))) (insert-and-inherit ":" drawer ":\n:END:\n") (org-indent-region beg (point)) @@ -10201,34 +10201,34 @@ (defun org-store-log-note () (when (and lines (not org-note-abort)) (with-current-buffer (marker-buffer org-log-note-marker) (org-fold-core-ignore-modifications - (org-with-wide-buffer - ;; Find location for the new note. - (goto-char org-log-note-marker) - (set-marker org-log-note-marker nil) - ;; Note associated to a clock is to be located right after - ;; the clock. Do not move point. - (unless (eq org-log-note-purpose 'clock-out) - (goto-char (org-log-beginning t))) - ;; Make sure point is at the beginning of an empty line. - (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert-and-inherit= "\n"))) - ((looking-at "[ \t]*\\S-") (save-excursion (insert-and-inherit= "\n")))) - ;; In an existing list, add a new item at the top level. - ;; Otherwise, indent line like a regular one. - (let ((itemp (org-in-item-p))) - (if itemp - (indent-line-to - (let ((struct (save-excursion - (goto-char itemp) (org-list-struct)))) - (org-list-get-ind (org-list-get-top-point struct) struct))) - (org-indent-line))) - (insert-and-inherit (org-list-bullet-string "-") (pop lines)) - (let ((ind (org-list-item-body-column (line-beginning-position)))) - (dolist (line lines) - (insert-and-inherit "\n") - (indent-line-to ind) - (insert-and-inherit line))) - (message "Note stored") - (org-back-to-heading t)))))) + (org-with-wide-buffer + ;; Find location for the new note. + (goto-char org-log-note-marker) + (set-marker org-log-note-marker nil) + ;; Note associated to a clock is to be located right after + ;; the clock. Do not move point. + (unless (eq org-log-note-purpose 'clock-out) + (goto-char (org-log-beginning t))) + ;; Make sure point is at the beginning of an empty line. + (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert-and-inherit "= \n"))) + ((looking-at "[ \t]*\\S-") (save-excursion (insert-and-inherit "= \n")))) + ;; In an existing list, add a new item at the top level. + ;; Otherwise, indent line like a regular one. + (let ((itemp (org-in-item-p))) + (if itemp + (indent-line-to + (let ((struct (save-excursion + (goto-char itemp) (org-list-struct)))) + (org-list-get-ind (org-list-get-top-point struct) struct))) + (org-indent-line))) + (insert-and-inherit (org-list-bullet-string "-") (pop lines)) + (let ((ind (org-list-item-body-column (line-beginning-position)))) + (dolist (line lines) + (insert-and-inherit "\n") + (indent-line-to ind) + (insert-and-inherit line))) + (message "Note stored") + (org-back-to-heading t)))))) ;; Don't add undo information when called from `org-agenda-todo'. (set-window-configuration org-log-note-window-configuration) (with-current-buffer (marker-buffer org-log-note-return-to) @@ -11360,34 +11360,34 @@ (defun org-set-tags (tags) This function assumes point is on a headline." (org-with-wide-buffer (org-fold-core-ignore-modifications - (let ((tags (pcase tags - ((pred listp) tags) - ((pred stringp) (split-string (org-trim tags) ":" t)) - (_ (error "Invalid tag specification: %S" tags)))) - (old-tags (org-get-tags nil t)) - (tags-change? nil)) - (when (functionp org-tags-sort-function) - (setq tags (sort tags org-tags-sort-function))) - (setq tags-change? (not (equal tags old-tags))) - (when tags-change? - ;; Delete previous tags and any trailing white space. - (goto-char (if (org-match-line org-tag-line-re) (match-beginnin= g 1) - (line-end-position))) - (skip-chars-backward " \t") - (delete-region (point) (line-end-position)) - ;; Deleting white spaces may break an otherwise empty headline. - ;; Re-introduce one space in this case. - (unless (org-at-heading-p) (insert " ")) - (when tags - (save-excursion (insert-and-inherit " " (org-make-tag-string tags))) - ;; When text is being inserted on an invisible region - ;; boundary, it can be inadvertently sucked into - ;; invisibility. - (unless (org-invisible-p (line-beginning-position)) - (org-fold-region (point) (line-end-position) nil 'outline)))) - ;; Align tags, if any. - (when tags (org-align-tags)) - (when tags-change? (run-hooks 'org-after-tags-change-hook)))))) + (let ((tags (pcase tags + ((pred listp) tags) + ((pred stringp) (split-string (org-trim tags) ":" t)) + (_ (error "Invalid tag specification: %S" tags)))) + (old-tags (org-get-tags nil t)) + (tags-change? nil)) + (when (functionp org-tags-sort-function) + (setq tags (sort tags org-tags-sort-function))) + (setq tags-change? (not (equal tags old-tags))) + (when tags-change? + ;; Delete previous tags and any trailing white space. + (goto-char (if (org-match-line org-tag-line-re) (match-beginning = 1) + (line-end-position))) + (skip-chars-backward " \t") + (delete-region (point) (line-end-position)) + ;; Deleting white spaces may break an otherwise empty headline. + ;; Re-introduce one space in this case. + (unless (org-at-heading-p) (insert " ")) + (when tags + (save-excursion (insert-and-inherit " " (org-make-tag-string tags))) + ;; When text is being inserted on an invisible region + ;; boundary, it can be inadvertently sucked into + ;; invisibility. + (unless (org-invisible-p (line-beginning-position)) + (org-fold-region (point) (line-end-position) nil 'outline)))) + ;; Align tags, if any. + (when tags (org-align-tags)) + (when tags-change? (run-hooks 'org-after-tags-change-hook)))))) =20 (defun org-change-tag-in-region (beg end tag off) "Add or remove TAG for each entry in the region. @@ -12582,19 +12582,19 @@ (defun org-entry-put (pom property value) (error "The %s property cannot be set with `org-entry-put'" property)) (t (org-fold-core-ignore-modifications - (let* ((range (org-get-property-block beg 'force)) - (end (cdr range)) - (case-fold-search t)) - (goto-char (car range)) - (if (re-search-forward (org-re-property property nil t) end t) - (progn (delete-region (match-beginning 0) (match-end 0)) - (goto-char (match-beginning 0))) - (goto-char end) - (insert-and-inherit "\n") - (backward-char)) - (insert-and-inherit ":" property ":") - (when value (insert-and-inherit " " value)) - (org-indent-line)))))) + (let* ((range (org-get-property-block beg 'force)) + (end (cdr range)) + (case-fold-search t)) + (goto-char (car range)) + (if (re-search-forward (org-re-property property nil t) end t) + (progn (delete-region (match-beginning 0) (match-end 0)) + (goto-char (match-beginning 0))) + (goto-char end) + (insert-and-inherit "\n") + (backward-char)) + (insert-and-inherit ":" property ":") + (when value (insert-and-inherit " " value)) + (org-indent-line)))))) (run-hook-with-args 'org-property-changed-functions property value)))) =20 (defun org-buffer-property-keys (&optional specials defaults columns) @@ -13749,23 +13749,23 @@ (defun org-insert-time-stamp (time &optional with= -hm inactive pre post extra) stamp. The command returns the inserted time stamp." (org-fold-core-ignore-modifications - (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) - stamp) - (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) - (insert-before-markers-and-inherit (or pre "")) - (when (listp extra) - (setq extra (car extra)) - (if (and (stringp extra) - (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) - (setq extra (format "-%02d:%02d" - (string-to-number (match-string 1 extra)) - (string-to-number (match-string 2 extra)))) - (setq extra nil))) - (when extra - (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1))= )) - (insert-before-markers-and-inherit (setq stamp (format-time-string= fmt time))) - (insert-before-markers-and-inherit (or post "")) - (setq org-last-inserted-timestamp stamp)))) + (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) + stamp) + (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) + (insert-before-markers-and-inherit (or pre "")) + (when (listp extra) + (setq extra (car extra)) + (if (and (stringp extra) + (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) + (setq extra (format "-%02d:%02d" + (string-to-number (match-string 1 extra)) + (string-to-number (match-string 2 extra)))) + (setq extra nil))) + (when extra + (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) + (insert-before-markers-and-inherit (setq stamp (format-time-string f= mt time))) + (insert-before-markers-and-inherit (or post "")) + (setq org-last-inserted-timestamp stamp)))) =20 (defun org-toggle-time-stamp-overlays () "Toggle the use of custom time stamp formats." --=20 2.35.1 --=-=-=--