summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2015-08-08 19:41:57 -0400
committerKyle Meyer <kyle@kyleam.com>2015-08-09 21:28:06 -0400
commitef9637030456b153fd834f4c9202a9264d5ef18d (patch)
tree98dea1a483a2cd28479f6ccec02e43094f3c9978
parent3b20eed34ab39a91bb3922574c750724427966c8 (diff)
downloadorg-mode-ef9637030456b153fd834f4c9202a9264d5ef18d.tar.gz
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
-rwxr-xr-xlisp/org.el183
1 files changed, 97 insertions, 86 deletions
diff --git a/lisp/org.el b/lisp/org.el
index 685489e..c062c3e 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)