mirrors/org-mode
0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-29 18:36:26 +00:00
Code Releases Activity

Backport commit 3a5f751 from Emacs master branch

Browse source 
* 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
This commit is contained in:
Stefan Monnier 2015-08-08 19:41:57 -04:00 committed by Kyle Meyer
parent 3b20eed34a
commit ef96370304
1 changed files with 97 additions and 86 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

183
lisp/org.el
View file

@ -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)