From ef9637030456b153fd834f4c9202a9264d5ef18d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 8 Aug 2015 19:41:57 -0400 Subject: [PATCH] Backport commit 3a5f751 from Emacs master branch * lisp/org.el (org-goto-map, org-assign-fast-keys) (org-contextualize-keys, org-contextualize-validate-key) (org-notes-order-reversed-p, org-local-logging, org-map-entries) (org-find-olp, org-find-exact-heading-in-directory) (org-cycle-agenda-files, org-release-buffers, org-fill-template) (org-agenda-prepare-buffers, org-occur-in-agenda-files) (org-replace-escapes): Use dolist. (org-mode): Optimize away XEmacs-only code. (org-refile-get-targets): Remove unused var `f'. (org-fast-todo-selection): Remove unused var `e'. (org-make-tags-matcher): Use dolist. Remove unused var `term'. (org-fast-tag-selection): Use dolist. Remove unused var `e'. (org-format-latex): Use dolist. Remove unused var `e'. (org-backward-sentence, org-forward-sentence, org-meta-return) (org-kill-line): Mark arg as unused. (org-submit-bug-report): Silence compiler warning. (org-occur-in-agenda-files): Don't use add-to-list on local vars. (org-get-cursor-date): Remove unused var `tm'. (org-comment-or-uncomment-region): Use standard name `_'. (reftex-docstruct-symbol, reftex-cite-format): Declare to silence byte-compiler. (org-reftex-citation): Add `org--' prefix to dynamically scoped `rds' var. org.el: Fix up some lexical scoping warnings, and use dolist 3a5f75193ed10ee5fb458e9879340947f31d5e12 Stefan Monnier Sat Aug 8 19:41:57 2015 -0400 --- lisp/org.el | 183 ++++++++++++++++++++++++++++------------------------ 1 file changed, 97 insertions(+), 86 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 685489e91..c062c3ecf 100755 --- a/lisp/org.el +++ b/lisp/org.el @@ -5299,8 +5299,8 @@ This will extract info from a string like \"WAIT(w@/!)\"." (defun org-assign-fast-keys (alist) "Assign fast keys to a keyword-key alist. Respect keys that are already there." - (let (new e (alt ?0)) - (while (setq e (pop alist)) + (let (new (alt ?0)) + (dolist (e alist) (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup)) (cdr e)) ;; Key already assigned. (push e new) @@ -5420,8 +5420,9 @@ The following commands are available: (define-key org-mode-map [menu-bar show] 'undefined)) (org-load-modules-maybe) - (easy-menu-add org-org-menu) - (easy-menu-add org-tbl-menu) + (when (featurep 'xemacs) + (easy-menu-add org-org-menu) + (easy-menu-add org-tbl-menu)) (org-install-agenda-files-menu) (if org-descriptive-links (add-to-invisibility-spec '(org-link))) (add-to-invisibility-spec '(org-cwidth)) @@ -7387,9 +7388,8 @@ a block. Return a non-nil value when toggling is successful." (setq org-goto-map (let ((map (make-sparse-keymap))) (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command - mouse-drag-region universal-argument org-occur)) - cmd) - (while (setq cmd (pop cmds)) + mouse-drag-region universal-argument org-occur))) + (dolist (cmd cmds) (substitute-key-definition cmd cmd map global-map))) (suppress-keymap map) (org-defkey map "\C-m" 'org-goto-ret) @@ -8836,7 +8836,8 @@ Optional argument WITH-CASE means sort case-sensitively." (while (string-match org-bracket-link-regexp s) (setq s (replace-match (if (match-end 2) (match-string 3 s) - (match-string 1 s)) t t s))) + (match-string 1 s)) + t t s))) (let ((st (format " %s " s))) (while (string-match org-emph-re st) (setq st (replace-match (format " %s " (match-string 4 st)) t t st))) @@ -9351,10 +9352,11 @@ definitions." (list (car c) (car c) (cadr c))) ((string= "" (cadr c)) (list (car c) (car c) (caddr c))) - (t c))) contexts)) - (a alist) c r s) + (t c))) + contexts)) + (a alist) r s) ;; loop over all commands or templates - (while (setq c (pop a)) + (dolist (c a) (let (vrules repl) (cond ((not (assoc (car c) contexts)) @@ -9364,7 +9366,8 @@ definitions." (car c) contexts))) (mapc (lambda (vr) (when (not (equal (car vr) (cadr vr))) - (setq repl vr))) vrules) + (setq repl vr))) + vrules) (if (not repl) (push c r) (push (cadr repl) s) (push @@ -9381,14 +9384,16 @@ definitions." (let ((tpl (car x))) (when (not (delq nil - (mapcar (lambda(y) - (equal y tpl)) s))) x))) + (mapcar (lambda (y) + (equal y tpl)) + s))) + x))) (reverse r)))))) (defun org-contextualize-validate-key (key contexts) "Check CONTEXTS for agenda or capture KEY." - (let (r rr res) - (while (setq r (pop contexts)) + (let (rr res) + (dolist (r contexts) (mapc (lambda (rr) (when @@ -9738,7 +9743,8 @@ active region." (funcall (caar sfuns))) (setq link (plist-get org-store-link-plist :link) desc (or (plist-get org-store-link-plist - :description) link)))) + :description) + link)))) ;; Store a link from a source code buffer. ((org-src-edit-buffer-p) @@ -9925,7 +9931,8 @@ active region." ;; Return the link (if (not (and (or (org-called-interactively-p 'any) - executing-kbd-macro) link)) + executing-kbd-macro) + link)) (or agenda-link (and link (org-make-link-string link desc))) (push (list link desc) org-stored-links) (message "Stored: %s" (or desc link)) @@ -11524,12 +11531,9 @@ on the system \"/user@host:\"." ((eq t org-reverse-note-order) t) ((not (listp org-reverse-note-order)) nil) (t (catch 'exit - (let ((all org-reverse-note-order) - entry) - (while (setq entry (pop all)) - (if (string-match (car entry) buffer-file-name) - (throw 'exit (cdr entry)))) - nil))))) + (dolist (entry org-reverse-note-order) + (if (string-match (car entry) buffer-file-name) + (throw 'exit (cdr entry)))))))) (defvar org-refile-target-table nil "The list of refile targets, created by `org-refile'.") @@ -11594,10 +11598,10 @@ on the system \"/user@host:\"." (let ((case-fold-search nil) ;; otherwise org confuses "TODO" as a kw and "Todo" as a word (entries (or org-refile-targets '((nil . (:level . 1))))) - targets tgs txt re files f desc descre fast-path-p level pos0) + targets tgs txt re files desc descre fast-path-p level pos0) (message "Getting targets...") (with-current-buffer (or default-buffer (current-buffer)) - (while (setq entry (pop entries)) + (dolist (entry entries) (setq files (car entry) desc (cdr entry)) (setq fast-path-p nil) (cond @@ -11630,7 +11634,7 @@ on the system \"/user@host:\"." (cdr desc))) "\\}[ \t]"))) (t (error "Bad refiling target description %s" desc))) - (while (setq f (pop files)) + (dolist (f files) (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)) (or @@ -13030,20 +13034,19 @@ This hook runs even if there is no statistics cookie present, in which case (defun org-local-logging (value) "Get logging settings from a property VALUE." - (let* (words w a) - ;; directly set the variables, they are already local. - (setq org-log-done nil - org-log-repeat nil - org-todo-log-states nil) - (setq words (org-split-string value)) - (while (setq w (pop words)) + ;; Directly set the variables, they are already local. + (setq org-log-done nil + org-log-repeat nil + org-todo-log-states nil) + (dolist (w (org-split-string value)) + (let* (a) (cond ((setq a (assoc w org-startup-options)) - (and (member (nth 1 a) '(org-log-done org-log-repeat)) - (set (nth 1 a) (nth 2 a)))) + (and (member (nth 1 a) '(org-log-done org-log-repeat)) + (set (nth 1 a) (nth 2 a)))) ((setq a (org-extract-log-state-settings w)) - (and (member (car a) org-todo-keywords-1) - (push a org-todo-log-states))))))) + (and (member (car a) org-todo-keywords-1) + (push a org-todo-log-states))))))) (defun org-get-todo-sequence-head (kwd) "Return the head of the TODO sequence to which KWD belongs. @@ -13073,7 +13076,7 @@ Returns the new TODO keyword, or nil if no state change should occur." (expert nil) (fwidth (+ maxlen 3 1 3)) (ncol (/ (- (window-width) 4) fwidth)) - tg cnt e c tbl + tg cnt c tbl groups ingroup) (save-excursion (save-window-excursion @@ -13083,7 +13086,7 @@ Returns the new TODO keyword, or nil if no state change should occur." (erase-buffer) (org-set-local 'org-done-keywords done-keywords) (setq tbl fulltable cnt 0) - (while (setq e (pop tbl)) + (dolist (e tbl) (cond ((equal e '(:startgroup)) (push '() groups) (setq ingroup t) @@ -14449,7 +14452,7 @@ See also `org-scan-tags'. (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")) minus tag mm tagsmatch todomatch tagsmatcher todomatcher kwd matcher - orterms term orlist re-p str-p level-p level-op time-p + orterms orlist re-p str-p level-p level-op time-p prop-p pn pv po gv rest (start 0) (ss 0)) ;; Expand group tags (setq match (org-tags-expand match)) @@ -14478,7 +14481,7 @@ See also `org-scan-tags'. (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch))) (setq tagsmatcher t) (setq orterms (org-split-string tagsmatch "|") orlist nil) - (while (setq term (pop orterms)) + (dolist (term orterms) (while (and (equal (substring term -1) "\\") orterms) (setq term (concat term "|" (pop orterms)))) ; repair bad split (while (string-match re term) @@ -14539,7 +14542,7 @@ See also `org-scan-tags'. (if (or (not todomatch) (not (string-match "\\S-" todomatch))) (setq todomatcher t) (setq orterms (org-split-string todomatch "|") orlist nil) - (while (setq term (pop orterms)) + (dolist (term orterms) (while (string-match re term) (setq minus (and (match-end 1) (equal (match-string 1 term) "-")) @@ -14623,7 +14626,8 @@ When DOWNCASE is non-nil, expand downcased TAGS." (with-syntax-table stable (string-match (concat "\\(?1:[+-]?\\)\\(?2:\\<" - (regexp-opt taggroups-keys) "\\>\\)") return-match))) + (regexp-opt taggroups-keys) "\\>\\)") + return-match))) (let* ((dir (match-string 1 return-match)) (tag (match-string 2 return-match)) (tag (if downcased (downcase tag) tag))) @@ -14829,7 +14833,8 @@ ignore inherited ones." (reverse (delete-dups (reverse (append (org-remove-uninherited-tags - org-file-tags) tags))))))))) + org-file-tags) + tags))))))))) (defun org-add-prop-inherited (s) (add-text-properties 0 (length s) '(inherited t) s) @@ -15167,7 +15172,7 @@ Returns the new tags string, or nil to not change the current settings." (ncol (/ (- (window-width) 4) fwidth)) (i-face 'org-done) (c-face 'org-todo) - tg cnt e c char c1 c2 ntable tbl rtn + tg cnt c char c1 c2 ntable tbl rtn ov-start ov-end ov-prefix (exit-after-next org-fast-tag-selection-single-key) (done-keywords org-done-keywords) @@ -15202,7 +15207,7 @@ Returns the new tags string, or nil to not change the current settings." (org-fast-tag-show-exit exit-after-next) (org-set-current-tags-overlay current ov-prefix) (setq tbl fulltable char ?a cnt 0) - (while (setq e (pop tbl)) + (dolist (e tbl) (cond ((eq (car e) :startgroup) (push '() groups) (setq ingroup t) @@ -15500,7 +15505,7 @@ a *different* entry, you cannot use these techniques." ((eq scope 'file-with-archives) (setq scope (org-add-archive-files (list (buffer-file-name)))))) (org-agenda-prepare-buffers scope) - (while (setq file (pop scope)) + (dolist (file scope) (with-current-buffer (org-find-base-buffer-visiting file) (save-excursion (save-restriction @@ -16532,7 +16537,7 @@ only headings." (widen) (setq limit (point-max)) (goto-char (point-min)) - (while (setq heading (pop path)) + (dolist (heading path) (setq re (format org-complex-heading-regexp-format (regexp-quote heading))) (setq cnt 0 pos (point)) @@ -16575,9 +16580,9 @@ a priority cookie and tags in the standard locations." When the target headline is found, return a marker to this location." (let ((files (directory-files (or dir default-directory) t "\\`[^.#].*\\.org\\'")) - file visiting m buffer) + visiting m buffer) (catch 'found - (while (setq file (pop files)) + (dolist (file files) (message "trying %s" file) (setq visiting (org-find-base-buffer-visiting file)) (setq buffer (or visiting (find-file-noselect file))) @@ -18559,7 +18564,7 @@ If the current buffer does not, find the first agenda file." file) (unless files (user-error "No agenda files")) (catch 'exit - (while (setq file (pop files)) + (dolist (file files) (if (equal (file-truename file) tcf) (when (car files) (find-file (car files)) @@ -18646,8 +18651,8 @@ which might be released later." "Release all buffers in list, asking the user for confirmation when needed. When a buffer is unmodified, it is just killed. When modified, it is saved \(if the user agrees) and then killed." - (let (buf file) - (while (setq buf (pop blist)) + (let (file) + (dolist (buf blist) (setq file (buffer-file-name buf)) (when (and (buffer-modified-p buf) file @@ -18669,7 +18674,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved org-tag-groups-alist-for-agenda nil) (save-excursion (save-restriction - (while (setq file (pop files)) + (dolist (file files) (catch 'nextfile (if (bufferp file) (set-buffer file) @@ -19735,7 +19740,7 @@ boundaries." (org-defkey org-mode-map "\C-i" 'org-cycle) (org-defkey org-mode-map [(tab)] 'org-cycle) (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) -(org-defkey org-mode-map "\M-\t" 'pcomplete) +(org-defkey org-mode-map "\M-\t" #'pcomplete) ;; The following line is necessary under Suse GNU/Linux (unless (featurep 'xemacs) (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) @@ -19804,7 +19809,7 @@ boundaries." (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft) - (org-defkey org-mode-map [?\e (tab)] 'pcomplete) + (org-defkey org-mode-map [?\e (tab)] #'pcomplete) (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading) (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft) (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright) @@ -21607,11 +21612,11 @@ number of stars to add." (forward-line))))))) (unless toggled (message "Cannot toggle heading from here")))) -(defun org-meta-return (&optional arg) +(defun org-meta-return (&optional _arg) "Insert a new heading or wrap a region in a table. Calls `org-insert-heading' or `org-table-wrap-region', depending on context. See the individual commands for more information." - (interactive "P") + (interactive) (org-check-before-invisible-edit 'insert) (or (run-hook-with-args-until-success 'org-metareturn-hook) (call-interactively (if (org-at-table-p) #'org-table-wrap-region @@ -21904,6 +21909,7 @@ output buffer into your mail program, as it gives us important information about your Org-mode version and configuration." (interactive) (require 'reporter) + (defvar reporter-prompt-for-summary-p) (org-load-modules-maybe) (org-require-autoloaded-modules) (let ((reporter-prompt-for-summary-p "Bug report subject: ")) @@ -22152,11 +22158,13 @@ upon the next fontification round." 'invisible 'org-link s)) (setq s (concat (substring s 0 b) (substring s (or (next-single-property-change - b 'invisible s) (length s))))))) + b 'invisible s) + (length s))))))) (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) (setq s (concat (substring s 0 b) (substring s (or (next-single-property-change - b 'org-cwidth s) (length s)))))) + b 'org-cwidth s) + (length s)))))) (setq l (string-width s) b -1) (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) (setq l (- l (get-text-property b 'org-dwidth-n s)))) @@ -22253,11 +22261,9 @@ N may optionally be the number of spaces to remove." (defun org-fill-template (template alist) "Find each %key of ALIST in TEMPLATE and replace it." - (let ((case-fold-search nil) - entry key value) - (setq alist (sort (copy-sequence alist) - (lambda (a b) (< (length (car a)) (length (car b)))))) - (while (setq entry (pop alist)) + (let ((case-fold-search nil)) + (dolist (entry (sort (copy-sequence alist) + (lambda (a b) (< (length (car a)) (length (car b)))))) (setq template (replace-regexp-in-string (concat "%" (regexp-quote (car entry))) @@ -22545,23 +22551,24 @@ block from point." names)) nil))) -(defun org-occur-in-agenda-files (regexp &optional nlines) +(defun org-occur-in-agenda-files (regexp &optional _nlines) "Call `multi-occur' with buffers for all agenda files." - (interactive "sOrg-files matching: \np") + (interactive "sOrg-files matching: ") (let* ((files (org-agenda-files)) - (tnames (mapcar 'file-truename files)) - (extra org-agenda-text-search-extra-files) - f) + (tnames (mapcar #'file-truename files)) + (extra org-agenda-text-search-extra-files)) (when (eq (car extra) 'agenda-archives) (setq extra (cdr extra)) (setq files (org-add-archive-files files))) - (while (setq f (pop extra)) + (dolist (f extra) (unless (member (file-truename f) tnames) - (add-to-list 'files f 'append) - (add-to-list 'tnames (file-truename f) 'append))) + (unless (member f files) (setq files (append files (list f)))) + (setq tnames (append tnames (list (file-truename f)))))) (multi-occur (mapcar (lambda (x) (with-current-buffer + ;; FIXME: Why not just (find-file-noselect x)? + ;; Is it to avoid the "revert buffer" prompt? (or (get-file-buffer x) (find-file-noselect x)) (widen) (current-buffer))) @@ -22746,7 +22753,7 @@ so values can contain further %-escapes if they are define later in TABLE." (case-fold-search nil) (pchg 0) e re rpl) - (while (setq e (pop tbl)) + (dolist (e tbl) (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) (when (and (cdr e) (string-match re (cdr e))) (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0))) @@ -22809,7 +22816,7 @@ This works in the calendar and in the agenda, anywhere else it just returns the current time. If WITH-TIME is non-nil, returns the time of the event at point (in the agenda) or the current time of the day." - (let (date day defd tp tm hod mod) + (let (date day defd tp hod mod) (when with-time (setq tp (get-text-property (point) 'time)) (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) @@ -23642,7 +23649,7 @@ major mode." (insert "# "))) (defvar comment-empty-lines) ; From newcomment.el. -(defun org-comment-or-uncomment-region (beg end &rest ignore) +(defun org-comment-or-uncomment-region (beg end &rest _) "Comment or uncomment each non-blank line in the region. Uncomment each non-blank line between BEG and END if it only contains commented lines. Otherwise, comment them. If region is @@ -23809,6 +23816,10 @@ it has a `diary' type." ;;; Other stuff. +(defvar reftex-docstruct-symbol) +(defvar reftex-cite-format) +(defvar org--rds) + (defun org-reftex-citation () "Use reftex-citation to insert a citation into the buffer. This looks for a line like @@ -23823,9 +23834,9 @@ into the buffer. Export of such citations to both LaTeX and HTML is handled by the contributed package ox-bibtex by Taru Karttunen." (interactive) - (let ((reftex-docstruct-symbol 'rds) + (let ((reftex-docstruct-symbol 'org--rds) (reftex-cite-format "\\cite{%l}") - rds bib) + org--rds bib) (save-excursion (save-restriction (widen) @@ -23836,7 +23847,7 @@ package ox-bibtex by Taru Karttunen." (re-search-backward re nil t)))) (user-error "No bibliography defined in file") (setq bib (concat (match-string 1) ".bib") - rds (list (list 'bib bib))))))) + org--rds (list (list 'bib bib))))))) (call-interactively 'reftex-citation))) ;;;; Functions extending outline functionality @@ -23953,11 +23964,11 @@ the cursor is already beyond the end of the headline." (define-key org-mode-map "\C-a" 'org-beginning-of-line) (define-key org-mode-map "\C-e" 'org-end-of-line) -(defun org-backward-sentence (&optional arg) +(defun org-backward-sentence (&optional _arg) "Go to beginning of sentence, or beginning of table field. This will call `backward-sentence' or `org-table-beginning-of-field', depending on context." - (interactive "P") + (interactive) (let* ((element (org-element-at-point)) (contents-begin (org-element-property :contents-begin element)) (table (org-element-lineage element '(table) t))) @@ -23973,11 +23984,11 @@ depending on context." (org-element-property :contents-end element))) (call-interactively #'backward-sentence))))) -(defun org-forward-sentence (&optional arg) +(defun org-forward-sentence (&optional _arg) "Go to end of sentence, or end of table field. This will call `forward-sentence' or `org-table-end-of-field', depending on context." - (interactive "P") + (interactive) (let* ((element (org-element-at-point)) (contents-end (org-element-property :contents-end element)) (table (org-element-lineage element '(table) t))) @@ -23999,9 +24010,9 @@ depending on context." (define-key org-mode-map "\M-a" 'org-backward-sentence) (define-key org-mode-map "\M-e" 'org-forward-sentence) -(defun org-kill-line (&optional arg) +(defun org-kill-line (&optional _arg) "Kill line, to tags or end of line." - (interactive "P") + (interactive) (cond ((or (not org-special-ctrl-k) (bolp)