ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

161
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) (defun org-assign-fast-keys (alist)
"Assign fast keys to a keyword-key alist. "Assign fast keys to a keyword-key alist.
Respect keys that are already there." Respect keys that are already there."
(let (new e (alt ?0)) (let (new (alt ?0))
(while (setq e (pop alist)) (dolist (e alist)
(if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup)) (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup))
(cdr e)) ;; Key already assigned. (cdr e)) ;; Key already assigned.
(push e new) (push e new)
@ -5420,8 +5420,9 @@ The following commands are available:
(define-key org-mode-map [menu-bar show] 'undefined)) (define-key org-mode-map [menu-bar show] 'undefined))
(org-load-modules-maybe) (org-load-modules-maybe)
(when (featurep 'xemacs)
(easy-menu-add org-org-menu) (easy-menu-add org-org-menu)
(easy-menu-add org-tbl-menu) (easy-menu-add org-tbl-menu))
(org-install-agenda-files-menu) (org-install-agenda-files-menu)
(if org-descriptive-links (add-to-invisibility-spec '(org-link))) (if org-descriptive-links (add-to-invisibility-spec '(org-link)))
(add-to-invisibility-spec '(org-cwidth)) (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 (setq org-goto-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command
mouse-drag-region universal-argument org-occur)) mouse-drag-region universal-argument org-occur)))
cmd) (dolist (cmd cmds)
(while (setq cmd (pop cmds))
(substitute-key-definition cmd cmd map global-map))) (substitute-key-definition cmd cmd map global-map)))
(suppress-keymap map) (suppress-keymap map)
(org-defkey map "\C-m" 'org-goto-ret) (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) (while (string-match org-bracket-link-regexp s)
(setq s (replace-match (if (match-end 2) (setq s (replace-match (if (match-end 2)
(match-string 3 s) (match-string 3 s)
(match-string 1 s)) t t s))) (match-string 1 s))
t t s)))
(let ((st (format " %s " s))) (let ((st (format " %s " s)))
(while (string-match org-emph-re st) (while (string-match org-emph-re st)
(setq st (replace-match (format " %s " (match-string 4 st)) t t 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))) (list (car c) (car c) (cadr c)))
((string= "" (cadr c)) ((string= "" (cadr c))
(list (car c) (car c) (caddr c))) (list (car c) (car c) (caddr c)))
(t c))) contexts)) (t c)))
(a alist) c r s) contexts))
(a alist) r s)
;; loop over all commands or templates ;; loop over all commands or templates
(while (setq c (pop a)) (dolist (c a)
(let (vrules repl) (let (vrules repl)
(cond (cond
((not (assoc (car c) contexts)) ((not (assoc (car c) contexts))
@ -9364,7 +9366,8 @@ definitions."
(car c) contexts))) (car c) contexts)))
(mapc (lambda (vr) (mapc (lambda (vr)
(when (not (equal (car vr) (cadr vr))) (when (not (equal (car vr) (cadr vr)))
(setq repl vr))) vrules) (setq repl vr)))
vrules)
(if (not repl) (push c r) (if (not repl) (push c r)
(push (cadr repl) s) (push (cadr repl) s)
(push (push
@ -9382,13 +9385,15 @@ definitions."
(when (not (delq (when (not (delq
nil nil
(mapcar (lambda (y) (mapcar (lambda (y)
(equal y tpl)) s))) x))) (equal y tpl))
s)))
x)))
(reverse r)))))) (reverse r))))))
(defun org-contextualize-validate-key (key contexts) (defun org-contextualize-validate-key (key contexts)
"Check CONTEXTS for agenda or capture KEY." "Check CONTEXTS for agenda or capture KEY."
(let (r rr res) (let (rr res)
(while (setq r (pop contexts)) (dolist (r contexts)
(mapc (mapc
(lambda (rr) (lambda (rr)
(when (when
@ -9738,7 +9743,8 @@ active region."
(funcall (caar sfuns))) (funcall (caar sfuns)))
(setq link (plist-get org-store-link-plist :link) (setq link (plist-get org-store-link-plist :link)
desc (or (plist-get org-store-link-plist desc (or (plist-get org-store-link-plist
:description) link)))) :description)
link))))
;; Store a link from a source code buffer. ;; Store a link from a source code buffer.
((org-src-edit-buffer-p) ((org-src-edit-buffer-p)
@ -9925,7 +9931,8 @@ active region."
;; Return the link ;; Return the link
(if (not (and (or (org-called-interactively-p 'any) (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))) (or agenda-link (and link (org-make-link-string link desc)))
(push (list link desc) org-stored-links) (push (list link desc) org-stored-links)
(message "Stored: %s" (or desc link)) (message "Stored: %s" (or desc link))
@ -11524,12 +11531,9 @@ on the system \"/user@host:\"."
((eq t org-reverse-note-order) t) ((eq t org-reverse-note-order) t)
((not (listp org-reverse-note-order)) nil) ((not (listp org-reverse-note-order)) nil)
(t (catch 'exit (t (catch 'exit
(let ((all org-reverse-note-order) (dolist (entry org-reverse-note-order)
entry)
(while (setq entry (pop all))
(if (string-match (car entry) buffer-file-name) (if (string-match (car entry) buffer-file-name)
(throw 'exit (cdr entry)))) (throw 'exit (cdr entry))))))))
nil)))))
(defvar org-refile-target-table nil (defvar org-refile-target-table nil
"The list of refile targets, created by `org-refile'.") "The list of refile targets, created by `org-refile'.")
@ -11594,10 +11598,10 @@ on the system \"/user@host:\"."
(let ((case-fold-search nil) (let ((case-fold-search nil)
;; otherwise org confuses "TODO" as a kw and "Todo" as a word ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
(entries (or org-refile-targets '((nil . (:level . 1))))) (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...") (message "Getting targets...")
(with-current-buffer (or default-buffer (current-buffer)) (with-current-buffer (or default-buffer (current-buffer))
(while (setq entry (pop entries)) (dolist (entry entries)
(setq files (car entry) desc (cdr entry)) (setq files (car entry) desc (cdr entry))
(setq fast-path-p nil) (setq fast-path-p nil)
(cond (cond
@ -11630,7 +11634,7 @@ on the system \"/user@host:\"."
(cdr desc))) (cdr desc)))
"\\}[ \t]"))) "\\}[ \t]")))
(t (error "Bad refiling target description %s" desc))) (t (error "Bad refiling target description %s" desc)))
(while (setq f (pop files)) (dolist (f files)
(with-current-buffer (with-current-buffer
(if (bufferp f) f (org-get-agenda-file-buffer f)) (if (bufferp f) f (org-get-agenda-file-buffer f))
(or (or
@ -13030,13 +13034,12 @@ This hook runs even if there is no statistics cookie present, in which case
(defun org-local-logging (value) (defun org-local-logging (value)
"Get logging settings from a property VALUE." "Get logging settings from a property VALUE."
(let* (words w a) ;; Directly set the variables, they are already local.
;; directly set the variables, they are already local.
(setq org-log-done nil (setq org-log-done nil
org-log-repeat nil org-log-repeat nil
org-todo-log-states nil) org-todo-log-states nil)
(setq words (org-split-string value)) (dolist (w (org-split-string value))
(while (setq w (pop words)) (let* (a)
(cond (cond
((setq a (assoc w org-startup-options)) ((setq a (assoc w org-startup-options))
(and (member (nth 1 a) '(org-log-done org-log-repeat)) (and (member (nth 1 a) '(org-log-done org-log-repeat))
@ -13073,7 +13076,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
(expert nil) (expert nil)
(fwidth (+ maxlen 3 1 3)) (fwidth (+ maxlen 3 1 3))
(ncol (/ (- (window-width) 4) fwidth)) (ncol (/ (- (window-width) 4) fwidth))
tg cnt e c tbl tg cnt c tbl
groups ingroup) groups ingroup)
(save-excursion (save-excursion
(save-window-excursion (save-window-excursion
@ -13083,7 +13086,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
(erase-buffer) (erase-buffer)
(org-set-local 'org-done-keywords done-keywords) (org-set-local 'org-done-keywords done-keywords)
(setq tbl fulltable cnt 0) (setq tbl fulltable cnt 0)
(while (setq e (pop tbl)) (dolist (e tbl)
(cond (cond
((equal e '(:startgroup)) ((equal e '(:startgroup))
(push '() groups) (setq ingroup t) (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:]_@#%]+\\)")) (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)"))
minus tag mm minus tag mm
tagsmatch todomatch tagsmatcher todomatcher kwd matcher 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)) prop-p pn pv po gv rest (start 0) (ss 0))
;; Expand group tags ;; Expand group tags
(setq match (org-tags-expand match)) (setq match (org-tags-expand match))
@ -14478,7 +14481,7 @@ See also `org-scan-tags'.
(if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch))) (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch)))
(setq tagsmatcher t) (setq tagsmatcher t)
(setq orterms (org-split-string tagsmatch "|") orlist nil) (setq orterms (org-split-string tagsmatch "|") orlist nil)
(while (setq term (pop orterms)) (dolist (term orterms)
(while (and (equal (substring term -1) "\\") orterms) (while (and (equal (substring term -1) "\\") orterms)
(setq term (concat term "|" (pop orterms)))) ; repair bad split (setq term (concat term "|" (pop orterms)))) ; repair bad split
(while (string-match re term) (while (string-match re term)
@ -14539,7 +14542,7 @@ See also `org-scan-tags'.
(if (or (not todomatch) (not (string-match "\\S-" todomatch))) (if (or (not todomatch) (not (string-match "\\S-" todomatch)))
(setq todomatcher t) (setq todomatcher t)
(setq orterms (org-split-string todomatch "|") orlist nil) (setq orterms (org-split-string todomatch "|") orlist nil)
(while (setq term (pop orterms)) (dolist (term orterms)
(while (string-match re term) (while (string-match re term)
(setq minus (and (match-end 1) (setq minus (and (match-end 1)
(equal (match-string 1 term) "-")) (equal (match-string 1 term) "-"))
@ -14623,7 +14626,8 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(with-syntax-table stable (with-syntax-table stable
(string-match (string-match
(concat "\\(?1:[+-]?\\)\\(?2:\\<" (concat "\\(?1:[+-]?\\)\\(?2:\\<"
(regexp-opt taggroups-keys) "\\>\\)") return-match))) (regexp-opt taggroups-keys) "\\>\\)")
return-match)))
(let* ((dir (match-string 1 return-match)) (let* ((dir (match-string 1 return-match))
(tag (match-string 2 return-match)) (tag (match-string 2 return-match))
(tag (if downcased (downcase tag) tag))) (tag (if downcased (downcase tag) tag)))
@ -14829,7 +14833,8 @@ ignore inherited ones."
(reverse (delete-dups (reverse (delete-dups
(reverse (append (reverse (append
(org-remove-uninherited-tags (org-remove-uninherited-tags
org-file-tags) tags))))))))) org-file-tags)
tags)))))))))
(defun org-add-prop-inherited (s) (defun org-add-prop-inherited (s)
(add-text-properties 0 (length s) '(inherited t) 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)) (ncol (/ (- (window-width) 4) fwidth))
(i-face 'org-done) (i-face 'org-done)
(c-face 'org-todo) (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 ov-start ov-end ov-prefix
(exit-after-next org-fast-tag-selection-single-key) (exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords) (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-fast-tag-show-exit exit-after-next)
(org-set-current-tags-overlay current ov-prefix) (org-set-current-tags-overlay current ov-prefix)
(setq tbl fulltable char ?a cnt 0) (setq tbl fulltable char ?a cnt 0)
(while (setq e (pop tbl)) (dolist (e tbl)
(cond (cond
((eq (car e) :startgroup) ((eq (car e) :startgroup)
(push '() groups) (setq ingroup t) (push '() groups) (setq ingroup t)
@ -15500,7 +15505,7 @@ a *different* entry, you cannot use these techniques."
((eq scope 'file-with-archives) ((eq scope 'file-with-archives)
(setq scope (org-add-archive-files (list (buffer-file-name)))))) (setq scope (org-add-archive-files (list (buffer-file-name))))))
(org-agenda-prepare-buffers scope) (org-agenda-prepare-buffers scope)
(while (setq file (pop scope)) (dolist (file scope)
(with-current-buffer (org-find-base-buffer-visiting file) (with-current-buffer (org-find-base-buffer-visiting file)
(save-excursion (save-excursion
(save-restriction (save-restriction
@ -16532,7 +16537,7 @@ only headings."
(widen) (widen)
(setq limit (point-max)) (setq limit (point-max))
(goto-char (point-min)) (goto-char (point-min))
(while (setq heading (pop path)) (dolist (heading path)
(setq re (format org-complex-heading-regexp-format (setq re (format org-complex-heading-regexp-format
(regexp-quote heading))) (regexp-quote heading)))
(setq cnt 0 pos (point)) (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." When the target headline is found, return a marker to this location."
(let ((files (directory-files (or dir default-directory) (let ((files (directory-files (or dir default-directory)
t "\\`[^.#].*\\.org\\'")) t "\\`[^.#].*\\.org\\'"))
file visiting m buffer) visiting m buffer)
(catch 'found (catch 'found
(while (setq file (pop files)) (dolist (file files)
(message "trying %s" file) (message "trying %s" file)
(setq visiting (org-find-base-buffer-visiting file)) (setq visiting (org-find-base-buffer-visiting file))
(setq buffer (or visiting (find-file-noselect 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) file)
(unless files (user-error "No agenda files")) (unless files (user-error "No agenda files"))
(catch 'exit (catch 'exit
(while (setq file (pop files)) (dolist (file files)
(if (equal (file-truename file) tcf) (if (equal (file-truename file) tcf)
(when (car files) (when (car files)
(find-file (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. "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 When a buffer is unmodified, it is just killed. When modified, it is saved
\(if the user agrees) and then killed." \(if the user agrees) and then killed."
(let (buf file) (let (file)
(while (setq buf (pop blist)) (dolist (buf blist)
(setq file (buffer-file-name buf)) (setq file (buffer-file-name buf))
(when (and (buffer-modified-p buf) (when (and (buffer-modified-p buf)
file 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) org-tag-groups-alist-for-agenda nil)
(save-excursion (save-excursion
(save-restriction (save-restriction
(while (setq file (pop files)) (dolist (file files)
(catch 'nextfile (catch 'nextfile
(if (bufferp file) (if (bufferp file)
(set-buffer file) (set-buffer file)
@ -19735,7 +19740,7 @@ boundaries."
(org-defkey org-mode-map "\C-i" 'org-cycle) (org-defkey org-mode-map "\C-i" 'org-cycle)
(org-defkey org-mode-map [(tab)] '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 [(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 ;; The following line is necessary under Suse GNU/Linux
(unless (featurep 'xemacs) (unless (featurep 'xemacs)
(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) (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 (right)] 'org-shiftright)
(org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) (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 [?\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 return)] 'org-insert-todo-heading)
(org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft) (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft)
(org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright) (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright)
@ -21607,11 +21612,11 @@ number of stars to add."
(forward-line))))))) (forward-line)))))))
(unless toggled (message "Cannot toggle heading from here")))) (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. "Insert a new heading or wrap a region in a table.
Calls `org-insert-heading' or `org-table-wrap-region', depending Calls `org-insert-heading' or `org-table-wrap-region', depending
on context. See the individual commands for more information." on context. See the individual commands for more information."
(interactive "P") (interactive)
(org-check-before-invisible-edit 'insert) (org-check-before-invisible-edit 'insert)
(or (run-hook-with-args-until-success 'org-metareturn-hook) (or (run-hook-with-args-until-success 'org-metareturn-hook)
(call-interactively (if (org-at-table-p) #'org-table-wrap-region (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." information about your Org-mode version and configuration."
(interactive) (interactive)
(require 'reporter) (require 'reporter)
(defvar reporter-prompt-for-summary-p)
(org-load-modules-maybe) (org-load-modules-maybe)
(org-require-autoloaded-modules) (org-require-autoloaded-modules)
(let ((reporter-prompt-for-summary-p "Bug report subject: ")) (let ((reporter-prompt-for-summary-p "Bug report subject: "))
@ -22152,11 +22158,13 @@ upon the next fontification round."
'invisible 'org-link s)) 'invisible 'org-link s))
(setq s (concat (substring s 0 b) (setq s (concat (substring s 0 b)
(substring s (or (next-single-property-change (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)) (while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
(setq s (concat (substring s 0 b) (setq s (concat (substring s 0 b)
(substring s (or (next-single-property-change (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) (setq l (string-width s) b -1)
(while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) (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)))) (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) (defun org-fill-template (template alist)
"Find each %key of ALIST in TEMPLATE and replace it." "Find each %key of ALIST in TEMPLATE and replace it."
(let ((case-fold-search nil) (let ((case-fold-search nil))
entry key value) (dolist (entry (sort (copy-sequence alist)
(setq alist (sort (copy-sequence alist)
(lambda (a b) (< (length (car a)) (length (car b)))))) (lambda (a b) (< (length (car a)) (length (car b))))))
(while (setq entry (pop alist))
(setq template (setq template
(replace-regexp-in-string (replace-regexp-in-string
(concat "%" (regexp-quote (car entry))) (concat "%" (regexp-quote (car entry)))
@ -22545,23 +22551,24 @@ block from point."
names)) names))
nil))) 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." "Call `multi-occur' with buffers for all agenda files."
(interactive "sOrg-files matching: \np") (interactive "sOrg-files matching: ")
(let* ((files (org-agenda-files)) (let* ((files (org-agenda-files))
(tnames (mapcar 'file-truename files)) (tnames (mapcar #'file-truename files))
(extra org-agenda-text-search-extra-files) (extra org-agenda-text-search-extra-files))
f)
(when (eq (car extra) 'agenda-archives) (when (eq (car extra) 'agenda-archives)
(setq extra (cdr extra)) (setq extra (cdr extra))
(setq files (org-add-archive-files files))) (setq files (org-add-archive-files files)))
(while (setq f (pop extra)) (dolist (f extra)
(unless (member (file-truename f) tnames) (unless (member (file-truename f) tnames)
(add-to-list 'files f 'append) (unless (member f files) (setq files (append files (list f))))
(add-to-list 'tnames (file-truename f) 'append))) (setq tnames (append tnames (list (file-truename f))))))
(multi-occur (multi-occur
(mapcar (lambda (x) (mapcar (lambda (x)
(with-current-buffer (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)) (or (get-file-buffer x) (find-file-noselect x))
(widen) (widen)
(current-buffer))) (current-buffer)))
@ -22746,7 +22753,7 @@ so values can contain further %-escapes if they are define later in TABLE."
(case-fold-search nil) (case-fold-search nil)
(pchg 0) (pchg 0)
e re rpl) e re rpl)
(while (setq e (pop tbl)) (dolist (e tbl)
(setq re (concat "%-?[0-9.]*" (substring (car e) 1))) (setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
(when (and (cdr e) (string-match re (cdr e))) (when (and (cdr e) (string-match re (cdr e)))
(let ((sref (substring (cdr e) (match-beginning 0) (match-end 0))) (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. returns the current time.
If WITH-TIME is non-nil, returns the time of the event at point (in If WITH-TIME is non-nil, returns the time of the event at point (in
the agenda) or the current time of the day." 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 (when with-time
(setq tp (get-text-property (point) 'time)) (setq tp (get-text-property (point) 'time))
(when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp))
@ -23642,7 +23649,7 @@ major mode."
(insert "# "))) (insert "# ")))
(defvar comment-empty-lines) ; From newcomment.el. (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. "Comment or uncomment each non-blank line in the region.
Uncomment each non-blank line between BEG and END if it only Uncomment each non-blank line between BEG and END if it only
contains commented lines. Otherwise, comment them. If region is contains commented lines. Otherwise, comment them. If region is
@ -23809,6 +23816,10 @@ it has a `diary' type."
;;; Other stuff. ;;; Other stuff.
(defvar reftex-docstruct-symbol)
(defvar reftex-cite-format)
(defvar org--rds)
(defun org-reftex-citation () (defun org-reftex-citation ()
"Use reftex-citation to insert a citation into the buffer. "Use reftex-citation to insert a citation into the buffer.
This looks for a line like 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 Export of such citations to both LaTeX and HTML is handled by the contributed
package ox-bibtex by Taru Karttunen." package ox-bibtex by Taru Karttunen."
(interactive) (interactive)
(let ((reftex-docstruct-symbol 'rds) (let ((reftex-docstruct-symbol 'org--rds)
(reftex-cite-format "\\cite{%l}") (reftex-cite-format "\\cite{%l}")
rds bib) org--rds bib)
(save-excursion (save-excursion
(save-restriction (save-restriction
(widen) (widen)
@ -23836,7 +23847,7 @@ package ox-bibtex by Taru Karttunen."
(re-search-backward re nil t)))) (re-search-backward re nil t))))
(user-error "No bibliography defined in file") (user-error "No bibliography defined in file")
(setq bib (concat (match-string 1) ".bib") (setq bib (concat (match-string 1) ".bib")
rds (list (list 'bib bib))))))) org--rds (list (list 'bib bib)))))))
(call-interactively 'reftex-citation))) (call-interactively 'reftex-citation)))
;;;; Functions extending outline functionality ;;;; 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-a" 'org-beginning-of-line)
(define-key org-mode-map "\C-e" 'org-end-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. "Go to beginning of sentence, or beginning of table field.
This will call `backward-sentence' or `org-table-beginning-of-field', This will call `backward-sentence' or `org-table-beginning-of-field',
depending on context." depending on context."
(interactive "P") (interactive)
(let* ((element (org-element-at-point)) (let* ((element (org-element-at-point))
(contents-begin (org-element-property :contents-begin element)) (contents-begin (org-element-property :contents-begin element))
(table (org-element-lineage element '(table) t))) (table (org-element-lineage element '(table) t)))
@ -23973,11 +23984,11 @@ depending on context."
(org-element-property :contents-end element))) (org-element-property :contents-end element)))
(call-interactively #'backward-sentence))))) (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. "Go to end of sentence, or end of table field.
This will call `forward-sentence' or `org-table-end-of-field', This will call `forward-sentence' or `org-table-end-of-field',
depending on context." depending on context."
(interactive "P") (interactive)
(let* ((element (org-element-at-point)) (let* ((element (org-element-at-point))
(contents-end (org-element-property :contents-end element)) (contents-end (org-element-property :contents-end element))
(table (org-element-lineage element '(table) t))) (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-a" 'org-backward-sentence)
(define-key org-mode-map "\M-e" 'org-forward-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." "Kill line, to tags or end of line."
(interactive "P") (interactive)
(cond (cond
((or (not org-special-ctrl-k) ((or (not org-special-ctrl-k)
(bolp) (bolp)