diff --git a/lisp/org.el b/lisp/org.el index 4d8117a22..31040cbbe 100755 --- a/lisp/org.el +++ b/lisp/org.el @@ -1,4 +1,4 @@ -;;; org.el --- Outline-based notes management and organizer +;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*- ;; Carstens outline-mode for keeping track of everything. ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -70,9 +70,7 @@ (require 'cl-lib) -(eval-when-compile - (require 'cl) - (require 'gnus-sum)) +(eval-when-compile (require 'gnus-sum)) (require 'calendar) (require 'find-func) @@ -316,28 +314,28 @@ With prefix argument, or when HERE is non-nil, insert it at point. In non-interactive uses, a reduced version string is output unless FULL is given." (interactive (list current-prefix-arg t (not current-prefix-arg))) - (let* ((org-dir (ignore-errors (org-find-library-dir "org"))) - (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) - (load-suffixes (list ".el")) - (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs"))) - (org-trash (or - (and (fboundp 'org-release) (fboundp 'org-git-version)) - (org-load-noerror-mustsuffix (concat org-dir "org-version")))) - (load-suffixes save-load-suffixes) - (org-version (org-release)) - (git-version (org-git-version)) - (version (format "Org-mode version %s (%s @ %s)" - org-version - git-version - (if org-install-dir - (if (string= org-dir org-install-dir) - org-install-dir - (concat "mixed installation! " org-install-dir " and " org-dir)) - "org-loaddefs.el can not be found!"))) - (version1 (if full version org-version))) - (when here (insert version1)) - (when message (message "%s" version1)) - version1)) + (let ((org-dir (ignore-errors (org-find-library-dir "org"))) + (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) + (load-suffixes (list ".el")) + (org-install-dir + (ignore-errors (org-find-library-dir "org-loaddefs")))) + (unless (and (fboundp 'org-release) (fboundp 'org-git-version)) + (org-load-noerror-mustsuffix (concat org-dir "org-version"))) + (let* ((load-suffixes save-load-suffixes) + (org-version (org-release)) + (git-version (org-git-version)) + (version (format "Org-mode version %s (%s @ %s)" + org-version + git-version + (if org-install-dir + (if (string= org-dir org-install-dir) + org-install-dir + (concat "mixed installation! " org-install-dir " and " org-dir)) + "org-loaddefs.el can not be found!"))) + (version1 (if full version org-version))) + (when here (insert version1)) + (when message (message "%s" version1)) + version1))) (defconst org-version (org-version)) @@ -5277,12 +5275,10 @@ FILETAGS is a list of tags, as strings." (defun org-extract-log-state-settings (x) "Extract the log state setting from a TODO keyword string. This will extract info from a string like \"WAIT(w@/!)\"." - (let (kw key log1 log2) - (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) - (setq kw (match-string 1 x) - key (and (match-end 2) (match-string 2 x)) - log1 (and (match-end 3) (match-string 3 x)) - log2 (and (match-end 4) (match-string 4 x))) + (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) + (let ((kw (match-string 1 x)) + (log1 (and (match-end 3) (match-string 3 x))) + (log2 (and (match-end 4) (match-string 4 x)))) (and (or log1 log2) (list kw (and log1 (if (equal log1 "!") 'time 'note)) @@ -5325,13 +5321,7 @@ Respect keys that are already there." (defvar org-finish-function nil "Function to be called when `C-c C-c' is used. This is for getting out of special buffers like capture.") - - -;; FIXME: Occasionally check by commenting these, to make sure -;; no other functions uses these, forgetting to let-bind them. -(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el (defvar org-last-state) -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el ;; Defined somewhere in this file, but used before definition. (defvar org-entities) ;; defined in org-entities.el @@ -5347,7 +5337,7 @@ This is for getting out of special buffers like capture.") "Indicates that a table might need an update. This variable is set by `org-before-change-function'. `org-table-align' sets it back to nil.") -(defun org-before-change-function (beg end) +(defun org-before-change-function (_beg _end) "Every change indicates that a table might need an update." (setq org-table-may-need-update t)) (defvar org-mode-map) @@ -5515,7 +5505,7 @@ The following commands are available: (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) ;; Emacs 22 deals with this through a special variable (setq-local outline-isearch-open-invisible-function - (lambda (&rest ignore) (org-show-context 'isearch)))) + (lambda (&rest _) (org-show-context 'isearch)))) ;; Setup the pcomplete hooks (setq-local pcomplete-command-completion-function 'org-pcomplete-initial) @@ -5778,19 +5768,20 @@ If CHAR is not given (for example in an interactive call) it will be prompted for." (interactive) (let ((erc org-emphasis-regexp-components) - (prompt "") - (string "") beg end move c s) + (string "") beg end move s) (if (org-region-active-p) - (setq beg (region-beginning) end (region-end) + (setq beg (region-beginning) + end (region-end) string (buffer-substring beg end)) (setq move t)) (unless char (message "Emphasis marker or tag: [%s]" - (mapconcat (lambda(e) (car e)) org-emphasis-alist "")) + (mapconcat #'car org-emphasis-alist "")) (setq char (read-char-exclusive))) - (if (equal char ?\ ) - (setq s "" move nil) + (if (equal char ?\s) + (setq s "" + move nil) (unless (assoc (char-to-string char) org-emphasis-alist) (user-error "No such emphasis marker: \"%c\"" char)) (setq s (char-to-string char))) @@ -5878,7 +5869,7 @@ by a #." (beg1 (line-beginning-position 2)) (dc1 (downcase (match-string 2))) (dc3 (downcase (match-string 3))) - end end1 quoting block-type ovl) + end end1 quoting block-type) (cond ((and (match-end 4) (equal dc3 "+begin")) ;; Truly a block @@ -6106,7 +6097,8 @@ Also refresh fontification if needed." (backward-char) (let ((obj (org-element-context))) (when (eq (org-element-type obj) 'radio-target) - (add-to-list 'rtn (org-element-property :value obj))))) + (cl-pushnew (org-element-property :value obj) rtn + :test #'equal)))) rtn)))) (setq org-target-link-regexp (and targets @@ -6530,7 +6522,7 @@ If TAG is a number, get the corresponding match group." 'font-lock-fontified t)) (backward-char 1)))) -(defun org-unfontify-region (beg end &optional maybe_loudly) +(defun org-unfontify-region (beg end &optional _maybe_loudly) "Remove fontification and activation overlays from links." (font-lock-default-unfontify-region beg end) (let* ((buffer-undo-list t) @@ -6968,33 +6960,32 @@ With a numeric prefix, show all headlines up to that level." (defun org-set-visibility-according-to-property (&optional no-cleanup) "Switch subtree visibilities according to :VISIBILITY: property." (interactive) - (let (org-show-entry-below) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*:VISIBILITY:" nil t) - (if (not (org-at-property-p)) (outline-next-heading) - (let ((state (match-string 3))) - (save-excursion - (org-back-to-heading t) - (outline-hide-subtree) - (org-reveal) - (cond - ((equal state "folded") - (outline-hide-subtree)) - ((equal state "children") - (org-show-hidden-entry) - (org-show-children)) - ((equal state "content") - (save-excursion - (save-restriction - (org-narrow-to-subtree) - (org-content)))) - ((member state '("all" "showall")) - (outline-show-subtree))))))) - (unless no-cleanup - (org-cycle-hide-archived-subtrees 'all) - (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines 'all))))) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*:VISIBILITY:" nil t) + (if (not (org-at-property-p)) (outline-next-heading) + (let ((state (match-string 3))) + (save-excursion + (org-back-to-heading t) + (outline-hide-subtree) + (org-reveal) + (cond + ((equal state "folded") + (outline-hide-subtree)) + ((equal state "children") + (org-show-hidden-entry) + (org-show-children)) + ((equal state "content") + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (org-content)))) + ((member state '("all" "showall")) + (outline-show-subtree))))))) + (unless no-cleanup + (org-cycle-hide-archived-subtrees 'all) + (org-cycle-hide-drawers 'all) + (org-cycle-show-empty-lines 'all)))) ;; This function uses outline-regexp instead of the more fundamental ;; org-outline-regexp so that org-cycle-global works outside of Org @@ -7241,14 +7232,9 @@ If USE-MARKERS is set, return the positions as markers." (defun org-set-outline-overlay-data (data) "Create visibility overlays for all positions in DATA. DATA should have been made by `org-outline-overlay-data'." - (let (o) - (save-excursion - (save-restriction - (widen) - (outline-show-all) - (mapc (lambda (c) - (outline-flag-region (car c) (cdr c) t)) - data))))) + (org-with-wide-buffer + (outline-show-all) + (dolist (c data) (outline-flag-region (car c) (cdr c) t)))) ;;; Folding of blocks @@ -7449,8 +7435,8 @@ With a prefix argument, use the alternative interface: e.g., if (defvar org-goto-exit-command nil) ; dynamically scoped parameter (defvar org-goto-local-auto-isearch-map) ; defined below -(defun org-get-location (buf help) - "Let the user select a location in the Org-mode buffer BUF. +(defun org-get-location (_buf help) + "Let the user select a location in current buffer. This function uses a recursive edit. It returns the selected position or nil." (org-no-popups @@ -7526,11 +7512,11 @@ or nil." (isearch-mode t) (isearch-process-search-char (string-to-char keys))))) -(defun org-goto-ret (&optional arg) +(defun org-goto-ret (&optional _arg) "Finish `org-goto' by going to the new location." (interactive "P") - (setq org-goto-selected-point (point) - org-goto-exit-command 'return) + (setq org-goto-selected-point (point)) + (setq org-goto-exit-command 'return) (throw 'exit nil)) (defun org-goto-left () @@ -7679,7 +7665,7 @@ When NEXT is non-nil, check the next line instead." When NEXT is non-nil, check the next line instead." (org--line-empty-p 2)) -(defun org-insert-heading (&optional arg invisible-ok top-level) +(defun org-insert-heading (&optional arg invisible-ok top) "Insert a new heading or an item with the same depth at point. If point is at the beginning of a heading or a list item, insert @@ -7715,11 +7701,11 @@ When INVISIBLE-OK is set, stop at invisible headlines when going back. This is important for non-interactive uses of the command. -When optional argument TOP-LEVEL is non-nil, insert a level 1 -heading, unconditionally." +When optional argument TOP is non-nil, insert a level 1 heading, +unconditionally." (interactive "P") (when (org-called-interactively-p 'any) (org-reveal)) - (let ((itemp (and (not top-level) (org-in-item-p))) + (let ((itemp (and (not top) (org-in-item-p))) (may-split (org-get-alist-option org-M-RET-may-split-line 'headline)) (respect-content (or org-insert-heading-respect-content (equal arg '(4)))) @@ -7773,7 +7759,7 @@ heading, unconditionally." (stars (save-excursion (condition-case nil - (if top-level "* " + (if top "* " (org-back-to-heading invisible-ok) (when (and (not on-heading) (featurep 'org-inlinetask) @@ -7798,8 +7784,7 @@ heading, unconditionally." (match-string 0)) (error (or fix-level "* "))))) (blank-a (cdr (assq 'heading org-blank-before-new-entry))) - (blank (if (eq blank-a 'auto) empty-line-p blank-a)) - pos hide-previous previous-pos) + (blank (if (eq blank-a 'auto) empty-line-p blank-a))) ;; If we insert after content, move there and clean up ;; whitespace. @@ -9369,29 +9354,27 @@ definitions." (defun org-contextualize-validate-key (key contexts) "Check CONTEXTS for agenda or capture KEY." - (let (rr res) + (let (res) (dolist (r contexts) - (mapc - (lambda (rr) - (when - (and (equal key (car r)) - (if (functionp rr) (funcall rr) - (or (and (eq (car rr) 'in-file) - (buffer-file-name) - (string-match (cdr rr) (buffer-file-name))) - (and (eq (car rr) 'in-mode) - (string-match (cdr rr) (symbol-name major-mode))) - (and (eq (car rr) 'in-buffer) - (string-match (cdr rr) (buffer-name))) - (when (and (eq (car rr) 'not-in-file) - (buffer-file-name)) - (not (string-match (cdr rr) (buffer-file-name)))) - (when (eq (car rr) 'not-in-mode) - (not (string-match (cdr rr) (symbol-name major-mode)))) - (when (eq (car rr) 'not-in-buffer) - (not (string-match (cdr rr) (buffer-name))))))) - (push r res))) - (car (last r)))) + (dolist (rr (car (last r))) + (when + (and (equal key (car r)) + (if (functionp rr) (funcall rr) + (or (and (eq (car rr) 'in-file) + (buffer-file-name) + (string-match (cdr rr) (buffer-file-name))) + (and (eq (car rr) 'in-mode) + (string-match (cdr rr) (symbol-name major-mode))) + (and (eq (car rr) 'in-buffer) + (string-match (cdr rr) (buffer-name))) + (when (and (eq (car rr) 'not-in-file) + (buffer-file-name)) + (not (string-match (cdr rr) (buffer-file-name)))) + (when (eq (car rr) 'not-in-mode) + (not (string-match (cdr rr) (symbol-name major-mode)))) + (when (eq (car rr) 'not-in-buffer) + (not (string-match (cdr rr) (buffer-name))))))) + (push r res)))) (delete-dups (delq nil res)))) (defun org-context-p (&rest contexts) @@ -10222,7 +10205,7 @@ prepend or to append." (put-text-property 0 (length l) 'face 'font-lock-comment-face l)) (delq nil (append a b))))) -(defvar org-link-links-in-this-file nil) +(defvar org--links-history nil) (defun org-insert-link (&optional complete-file link-location default-description) "Insert a link. At the prompt, enter the link. @@ -10270,12 +10253,11 @@ be used as the default description." (buffer-substring (region-beginning) (region-end)))) (remove (and region (list (region-beginning) (region-end)))) (desc region) - tmphist ; byte-compile incorrectly complains about this (link link-location) (abbrevs org-link-abbrev-alist-local) - entry file all-prefixes auto-desc) + entry all-prefixes auto-desc) (cond - (link-location) ; specified by arg, just use it. + (link-location) ; specified by arg, just use it. ((org-in-regexp org-bracket-link-regexp 1) ;; We do have a link at point, and we are going to edit it. (setq remove (list (match-beginning 0) (match-end 0))) @@ -10311,29 +10293,28 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (unless (pos-visible-in-window-p (point-max)) (org-fit-window-to-buffer)) (and (window-live-p cw) (select-window cw))) - ;; Fake a link history, containing the stored links. - (setq tmphist (append (mapcar 'car org-stored-links) - org-insert-link-history)) (setq all-prefixes (append (mapcar 'car abbrevs) (mapcar 'car org-link-abbrev-alist) org-link-types)) (unwind-protect - (progn + ;; Fake a link history, containing the stored links. + (let ((org--links-history + (append (mapcar #'car org-stored-links) + org-insert-link-history))) (setq link (org-completing-read "Link: " (append - (mapcar (lambda (x) (concat x ":")) - all-prefixes) - (mapcar 'car org-stored-links)) + (mapcar (lambda (x) (concat x ":")) all-prefixes) + (mapcar #'car org-stored-links)) nil nil nil - 'tmphist + 'org--links-history (caar org-stored-links))) - (unless (string-match "\\S-" link) - (user-error "No link selected")) - (mapc (lambda(l) - (when (equal link (cadr l)) (setq link (car l) auto-desc t))) - org-stored-links) + (unless (org-string-nw-p link) (user-error "No link selected")) + (dolist (l org-stored-links) + (when (equal link (cadr l)) + (setq link (car l)) + (setq auto-desc t))) (when (or (member link all-prefixes) (and (equal ":" (substring link -1)) (member (substring link 0 -1) all-prefixes) @@ -10442,6 +10423,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (match-string 1 (expand-file-name file)))) (t (concat "file:" file))))) +(defvar ido-enter-matching-directory) (defun org-iread-file-name (&rest args) "Read-file-name using `ido-mode' speedup if available. ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'. @@ -10847,7 +10829,6 @@ there is one, return it." (widen) (goto-char marker) (let ((cnt ?0) - (in-emacs (unless (integerp nth) nth)) have-zero end links link c) (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) (push (match-string 0 zero) links) @@ -11040,10 +11021,7 @@ of matched result, with is either `dedicated' or `fuzzy'." (match-string 1 s))) ;; Fuzzy links. (t - (let* ((starred (eq (string-to-char normalized) ?*)) - (headline-search (and (derived-mode-p 'org-mode) - (or org-link-search-must-match-exact-headline - starred)))) + (let ((starred (eq (string-to-char normalized) ?*))) (cond ;; Look for targets, only if not in a headline search. ((and (not starred) @@ -11401,10 +11379,9 @@ If the file does not exist, an error is thrown." (org-reveal))) (when search (org-link-search search)))) ((consp cmd) - (let ((file (convert-standard-filename file))) - (save-match-data - (set-match-data link-match-data) - (eval cmd)))) + (save-match-data + (set-match-data link-match-data) + (eval cmd `((file . ,(convert-standard-filename file)))))) (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode) (or (not (equal old-buffer (current-buffer))) @@ -11807,13 +11784,11 @@ prefix argument (`C-u C-u C-u C-c C-w')." (let* ((actionmsg (cond (msg msg) ((equal arg 3) "Refile (and keep)") (t "Refile"))) - (cbuf (current-buffer)) (regionp (org-region-active-p)) (region-start (and regionp (region-beginning))) (region-end (and regionp (region-end))) - (filename (buffer-file-name (buffer-base-buffer cbuf))) (org-refile-keep (if (equal arg 3) t org-refile-keep)) - pos it nbuf file re level reversed) + pos it nbuf file level reversed) (setq last-command nil) (when regionp (goto-char region-start) @@ -11858,7 +11833,6 @@ prefix argument (`C-u C-u C-u C-c C-w')." org-refile-allow-creating-parent-nodes) arg)))))) (setq file (nth 1 it) - re (nth 2 it) pos (nth 3 it)) (when (and (not arg) pos @@ -13630,7 +13604,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (goto-char (or (org-list-get-next-item (point) struct prevs) (org-list-get-item-end (point) struct))))))) -(defun org-add-log-note (&optional purpose) +(defun org-add-log-note (&optional _purpose) "Pop up a window for taking a note, and add this note later." (remove-hook 'post-command-hook 'org-add-log-note) (setq org-log-note-window-configuration (current-window-configuration)) @@ -13883,11 +13857,11 @@ that the match should indeed be shown." (message "%d match(es) for regexp %s" cnt regexp)) cnt)) -(defun org-occur-next-match (&optional n reset) +(defun org-occur-next-match (&optional n _reset) "Function for `next-error-function' to find sparse tree matches. N is the number of matches to move, when negative move backwards. -RESET is entirely ignored - this function always goes back to the -starting point when no match is found." +This function always goes back to the starting point when no +match is found." (let* ((limit (if (< n 0) (point-min) (point-max))) (search-func (if (< n 0) 'previous-single-char-property-change @@ -13980,7 +13954,7 @@ entire tree." (overlay-put ov 'org-type 'org-occur) (push ov org-occur-highlights))) -(defun org-remove-occur-highlights (&optional beg end noremove) +(defun org-remove-occur-highlights (&optional _beg _end noremove) "Remove the occur highlights from the buffer. BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." @@ -14010,7 +13984,7 @@ from the `before-change-functions' in the current buffer." (interactive) (org-priority 'down)) -(defun org-priority (&optional action show) +(defun org-priority (&optional action _show) "Change the priority of an item. ACTION can be `set', `up', `down', or a character." (interactive "P") @@ -15055,7 +15029,7 @@ This works in the agenda, and also in an org-mode buffer." (and agendap (org-agenda-change-all-lines newhead m)))) (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) -(defun org-tags-completion-function (string predicate &optional flag) +(defun org-tags-completion-function (string _predicate &optional flag) (let (s1 s2 rtn (ctable org-last-tags-completion-table) (confirm (lambda (x) (stringp (car x))))) (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string) @@ -15408,7 +15382,7 @@ a *different* entry, you cannot use these techniques." (car (org-delete-all '(comment archive) skip))) (org-tags-match-list-sublevels t) (start-level (eq scope 'region-start-level)) - matcher file res + matcher res org-todo-keywords-for-agenda org-done-keywords-for-agenda org-todo-keyword-alist-for-agenda @@ -15735,7 +15709,10 @@ strings." (member specific '("TIMESTAMP" "TIMESTAMP_IA"))) (let ((find-ts (lambda (end ts) - (let ((regexp (cond + ;; Fix next time-stamp before END. TS is the + ;; list of time-stamps found so far. + (let ((ts ts) + (regexp (cond ((string= specific "TIMESTAMP") org-ts-regexp) ((string= specific "TIMESTAMP_IA") @@ -16149,9 +16126,9 @@ automatically performed, such drawers will be silently ignored." (let ((p (progn (looking-at org-property-re) (org-match-string-no-properties 2)))) ;; Only add true property name, not extension symbol. - (add-to-list 'props - (if (not (org-string-match-p "\\+\\'" p)) p - (substring p 0 -1)))) + (push (if (not (org-string-match-p "\\+\\'" p)) p + (substring p 0 -1)) + props)) (forward-line)))) (outline-next-heading))) (when columns @@ -16165,8 +16142,8 @@ automatically performed, such drawers will be silently ignored." (setq start (match-end 0)) (let ((p (org-match-string-no-properties 1 value))) (unless (member-ignore-case p org-special-properties) - (add-to-list 'props p)))))))))) - (sort props (lambda (a b) (string< (upcase a) (upcase b)))))) + (push p props)))))))))) + (sort (delete-dups props) (lambda (a b) (string< (upcase a) (upcase b)))))) (defun org-property-values (key) "List all non-nil values of property KEY in current buffer." @@ -16176,8 +16153,8 @@ automatically performed, such drawers will be silently ignored." (re (org-re-property key)) values) (while (re-search-forward re nil t) - (add-to-list 'values (org-entry-get (point) key))) - values))) + (push (org-entry-get (point) key) values)) + (delete-dups values)))) (defun org-insert-property-drawer () "Insert a property drawer into the current entry." @@ -16459,7 +16436,7 @@ completion." (org-add-props (car vals) '(org-unrestricted t))) (if table (mapcar 'list vals) vals))) -(defun org-property-previous-allowed-value (&optional previous) +(defun org-property-previous-allowed-value (&optional _previous) "Switch to the next allowed value for this property." (interactive) (org-property-next-allowed-value t)) @@ -16505,9 +16482,9 @@ completion." If anything goes wrong, throw an error. You can wrap this call to catch the error like this: - (condition-case msg - (org-mobile-locate-entry (match-string 4)) - (error (nth 1 msg))) + \(condition-case msg + \(org-mobile-locate-entry (match-string 4)) + \(error (nth 1 msg))) The return value will then be either a string with the error message, or a marker if everything is OK. @@ -16519,31 +16496,28 @@ only headings." (level 1) (lmin 1) (lmax 1) - limit re end found pos heading cnt flevel) + end found flevel) (unless buffer (error "File not found :%s" file)) (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (setq limit (point-max)) - (goto-char (point-min)) - (dolist (heading path) - (setq re (format org-complex-heading-regexp-format - (regexp-quote heading))) - (setq cnt 0 pos (point)) - (while (re-search-forward re end t) - (setq level (- (match-end 1) (match-beginning 1))) - (when (and (>= level lmin) (<= level lmax)) - (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) - (when (= cnt 0) (error "Heading not found on level %d: %s" - lmax heading)) - (when (> cnt 1) (error "Heading not unique on level %d: %s" - lmax heading)) - (goto-char found) - (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) - (setq end (save-excursion (org-end-of-subtree t t)))) - (when (org-at-heading-p) - (point-marker))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (dolist (heading path) + (let ((re (format org-complex-heading-regexp-format + (regexp-quote heading))) + (cnt 0)) + (while (re-search-forward re end t) + (setq level (- (match-end 1) (match-beginning 1))) + (when (and (>= level lmin) (<= level lmax)) + (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) + (when (= cnt 0) + (error "Heading not found on level %d: %s" lmax heading)) + (when (> cnt 1) + (error "Heading not unique on level %d: %s" lmax heading)) + (goto-char found) + (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) + (setq end (save-excursion (org-end-of-subtree t t))))) + (when (org-at-heading-p) + (point-marker)))))) (defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) "Find node HEADING in BUFFER. @@ -16790,7 +16764,8 @@ So these are more for recording a certain time/date." (defvar org-defdecode) (defvar org-with-time) -(defun org-read-date (&optional org-with-time to-time from-string prompt +(defvar calendar-setup) ; Dynamically scoped. +(defun org-read-date (&optional with-time to-time from-string prompt default-time default-input inactive) "Read a date, possibly a time, and make things smooth for the user. The prompt will suggest to enter an ISO date, but you can also enter anything @@ -16834,8 +16809,8 @@ If you don't like the calendar, turn it off with With optional argument TO-TIME, the date will immediately be converted to an internal time. -With an optional argument ORG-WITH-TIME, the prompt will suggest to -also insert a time. Note that when ORG-WITH-TIME is not set, you can +With an optional argument WITH-TIME, the prompt will suggest to +also insert a time. Note that when WITH-TIME is not set, you can still enter a time, and this function will inform the calling routine about this change. The calling routine may then choose to change the format used to insert the time stamp into the buffer to include the time. @@ -16844,83 +16819,90 @@ the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is the time/date that is used for everything that is not specified by the user." (require 'parse-time) - (let* ((org-time-stamp-rounding-minutes - (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes)) + (let* ((org-with-time with-time) + (org-time-stamp-rounding-minutes + (if (equal org-with-time '(16)) + '(0 0) + org-time-stamp-rounding-minutes)) (org-dcst org-display-custom-times) (ct (org-current-time)) (org-def (or org-overriding-default-time default-time ct)) (org-defdecode (decode-time org-def)) - (dummy (progn - (when (< (nth 2 org-defdecode) org-extend-today-until) - (setcar (nthcdr 2 org-defdecode) -1) - (setcar (nthcdr 1 org-defdecode) 59) - (setq org-def (apply 'encode-time org-defdecode) - org-defdecode (decode-time org-def))))) (cur-frame (selected-frame)) - (mouse-autoselect-window nil) ; Don't let the mouse jump - (calendar-frame-setup nil) - (calendar-setup (when (eq calendar-setup 'calendar-only) 'calendar-only)) + (mouse-autoselect-window nil) ; Don't let the mouse jump + (calendar-setup + (and (eq calendar-setup 'calendar-only) 'calendar-only)) (calendar-move-hook nil) (calendar-view-diary-initially-flag nil) (calendar-view-holidays-initially-flag nil) - (timestr (format-time-string - (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def)) - (prompt (concat (if prompt (concat prompt " ") "") - (format "Date+time [%s]: " timestr))) ans (org-ans0 "") org-ans1 org-ans2 final cal-frame) + ;; Rationalize `org-def' and `org-defdecode', if required. + (when (< (nth 2 org-defdecode) org-extend-today-until) + (setf (nth 2 org-defdecode) -1) + (setf (nth 1 org-defdecode) 59) + (setq org-def (apply #'encode-time org-defdecode)) + (setq org-defdecode (decode-time org-def))) + (let* ((timestr (format-time-string + (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") + org-def)) + (prompt (concat (if prompt (concat prompt " ") "") + (format "Date+time [%s]: " timestr)))) + (cond + (from-string (setq ans from-string)) + (org-read-date-popup-calendar + (save-excursion + (save-window-excursion + (calendar) + (when (eq calendar-setup 'calendar-only) + (setq cal-frame + (window-frame (get-buffer-window "*Calendar*" 'visible))) + (select-frame cal-frame)) + (org-eval-in-calendar '(setq cursor-type nil) t) + (unwind-protect + (progn + (calendar-forward-day (- (time-to-days org-def) + (calendar-absolute-from-gregorian + (calendar-current-date)))) + (org-eval-in-calendar nil t) + (let* ((old-map (current-local-map)) + (map (copy-keymap calendar-mode-map)) + (minibuffer-local-map + (copy-keymap org-read-date-minibuffer-local-map))) + (org-defkey map (kbd "RET") 'org-calendar-select) + (org-defkey map [mouse-1] 'org-calendar-select-mouse) + (org-defkey map [mouse-2] 'org-calendar-select-mouse) + (unwind-protect + (progn + (use-local-map map) + (setq org-read-date-inactive inactive) + (add-hook 'post-command-hook 'org-read-date-display) + (setq org-ans0 + (read-string prompt + default-input + 'org-read-date-history + nil)) + ;; org-ans0: from prompt + ;; org-ans1: from mouse click + ;; org-ans2: from calendar motion + (setq ans + (concat org-ans0 " " (or org-ans1 org-ans2)))) + (remove-hook 'post-command-hook 'org-read-date-display) + (use-local-map old-map) + (when org-read-date-overlay + (delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil))))) + (bury-buffer "*Calendar*") + (when cal-frame + (delete-frame cal-frame) + (select-frame-set-input-focus cur-frame)))))) - (cond - (from-string (setq ans from-string)) - (org-read-date-popup-calendar - (save-excursion - (save-window-excursion - (calendar) - (when (eq calendar-setup 'calendar-only) - (setq cal-frame - (window-frame (get-buffer-window "*Calendar*" 'visible))) - (select-frame cal-frame)) - (org-eval-in-calendar '(setq cursor-type nil) t) - (unwind-protect - (progn - (calendar-forward-day (- (time-to-days org-def) - (calendar-absolute-from-gregorian - (calendar-current-date)))) - (org-eval-in-calendar nil t) - (let* ((old-map (current-local-map)) - (map (copy-keymap calendar-mode-map)) - (minibuffer-local-map - (copy-keymap org-read-date-minibuffer-local-map))) - (org-defkey map (kbd "RET") 'org-calendar-select) - (org-defkey map [mouse-1] 'org-calendar-select-mouse) - (org-defkey map [mouse-2] 'org-calendar-select-mouse) - (unwind-protect - (progn - (use-local-map map) - (setq org-read-date-inactive inactive) - (add-hook 'post-command-hook 'org-read-date-display) - (setq org-ans0 (read-string prompt default-input - 'org-read-date-history nil)) - ;; org-ans0: from prompt - ;; org-ans1: from mouse click - ;; org-ans2: from calendar motion - (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) - (remove-hook 'post-command-hook 'org-read-date-display) - (use-local-map old-map) - (when org-read-date-overlay - (delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))) - (bury-buffer "*Calendar*") - (when cal-frame - (delete-frame cal-frame) - (select-frame-set-input-focus cur-frame)))))) - - (t ; Naked prompt only - (unwind-protect - (setq ans (read-string prompt default-input - 'org-read-date-history timestr)) - (when org-read-date-overlay - (delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))) + (t ; Naked prompt only + (unwind-protect + (setq ans (read-string prompt default-input + 'org-read-date-history timestr)) + (when org-read-date-overlay + (delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil)))))) (setq final (org-read-date-analyze ans org-def org-defdecode)) @@ -16981,16 +16963,18 @@ user." (make-overlay (1- (point-at-eol)) (point-at-eol))) (org-overlay-display org-read-date-overlay txt 'secondary-selection))))) -(defun org-read-date-analyze (ans org-def org-defdecode) +(defun org-read-date-analyze (ans def defdecode) "Analyze the combined answer of the date prompt." ;; FIXME: cleanup and comment ;; Pass `current-time' result to `decode-time' (instead of calling ;; without arguments) so that only `current-time' has to be ;; overriden in tests. - (let ((nowdecode (decode-time (current-time))) + (let ((org-def def) + (org-defdecode defdecode) + (nowdecode (decode-time (current-time))) delta deltan deltaw deltadef year month day hour minute second wday pm h2 m2 tl wday1 - iso-year iso-weekday iso-week iso-year iso-date futurep kill-year) + iso-year iso-weekday iso-week iso-date futurep kill-year) (setq org-read-date-analyze-futurep nil org-read-date-analyze-forced-year nil) (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) @@ -17457,8 +17441,8 @@ both scheduled and deadline timestamps." (regexp-opt (list org-deadline-string org-scheduled-string)) " *<\\([^>]+\\)>")))) -(defun org-check-before-date (date) - "Check if there are deadlines or scheduled entries before DATE." +(defun org-check-before-date (d) + "Check if there are deadlines or scheduled entries before date D." (interactive (list (org-read-date))) (let ((case-fold-search nil) (regexp (org-re-timestamp org-ts-type)) @@ -17470,12 +17454,13 @@ both scheduled and deadline timestamps." '(org-at-planning-p)) (time-less-p (org-time-string-to-time match) - (org-time-string-to-time date))))))) + (org-time-string-to-time d))))))) (message "%d entries before %s" - (org-occur regexp nil callback) date))) + (org-occur regexp nil callback) + d))) -(defun org-check-after-date (date) - "Check if there are deadlines or scheduled entries after DATE." +(defun org-check-after-date (d) + "Check if there are deadlines or scheduled entries after date D." (interactive (list (org-read-date))) (let ((case-fold-search nil) (regexp (org-re-timestamp org-ts-type)) @@ -17487,9 +17472,10 @@ both scheduled and deadline timestamps." '(org-at-planning-p)) (not (time-less-p (org-time-string-to-time match) - (org-time-string-to-time date)))))))) + (org-time-string-to-time d)))))))) (message "%d entries after %s" - (org-occur regexp nil callback) date))) + (org-occur regexp nil callback) + d))) (defun org-check-dates-range (start-date end-date) "Check for deadlines/scheduled entries between START-DATE and END-DATE." @@ -17669,26 +17655,30 @@ D may be an absolute day number, or a calendar-type list (month day year)." (defun org-calendar-holiday () "List of holidays, for Diary display in Org-mode." + (declare (special date)) (require 'holidays) (let ((hl (funcall (if (fboundp 'calendar-check-holidays) 'calendar-check-holidays 'check-calendar-holidays) date))) (when hl (mapconcat 'identity hl "; ")))) -(defun org-diary-sexp-entry (sexp entry date) - "Process a SEXP diary ENTRY for DATE." +(defun org-diary-sexp-entry (sexp entry d) + "Process a SEXP diary ENTRY for date D." (require 'diary-lib) - (let ((result (if calendar-debug-sexp - (let ((stack-trace-on-error t)) - (eval (car (read-from-string sexp)))) - (condition-case nil - (eval (car (read-from-string sexp))) - (error - (beep) - (message "Bad sexp at line %d in %s: %s" - (org-current-line) - (buffer-file-name) sexp) - (sleep-for 2)))))) + ;; `org-anniversary' and alike expect ENTRY and DATE to be bound + ;; dynamically. + (let* ((sexp `(let ((entry ,entry) + (date ',d)) + ,(car (read-from-string sexp)))) + (result (if calendar-debug-sexp (eval sexp) + (condition-case nil + (eval sexp) + (error + (beep) + (message "Bad sexp at line %d in %s: %s" + (org-current-line) + (buffer-file-name) sexp) + (sleep-for 2)))))) (cond ((stringp result) (split-string result "; ")) ((and (consp result) (not (consp (cdr result))) @@ -17766,14 +17756,14 @@ day number." (setf n2 (+ n1 value)))) ("m" (let* ((add-months - (lambda (date n) - ;; Add N months to gregorian DATE, i.e., + (lambda (d n) + ;; Add N months to gregorian date D, i.e., ;; a list (MONTH DAY YEAR). Return a valid ;; gregorian date. - (let ((m (+ (nth 0 date) n))) + (let ((m (+ (nth 0 d) n))) (list (mod m 12) - (nth 1 date) - (+ (/ m 12) (nth 2 date)))))) + (nth 1 d) + (+ (/ m 12) (nth 2 d)))))) (months ; Complete months to TARGET. (* (/ (+ (* 12 (- (nth 2 target) (nth 2 base))) (- (nth 0 target) (nth 0 base)) @@ -17814,15 +17804,14 @@ day number." ((eq prefer 'future) (if (= cday n1) n1 n2)) (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))))))))) -(defun org-date-to-gregorian (date) - "Turn any specification of DATE into a Gregorian date for the calendar." - (cond ((integerp date) (calendar-gregorian-from-absolute date)) - ((and (listp date) (= (length date) 3)) date) - ((stringp date) - (setq date (org-parse-time-string date)) - (list (nth 4 date) (nth 3 date) (nth 5 date))) - ((listp date) - (list (nth 4 date) (nth 3 date) (nth 5 date))))) +(defun org-date-to-gregorian (d) + "Turn any specification of date D into a Gregorian date for the calendar." + (cond ((integerp d) (calendar-gregorian-from-absolute d)) + ((and (listp d) (= (length d) 3)) d) + ((stringp d) + (let ((d (org-parse-time-string d))) + (list (nth 4 d) (nth 3 d) (nth 5 d)))) + ((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d))))) (defun org-parse-time-string (s &optional nodefault) "Parse the standard Org-mode time string. @@ -18110,14 +18099,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (substring s (match-end ng)))))) s)) -(defun org-recenter-calendar (date) - "If the calendar is visible, recenter it to DATE." +(defun org-recenter-calendar (d) + "If the calendar is visible, recenter it to date D." (let ((cwin (get-buffer-window "*Calendar*" t))) (when cwin (let ((calendar-move-hook nil)) (with-selected-window cwin - (calendar-goto-date (if (listp date) date - (calendar-gregorian-from-absolute date)))))))) + (calendar-goto-date + (if (listp d) d (calendar-gregorian-from-absolute d)))))))) (defun org-goto-calendar (&optional arg) "Go to the Emacs calendar at the current date. @@ -18689,7 +18678,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (inhibit-read-only t) (org-inhibit-startup org-agenda-inhibit-startup) (rea (concat ":" org-archive-tag ":")) - file re pos) + re pos) (setq org-tag-alist-for-agenda nil org-tag-groups-alist-for-agenda nil) (save-excursion @@ -18816,7 +18805,7 @@ It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is (cdlatex-tab) t) ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) -(defun org-cdlatex-underscore-caret (&optional arg) +(defun org-cdlatex-underscore-caret (&optional _arg) "Execute `cdlatex-sub-superscript' in LaTeX fragments. Revert to the normal definition outside of these fragments." (interactive "P") @@ -18825,7 +18814,7 @@ Revert to the normal definition outside of these fragments." (let (org-cdlatex-mode) (call-interactively (key-binding (vector last-input-event)))))) -(defun org-cdlatex-math-modify (&optional arg) +(defun org-cdlatex-math-modify (&optional _arg) "Execute `cdlatex-math-modify' in LaTeX fragments. Revert to the normal definition outside of these fragments." (interactive "P") @@ -19190,17 +19179,19 @@ inspection." (region-beginning) (region-end))))) (read-string "LaTeX Fragment: " frag nil frag)))) (unless latex-frag (user-error "Invalid LaTeX fragment")) - (let* ((tmp-in-file (file-relative-name - (make-temp-name (expand-file-name "ltxmathml-in")))) - (ignore (write-region latex-frag nil tmp-in-file)) + (let* ((tmp-in-file + (let ((file (file-relative-name + (make-temp-name (expand-file-name "ltxmathml-in"))))) + (write-region latex-frag nil file) + file)) (tmp-out-file (file-relative-name (make-temp-name (expand-file-name "ltxmathml-out")))) (cmd (format-spec org-latex-to-mathml-convert-command `((?j . ,(and org-latex-to-mathml-jar-file - (shell-quote-argument - (expand-file-name - org-latex-to-mathml-jar-file)))) + (shell-quote-argument + (expand-file-name + org-latex-to-mathml-jar-file)))) (?I . ,(shell-quote-argument tmp-in-file)) (?i . ,latex-frag) (?o . ,(shell-quote-argument tmp-out-file))))) @@ -19692,7 +19683,7 @@ boundaries." (define-obsolete-function-alias 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") -(defun org-display-inline-remove-overlay (ov after beg end &optional len) +(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len) "Remove inline-display overlay if a corresponding region is modified." (let ((inhibit-modification-hooks t)) (when (and ov after) @@ -20523,7 +20514,7 @@ individual commands for more information." (call-interactively 'org-indent-item-tree)) (t (org-modifier-cursor-error)))) -(defun org-shiftmetaup (&optional arg) +(defun org-shiftmetaup (&optional _arg) "Drag the line at point up. In a table, kill the current row. On a clock timestamp, update the value of the timestamp like `S-' @@ -20537,7 +20528,7 @@ Everywhere else, drag the line at point up." (call-interactively 'org-timestamp-up))) (t (call-interactively 'org-drag-line-backward)))) -(defun org-shiftmetadown (&optional arg) +(defun org-shiftmetadown (&optional _arg) "Drag the line at point down. In a table, insert an empty row at the current line. On a clock timestamp, update the value of the timestamp like `S-' @@ -20555,7 +20546,7 @@ Everywhere else, drag the line at point down." (user-error "Hidden subtree, open with TAB or use subtree command M-S-/")) -(defun org-metaleft (&optional arg) +(defun org-metaleft (&optional _arg) "Promote heading, list item at point or move table column left. Calls `org-do-promote', `org-outdent-item' or `org-table-move-column', @@ -20589,7 +20580,7 @@ and returns at first non-nil value." (call-interactively 'org-outdent-item)) (t (call-interactively 'backward-word)))) -(defun org-metaright (&optional arg) +(defun org-metaright (&optional _arg) "Demote heading, list item at point or move table column right. In front of a drawer or a block keyword, indent it correctly. @@ -20654,7 +20645,7 @@ this function returns t, nil otherwise." (throw 'exit t)))) nil)))) -(defun org-metaup (&optional arg) +(defun org-metaup (&optional _arg) "Move subtree up or move table row up. Calls `org-move-subtree-up' or `org-table-move-row' or `org-move-item-up', depending on context. See the individual commands @@ -20676,7 +20667,7 @@ for more information." ((org-at-item-p) (call-interactively 'org-move-item-up)) (t (org-drag-element-backward)))) -(defun org-metadown (&optional arg) +(defun org-metadown (&optional _arg) "Move subtree down or move table row down. Calls `org-move-subtree-down' or `org-table-move-row' or `org-move-item-down', depending on context. See the individual @@ -22369,7 +22360,7 @@ and end of string." "Whether point is in a code source block. When INSIDE is non-nil, don't consider we are within a src block when point is at #+BEGIN_SRC or #+END_SRC." - (let ((case-fold-search t) ov) + (let ((case-fold-search t)) (or (and (eq (get-char-property (point) 'src-block) t)) (and (not inside) (save-match-data @@ -22723,7 +22714,7 @@ so values can contain further %-escapes if they are define later in TABLE." (let ((tbl (copy-alist table)) (case-fold-search nil) (pchg 0) - e re rpl) + re rpl) (dolist (e tbl) (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) (when (and (cdr e) (string-match re (cdr e))) @@ -23024,9 +23015,9 @@ assumed to be significant there." (let ((indent-to (lambda (ind pos) ;; Set IND as indentation for all lines between point and - ;; POS or END, whichever comes first. Blank lines are - ;; ignored. Leave point after POS once done. - (let ((limit (copy-marker (min end pos)))) + ;; POS. Blank lines are ignored. Leave point after POS + ;; once done. + (let ((limit (copy-marker pos))) (while (< (point) limit) (unless (org-looking-at-p "[ \t]*$") (org-indent-line-to ind)) (forward-line)) @@ -23048,7 +23039,7 @@ assumed to be significant there." (when (eq type 'node-property) (org--align-node-property) (beginning-of-line)) - (funcall indent-to ind element-end)) + (funcall indent-to ind (min element-end end))) (t ;; Elements in this category consist of three parts: ;; before the contents, the contents, and after the @@ -23096,7 +23087,7 @@ assumed to be significant there." offset)) (goto-char cbeg))) ((eq type 'item) (goto-char cbeg)) - (t (funcall indent-to ind cbeg))) + (t (funcall indent-to ind (min cbeg end)))) (when (< (point) end) (case type ((example-block export-block verse-block)) @@ -23110,7 +23101,8 @@ assumed to be significant there." (indent-region (point-min) (point-max)))))) (t (org-indent-region (point) (min cend end)))) (goto-char (min cend end)) - (when (< (point) end) (funcall indent-to ind element-end))) + (when (< (point) end) + (funcall indent-to ind (min element-end end)))) (set-marker post nil) (set-marker cbeg nil) (set-marker cend nil)))) @@ -23672,7 +23664,7 @@ strictly within a source block, use appropriate comment syntax." (insert comment-start)) (forward-line))))))))) -(defun org-comment-dwim (arg) +(defun org-comment-dwim (_arg) "Call `comment-dwim' within a source edit buffer if needed." (interactive "*P") (if (org-in-src-block-p) @@ -24753,7 +24745,7 @@ Move to the previous element at the same level, when possible." (defun org-drag-line-forward (arg) "Drag the line at point ARG lines forward." (interactive "p") - (dotimes (n (abs arg)) + (dotimes (_ (abs arg)) (let ((c (current-column))) (if (< 0 arg) (progn