[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/org d6bae908f3: Fix macro indentation and re-indent cod
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/org d6bae908f3: Fix macro indentation and re-indent code misindented by nameless |
|
Date: |
Sat, 14 May 2022 05:57:44 -0400 (EDT) |
branch: externals/org
commit d6bae908f30e079e987680f0cc5f49683cdd0a78
Author: Ihor Radchenko <yantar92@gmail.com>
Commit: Ihor Radchenko <yantar92@gmail.com>
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 | 66 ++---
lisp/org-id.el | 48 ++--
lisp/org-list.el | 90 +++----
lisp/org-macs.el | 2 +-
lisp/org.el | 688 +++++++++++++++++++++++++-------------------------
9 files changed, 799 insertions(+), 753 deletions(-)
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 068e3eda2f..5ca4e1f2fd 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1174,7 +1174,7 @@ may have been stored before."
(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 ec87aaf8ab..e2c2688e14 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1582,8 +1582,8 @@ line and position cursor in that line."
(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 @@ line and position cursor in that line."
;; 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 @@ to, overriding the existing value of
`org-clock-out-switch-to-state'."
(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 @@ to, overriding the existing value of
`org-clock-out-switch-to-state'."
(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 0d1595d528..37a6ae7eed 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -646,8 +646,9 @@ Parse tree is modified by side effect."
;; 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 @@ parser (e.g. `:end' and :END:). Return value is a
plist."
(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)
@@ -5420,18 +5421,19 @@ See `org-element--cache-key' for more information.")
(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
@@ -5545,9 +5547,10 @@ current `org-element--cache-sync-keys-value' and the
element key."
(- 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)
@@ -5702,7 +5705,7 @@ the cache."
(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
@@ -5755,13 +5758,15 @@ the cache."
(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)
@@ -5785,12 +5790,13 @@ Assume ELEMENT belongs to cache and that a cache is
active."
(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))))
@@ -5877,7 +5883,7 @@ actually submitted."
;; 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
@@ -5905,16 +5911,17 @@ actually submitted."
;; 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)
@@ -5945,9 +5952,10 @@ The buffer is: %s\n Current command: %S\n Chars
modified: %S\n Buffer modified:
;; 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
@@ -5985,11 +5993,12 @@ information.
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.
@@ -6049,18 +6058,20 @@ completing the 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.
@@ -6165,10 +6176,11 @@ completing the 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.
@@ -6288,19 +6300,21 @@ completing the 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)
@@ -6321,9 +6335,10 @@ If this warning appears regularly, please report the
warning text to Org mode ma
(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
@@ -6372,8 +6387,9 @@ the expected result."
(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))
@@ -6445,9 +6461,9 @@ If you observe Emacs hangs frequently, please report this
to Org mode mailing li
(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
@@ -6455,12 +6471,13 @@ If you observe Emacs hangs frequently, please report
this to Org mode mailing li
;; 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)))
@@ -6649,9 +6666,10 @@ The function returns the new value of
`org-element--cache-change-warning'."
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.
@@ -6795,8 +6813,9 @@ known element in cache (it may start after END)."
(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
@@ -6813,10 +6832,11 @@ known element in cache (it may start after END)."
(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
@@ -6827,11 +6847,13 @@ known element in cache (it may start after END)."
(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)
@@ -6855,8 +6877,9 @@ known element in cache (it may start after END)."
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))
@@ -6889,38 +6912,49 @@ change, as an integer."
;; 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
@@ -6978,23 +7012,26 @@ change, as an integer."
;; 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)
@@ -7006,11 +7043,13 @@ Return non-nil when verification failed."
(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)
@@ -7022,13 +7061,14 @@ Return non-nil when verification failed."
(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.
@@ -7053,16 +7093,16 @@ The element is: %S\n The parent is: %S\n The real
parent is: %S"
(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
@@ -7178,8 +7218,8 @@ This variable can be set by called function, especially
when the
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.
@@ -7249,27 +7289,27 @@ the cache."
;; 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
@@ -7310,14 +7350,15 @@ the cache."
;; 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))))
@@ -7480,8 +7521,8 @@ the cache."
;; 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)))))
@@ -7501,8 +7542,8 @@ the cache."
;; 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.
@@ -7715,13 +7756,14 @@ element ending there."
(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)
@@ -7876,7 +7918,7 @@ Providing it allows for quicker computation."
(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)
@@ -8000,36 +8042,36 @@ end of ELEM-A."
(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 6165338393..5dda133fba 100644
--- a/lisp/org-fold-core.el
+++ b/lisp/org-fold-core.el
@@ -357,7 +357,7 @@ following symbols:
;;;; Folding specs
(defvar-local org-fold-core--specs '((org-fold-visible
- (:visible . t)
+ (:visible . t)
(:alias . (visible)))
(org-fold-hidden
(:ellipsis . "...")
@@ -504,7 +504,7 @@ than the buffer where the change was actually made.")
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))))
@@ -582,7 +582,7 @@ unless RETURN-ONLY is non-nil."
(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
@@ -615,25 +615,25 @@ unless RETURN-ONLY is non-nil."
;; 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.
@@ -1173,14 +1173,14 @@ This function is intended to be used as
`isearch-filter-predicate'."
(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)))
@@ -1211,53 +1211,53 @@ property, unfold the region if the :fragile function
returns non-nil."
;; 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 acf7c07614..43ebe7acca 100644
--- a/lisp/org-fold.el
+++ b/lisp/org-fold.el
@@ -215,34 +215,35 @@ smart Make point visible, and do
insertion/deletion if it is
;; 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 @@ When ENTRY is non-nil, show the entire 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 ()
diff --git a/lisp/org-id.el b/lisp/org-id.el
index 0331b7c1df..42b165681d 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -525,30 +525,30 @@ If SILENT is non-nil, messages are suppressed."
(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 f72151460d..5157630369 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -1092,51 +1092,51 @@ to the same sub-list.
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 8535bf2cd6..10eed2686a 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -181,7 +181,7 @@
(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 47a16e94b0..f4c67b8c0e 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -6448,7 +6448,7 @@ odd number. Returns values greater than 0."
(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))))
@@ -6862,81 +6862,81 @@ When REMOVE is non-nil, remove the subtree from the
clipboard."
"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.
@@ -8908,16 +8908,16 @@ When called through ELisp, arg is also interpreted in
the following way:
((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
@@ -8925,15 +8925,15 @@ When called through ELisp, arg is also interpreted in
the following way:
((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)
@@ -8944,10 +8944,10 @@ When called through ELisp, arg is also interpreted in
the following way:
((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
@@ -8979,7 +8979,7 @@ When called through ELisp, arg is also interpreted in the
following way:
(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
@@ -8990,8 +8990,8 @@ When called through ELisp, arg is also interpreted in the
following way:
(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))
@@ -9733,81 +9733,81 @@ of `org-todo-keywords-1'."
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.
@@ -9913,101 +9913,101 @@ the time to use. If none is given, the user is
prompted for
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.")
@@ -10064,7 +10064,7 @@ narrowing."
;; 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))
@@ -10204,34 +10204,34 @@ EXTRA is additional text that will be inserted into
the notes buffer."
(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)
@@ -11363,34 +11363,34 @@ If TAGS is nil or the empty string, all tags are
removed.
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.
@@ -12584,19 +12584,19 @@ decreases scheduled or deadline date by one day."
(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)
@@ -13751,23 +13751,23 @@ PRE and POST are optional strings to be inserted
before and after the
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."
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/org d6bae908f3: Fix macro indentation and re-indent code misindented by nameless,
ELPA Syncer <=