* [PATCH] Re: [Style] Shouldn’t the macros in org-fold-core have (indent 0)
2022-05-05 15:55 [Style] Shouldn’t the macros in org-fold-core have (indent 0) Anders Johansson
@ 2022-05-07 3:46 ` Ihor Radchenko
2022-05-14 8:59 ` Ihor Radchenko
0 siblings, 1 reply; 3+ messages in thread
From: Ihor Radchenko @ 2022-05-07 3:46 UTC (permalink / raw)
To: Anders Johansson; +Cc: org-mode-email
[-- Attachment #1: Type: text/plain, Size: 800 bytes --]
Anders Johansson <mejlaandersj@gmail.com> 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 “body” argument 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’t want to create a patch, since it would involve whitespace 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
[-- Attachment #2: 0001-Fix-macro-indentation-and-re-indent-code-misindented.patch --]
[-- Type: text/x-patch, Size: 113722 bytes --]
From 6412cc974afa3a4701a784f331b7182278ba5bef Mon Sep 17 00:00:00 2001
Message-Id: <6412cc974afa3a4701a784f331b7182278ba5bef.1651895053.git.yantar92@gmail.com>
From: Ihor Radchenko <yantar92@gmail.com>
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_YfMYpZTn7F92uxXJQ@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))))))))
@@ -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 'inactive))
(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)))
-(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.")
(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:" (point-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.")
-(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.
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)))
(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 (>= 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 was %S.
If this warning appears regularly, please report the warning text to Org mode 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 element))
+ (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))))
@@ -5873,7 +5879,7 @@ (defun org-element--cache-sync (buffer &optional threshold 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 (/= 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 threshold 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 mode mailing list (M-x org-submit-bug-report).
The buffer is: %s\n Current command: %S\n Chars modified: %S\n Buffer modified: %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-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)))))
(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 threshold 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--request-offset request))
- (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-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-string 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
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 (= (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-element--cache-sync-key data)
- (org-element--format-element data))
+ (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 elements 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 (= (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 parent)
+ (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 data)
- (org-element--format-element (org-element-property :parent data))
- (org-element--format-element parent))
+ (org-element--cache-log-message
+ "Updating parent in %S\n Old parent: %S\n New parent: %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 data))))
;; FIXME: This check is here to see whether
;; such error happens within
;; `org-element--cache-process-request' or somewhere
;; else.
- (org-element--cache-warn "Added org-data parent to 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 mode 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. The 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 remaining sync requests: %S"
+ org-element--cache-size
+ (let ((print-level 2)) (prin1-to-string org-element--cache-sync-requests))))
(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 time-limit)
(setq element (org-element-org-data-parser))
(unless (org-element-property :begin element)
(org-element--cache-warn "Error parsing org-data. Got %S\nPlease report to Org mode mailing list (M-x org-submit-bug-report)." element))
- (org-element--cache-log-message "Nothing in cache. Adding org-data: %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 time-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 time-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 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--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: warning %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)))))))
(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 offset)
(not (> end (org-element-property :end up)))
(let ((current (org-with-point-at (org-element-property :begin up)
(org-element-with-disabled-cache
- (org-element--current-element (point-max))))))
+ (org-element--current-element (point-max))))))
(when (eq 'headline (org-element-type current))
- (org-element--cache-log-message "Found non-robust headline that can be updated individually: %S"
- (org-element--format-element current))
+ (org-element--cache-log-message
+ "Found non-robust headline that can be updated 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 offset)
(when (and (eq 'org-data (org-element-type up))
(>= beg (org-element-property :contents-begin up)))
(org-element-set-element up (org-with-point-at 1 (org-element-org-data-parser)))
- (org-element--cache-log-message "Found non-robust change invalidating org-data. Re-parsing: %S"
- (org-element--format-element up))
+ (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 offset)
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]𝝙%S"
- beg end offset)
+ (org-element--cache-log-message
+ "Submitting new synchronization request for [%S..%S]𝝙%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 offset)
;; also need to update the request.
(let ((first (org-element--cache-for-removal delete-from end offset) ; Shift as needed.
))
- (org-element--cache-log-message "Current request is inside 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--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))))
+ (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 intersects 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--cache-key first)
- (org-element--request-key next)))
- (org-element--cache-log-message "Current request intersects 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 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-end next)
+ (max (org-element-property :end first)
+ (org-element--request-end next)))
(setf (org-element--request-parent next) (org-element-property :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 offset)
;; element starting before END but after
;; beginning of first.
;; of the FIRST.
- (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))
+ (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. Updating offset of the next request by 𝝙%S: %S"
- offset
- (let ((print-level 3))
- (car org-element--cache-sync-requests)))
+ (org-element--cache-log-message
+ "Nothing to remove. Updating offset of the next request by 𝝙%S: %S"
+ offset
+ (let ((print-level 3))
+ (car org-element--cache-sync-requests)))
(cl-incf (org-element--request-offset (car org-element--cache-sync-requests))
offset))
- (org-element--cache-log-message "Nothing to remove. No elements in cache after %S. Terminating."
- end))))))
+ (org-element--cache-log-message
+ "Nothing to remove. No elements in cache after %S. Terminating."
+ end))))))
(setq org-element--cache-change-warning nil)))
(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-test)))
- (org-element--cache-self-verify-frequency (if (and (boundp 'org-batch-test) org-batch-test)
- 1
- org-element--cache-self-verify-frequency)))
+ (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 (= (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 mode 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 element))
+ (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 element))))
;; 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 mode 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 (/= 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-property :begin real-element) 'both))
- (cdr (org-element--cache-find (org-element-property :begin real-element) 'both)))
+ this-command
+ (buffer-name (current-buffer))
+ (if (/= 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-property :begin real-element) 'both))
+ (cdr (org-element--cache-find (org-element-property :begin real-element) 'both)))
(org-element-cache-reset))))))
;;; 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+inlinetask) restrict-elements
- next-re fail-re from-pos (to-pos (point-max-marker)) after-element limit-count
- narrow)
+ next-re fail-re from-pos (to-pos (point-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.
@@ -7245,27 +7285,27 @@ (cl-defun org-element-cache-map (func &key (granularity '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+inlinetask))
- (org-element--headline-cache-root)
- (org-element--cache-root)))
+ ;; Use the most optimal version of cache available.
+ () `(if (memq granularity '(headline headline+inlinetask))
+ (org-element--headline-cache-root)
+ (org-element--cache-root)))
(cache-size
- ;; Use the most optimal version of cache available.
- () `(if (memq granularity '(headline headline+inlinetask))
- org-element--headline-cache-size
- org-element--cache-size))
+ ;; Use the most optimal version of cache available.
+ () `(if (memq granularity '(headline headline+inlinetask))
+ 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-balance.
+ () `(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 point.
;; For example, if point is inside headline and
@@ -7306,14 +7346,15 @@ (cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) re
;; point.
(move-start-to-next-match
(re) `(save-match-data
- (if (or (not ,re) (if org-element--cache-map-statistics
- (progn
- (setq before-time (float-time))
- (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)))
+ (if (or (not ,re)
+ (if org-element--cache-map-statistics
+ (progn
+ (setq before-time (float-time))
+ (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-element-property :begin data))))
@@ -7476,8 +7517,8 @@ (cl-defun org-element-cache-map (func &key (granularity '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 data)))))
@@ -7497,8 +7538,8 @@ (cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) re
;; and need to fill it.
(unless (or (and start (< (org-element-property :begin data) 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) (= (org-element-property :begin data) start))
;; DATA is at START. Match it.
@@ -7711,13 +7752,14 @@ (defun org-element-at-point (&optional pom cached-only)
(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-frames)
- (fboundp 'backtrace-to-string))
- (backtrace-to-string (backtrace-get-frames 'backtrace))))
+ (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-frames)
+ (fboundp 'backtrace-to-string))
+ (backtrace-to-string (backtrace-get-frames 'backtrace))))
(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 (= pos cend)
(or (= (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))
(/= (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
(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 (&rest body)
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-buffers))))
@@ -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-buffers
- (push (current-buffer) bufs))
+ (push (current-buffer) bufs))
(push buf bufs)
(delete-dups bufs)))))
;; Copy all the old folding properties to preserve the folding state
@@ -623,25 +623,25 @@ (defun org-fold-core--property-symbol-get-create (spec &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-core--property-symbol-get-create spec nil 'return-only)
- nil))
- ((org-fold-core-get-folding-spec-property spec :rear-sticky)
- nil)
- (t
- (cons (org-fold-core--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-folding-spec-property spec :front-sticky)
+ (cons (org-fold-core--property-symbol-get-create spec nil 'return-only)
+ nil))
+ ((org-fold-core-get-folding-spec-property spec :rear-sticky)
+ nil)
+ (t
+ (cons (org-fold-core--property-symbol-get-create spec nil 'return-only)
+ t))))
+ (org-fold-core-folding-spec-list))))))
(org-fold-core-cycle-over-indirect-buffers
- (setq-local text-property-default-nonsticky
- (delete-dups (append
- text-property-default-nonsticky
- full-prop-list))))))))))))))
+ (setq-local text-property-default-nonsticky
+ (delete-dups (append
+ text-property-default-nonsticky
+ full-prop-list))))))))))))))
(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
(defmacro org-fold-core-ignore-modifications (&rest body)
"Run BODY ignoring buffer modifications in `org-fold-core--fix-folded-region'."
- (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)))))
(defmacro org-fold-core-ignore-fragility-checks (&rest body)
"Run BODY skipping :fragility checks in `org-fold-core--fix-folded-region'."
- (declare (debug (form body)) (indent 1))
+ (declare (debug (form body)) (indent 0))
`(let ((org-fold-core--ignore-fragility-checks t))
(progn ,@body)))
@@ -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 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-property 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))))))))
+ ;; 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-property 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 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)))
+ (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)))
;;;; Searching and examining folded text
@@ -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)))
;; 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 silent)
(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 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))))))))))))
+ (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 struct))
- (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 (= 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 (= 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 struct))
+ (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 (= 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 (= 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.
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)
(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 (&rest _) nil)))
,@body))
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 (match-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 (= old-level -1)
- (= new-level -1)
- (= 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 (= old-level -1)
+ (= new-level -1)
+ (= 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 (= shift 0)
- (save-restriction
- (narrow-to-region beg end)
- (while (not (= 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 about 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 (= shift 0)
+ (save-restriction
+ (narrow-to-region beg end)
+ (while (not (= 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 about 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))))))
(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))))))
(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-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))
+ (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 (= (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 (= (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))))))
(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-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))))))
+ (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))))))
(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))))
(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 fmt time)))
+ (insert-before-markers-and-inherit (or post ""))
+ (setq org-last-inserted-timestamp stamp))))
(defun org-toggle-time-stamp-overlays ()
"Toggle the use of custom time stamp formats."
--
2.35.1
^ permalink raw reply related [flat|nested] 3+ messages in thread