diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2021-02-23 15:47:29 -0500 |
|---|---|---|
| committer | Kyle Meyer <kyle@kyleam.com> | 2021-03-09 22:56:33 -0500 |
| commit | 129c33dddfa80202f23756ad5b513acdc036591c (patch) | |
| tree | 0a14031e518df6e6939b58381f521b7fbddbd3c0 | |
| parent | 5263eff5a3f5f0fce83914828369271e6a981123 (diff) | |
| download | org-mode-129c33dddfa80202f23756ad5b513acdc036591c.tar.gz | |
* lisp/org-agenda.el: Use lexical-binding
- Removed the global (defvar date) and (defvar entry) so as not to
conflict with function arguments of that name. Instead I added such
`defvar`s in the body of each of the functions where it
seemed needed.
- I added some FIXMEs for some issues I found along the way.
- Added an `org-dlet` macro, just like I had done for `calendar-dlet`,
but I also use `defvar` "manually" at some places, when splitting an
existing `let` into a mix of `let`s and `dlet`s seemed too much trouble.
- Removed uses of `org-let and `org-let2` not only because I consider
them offensive to my sense of aesthetics but also because they're
basically incompatible with lexical scoping.
I replaced them with uses of `cl-progv` which are a bit more verbose.
Maybe we should define some `org-progv` macro on top of `cl-progv` to
make the code less verbose, but I didn't do that because I like the
fact that the current code makes uses of `eval` a bit more obvious
(since these behave differently with lexical scoping than with
lexical binding, it seemed worthwhile).
- Removed the use of `eval` in `org-store-agenda-views` which was only
placed there in order to use a macro before it's defined (it would
have been simpler/cleaner to just move that functions *after* the
macro, but with the new code the problem doesn't occur any more anyway).
- Replaced a few `(lambda...) with actual closures.
Detailed changes follow:
(date, entry): Don't declare as being globally dynbound.
(org-agenda-format-date-aligned): Remove unused var `weekyear`.
(org-agenda-mode): `run-mode-hooks` is always available nowadays.
(org-agenda-undo): Remove unused var `last-undo-buffer`.
(org-agenda): Rename arg to `keys` and then dyn-bind it as `org-keys`.
Remove unused vars `buf` and `key`.
(org-agenda): Use `pcase` and `cl-progv` instead of `org-let`.
(org-let, org-let2): Mark as obsolete.
(org-agenda-run-series): Use `cl-progv` instead of `org-let` and `org-let2`.
(org-agenda-run-series): New function.
(org--batch-agenda): New function extracted from `org-batch-agenda`.
(org-batch-agenda): Use it.
(org--batch-agenda-csv): New function extracted from `org-batch-agenda-csv`.
(org-batch-agenda-csv): Use it.
(org--batch-store-agenda-views): New function, extracted from
`org-batch-store-agenda-views`.
(org-store-agenda-views, org-batch-store-agenda-views): Use it.
(org--batch-store-agenda-views): Use `cl-progv` instead of
`org-eval-in-environment`.
(org-agenda-write): Use `cl-progv` instead of `org-let`.
Use `with-current-buffer`.
(org-agenda-filter-any): Use `cl-some` instead of `eval`.
(org-agenda-list): Remove unused var `e`.
(org-search-view): η-reduce.
(crm-separator): Declare var.
(org-agenda-skip-if): Remove unused var `beg`.
(org-agenda-list-stuck-projects): Use a closure rather than `(lambda..).
(diary-modify-entry-list-string-function, diary-file-name-prefix)
(diary-display-function): Declare vars.
(org-diary): Declare `date` and `entry` as dynbound.
(org-agenda-get-day-entries): Use `org-dlet`.
(org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled, org-agenda-get-blocks):
Declare `date` as dynbound.
(org-agenda-get-sexps, org-class): Declare `date` and `entry` as dynbound.
(org-agenda-format-item): Declare the vars mentioned in
`org-compile-prefix-format` as dyn-bound.
Also binding `extra`, suggested by Kyle Meyer <kyle@kyleam.com>.
(org-compile-prefix-format): Remove unused var `e`.
Use `member` rather than or+equal.
(org-set-sorting-strategy): Minor simplification.
(org-entries-lessp): Use `org-dlet`.
(org-agenda-redo): Declare var `org-agenda-tag-filter-while-redo`.
(org-agenda-redo): Use `cl-progv` rather than `org-let`.
(org-agenda-filter): Remove unused var `rpl-fn`.
Use `org-pushnew-to-end` to replace `add-to-list` on lexical var.
(org-agenda-filter-by-tag): Remove unused var `n`.
(org-agenda-filter-apply): Use `org-dlet`.
(org-agenda-compute-starting-span): Remove unused var `dg`.
(org-agenda-forward-block): Remove unused var `pos`.
(org-archive-from-agenda): Declare var.
(org-agenda-refile): Remove unused var `pos`.
(org-agenda-headline-snapshot-before-repeat): Declare var.
(org-agenda-todo): Remove redundant use of `bound-and-true-p`.
(org-agenda-add-note): Remove unused var `hdmarker` and unused `arg`.
(org-agenda-change-all-lines): Remove unused var `pl`.
(org-agenda-priority): Remove unused var `marker`.
(org-agenda-set-effort): Remove unused var `newhead`.
(org-agenda-schedule): Remove unused var `type`.
(org-agenda-clock-cancel): Remove unused `arg`.
(org-agenda-execute-calendar-command): Use `org-dlet`.
(org-agenda-bulk-action): Use closures instead of `(lambda ...).
(org-agenda-show-the-flagging-note): Remove unused vars `heading` and
`newhead`.
(org-agenda-remove-flag): Avoid `setq`.
* testing/org-test.el (org--compile-when): New macro.
(org-test-jump): Use it so compilation doesn't fail or generate broken
code when `jump` is not available.
* testing/lisp/test-org-src.el:
* testing/lisp/test-org-attach.el:
* testing/lisp/test-org-agenda.el:
* testing/lisp/test-ob-java.el: Pass explicit filename to `require`
so as not to rely on ".../testing" being in `load-path` during compilation.
* lisp/org-num.el: Require` org`.
* lisp/org-macs.el (org-eval-in-environment): Declare obsolete.
(org-dlet, org-pushnew-to-end): New macros.
* doc/Makefile (org.texi, orgguide.texi, %_letter.tex): Simplify quoting.
* contrib/lisp/ob-sclang.el: Don't crash compilation when `sclang`
is not available.
* contrib/lisp/ob-clojure-literate.el: Don't crash compilation when `cider`
is not available.
* contrib/lisp/ob-arduino.el: Don't crash compilation when `arduino-mode`
is not available.
* .gitignore: Add files generated during `make packages/org`.
| -rw-r--r-- | .gitignore | 6 | ||||
| -rw-r--r-- | contrib/lisp/ob-arduino.el | 2 | ||||
| -rw-r--r-- | contrib/lisp/ob-clojure-literate.el | 2 | ||||
| -rw-r--r-- | contrib/lisp/ob-sclang.el | 2 | ||||
| -rw-r--r-- | doc/Makefile | 14 | ||||
| -rw-r--r-- | lisp/org-agenda.el | 869 | ||||
| -rw-r--r-- | lisp/org-macs.el | 39 | ||||
| -rw-r--r-- | lisp/org-num.el | 3 | ||||
| -rw-r--r-- | testing/lisp/test-ob-java.el | 2 | ||||
| -rw-r--r-- | testing/lisp/test-org-agenda.el | 2 | ||||
| -rw-r--r-- | testing/lisp/test-org-attach.el | 2 | ||||
| -rw-r--r-- | testing/lisp/test-org-src.el | 2 | ||||
| -rw-r--r-- | testing/org-test.el | 13 |
13 files changed, 541 insertions, 417 deletions
@@ -49,6 +49,12 @@ local*.mk mk/x11idle ChangeLog +# Files generated during `make packages/org` in a clone of `elpa.git`. + +/org-pkg.el +/org-autoloads.el +/lisp/org-autoloads.el + # texi2pdf --tidy doc/*.t2d diff --git a/contrib/lisp/ob-arduino.el b/contrib/lisp/ob-arduino.el index 57a15ff..8a1fd76 100644 --- a/contrib/lisp/ob-arduino.el +++ b/contrib/lisp/ob-arduino.el @@ -33,7 +33,7 @@ (require 'org) (require 'ob) -(require 'arduino-mode) +(require 'arduino-mode nil t) (defgroup ob-arduino nil "org-mode blocks for Arduino." diff --git a/contrib/lisp/ob-clojure-literate.el b/contrib/lisp/ob-clojure-literate.el index b1cc386..cd2dcff 100644 --- a/contrib/lisp/ob-clojure-literate.el +++ b/contrib/lisp/ob-clojure-literate.el @@ -20,7 +20,7 @@ ;;; Code: (require 'ob-clojure) -(require 'cider) +(require 'cider nil t) (defgroup ob-clojure-literate nil "Clojure's Org-mode Literate Programming." diff --git a/contrib/lisp/ob-sclang.el b/contrib/lisp/ob-sclang.el index 5ab2686..0b01fc5 100644 --- a/contrib/lisp/ob-sclang.el +++ b/contrib/lisp/ob-sclang.el @@ -60,7 +60,7 @@ (require 'org) (require 'ob) -(require 'sclang) +(require 'sclang nil t) (defgroup ob-sclang nil "org-mode blocks for SuperCollider SCLang." diff --git a/doc/Makefile b/doc/Makefile index 96fda14..dc68829 100644 --- a/doc/Makefile +++ b/doc/Makefile @@ -28,9 +28,9 @@ guide:: orgguide.texi org-version.inc endif org.texi orgguide.texi: org-manual.org org-guide.org - $(BATCH) \ - --eval '(add-to-list '"'"'load-path "../lisp")' \ - --eval '(load "../mk/org-fixup.el")' \ + $(BATCH) \ + --eval '(add-to-list `load-path "../lisp")' \ + --eval '(load "../mk/org-fixup.el")' \ --eval '(org-make-manuals)' org-version.inc: org.texi @@ -88,8 +88,8 @@ ifneq ($(SERVERMK),) endif %_letter.tex: %.tex - $(BATCH) \ - --eval '(add-to-list '"'"'load-path "../lisp")' \ - --eval '(load "org-compat.el")' \ - --eval '(load "../mk/org-fixup.el")' \ + $(BATCH) \ + --eval '(add-to-list `load-path "../lisp")' \ + --eval '(load "org-compat.el")' \ + --eval '(load "../mk/org-fixup.el")' \ --eval '(org-make-letterformat "$(<F)" "$(@F)")' diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index ed976bf..33b3786 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1,4 +1,4 @@ -;;; org-agenda.el --- Dynamic task and appointment lists for Org +;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2021 Free Software Foundation, Inc. @@ -99,8 +99,8 @@ (defvar org-agenda-buffer-name "*Org Agenda*") (defvar org-agenda-overriding-header nil) (defvar org-agenda-title-append nil) -(with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el -(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el +;; (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el +;; (with-no-warnings (defvar date)) ;; unprefixed, from calendar.el (defvar original-date) ; dynamically scoped, calendar.el does scope this (defvar org-agenda-undo-list nil @@ -148,6 +148,8 @@ addresses the separator between the current and the previous block." :type 'boolean) (defcustom org-agenda-exporter-settings nil + ;; FIXME: Do we really want to evaluate those settings and thus force + ;; the user to use `quote' all the time? "Alist of variable/value pairs that should be active during agenda export. This is a good place to set options for ps-print and for htmlize. Note that the way this is implemented, the values will be evaluated @@ -1188,11 +1190,11 @@ This function makes sure that dates are aligned for easy reading." (year (nth 2 date)) (iso-week (org-days-to-iso-week (calendar-absolute-from-gregorian date))) - (weekyear (cond ((and (= month 1) (>= iso-week 52)) - (1- year)) - ((and (= month 12) (<= iso-week 1)) - (1+ year)) - (t year))) + ;; (weekyear (cond ((and (= month 1) (>= iso-week 52)) + ;; (1- year)) + ;; ((and (= month 12) (<= iso-week 1)) + ;; (1+ year)) + ;; (t year))) (weekstring (if (= day-of-week 1) (format " W%02d" iso-week) ""))) @@ -2269,7 +2271,7 @@ The following commands are available: (setq-local org-agenda-this-buffer-is-sticky t)) (org-agenda-sticky ;; Creating a sticky Agenda buffer for the first time - (mapc 'make-local-variable org-agenda-local-vars) + (mapc #'make-local-variable org-agenda-local-vars) (setq-local org-agenda-this-buffer-is-sticky t)) (t ;; Creating a non-sticky agenda buffer @@ -2287,8 +2289,8 @@ The following commands are available: (use-local-map org-agenda-mode-map) (when org-startup-truncated (setq truncate-lines t)) (setq-local line-move-visual nil) - (add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) - (add-hook 'pre-command-hook 'org-unhighlight nil 'local) + (add-hook 'post-command-hook #'org-agenda-update-agenda-type nil 'local) + (add-hook 'pre-command-hook #'org-unhighlight nil 'local) ;; Make sure properties are removed when copying text (if (boundp 'filter-buffer-substring-functions) (add-hook 'filter-buffer-substring-functions @@ -2316,11 +2318,9 @@ The following commands are available: '(org-edit-agenda-file-list) (not (get 'org-agenda-files 'org-restrict))) "--") - (mapcar 'org-file-menu-entry (org-agenda-files)))) + (mapcar #'org-file-menu-entry (org-agenda-files)))) (org-agenda-set-mode-name) - (apply - (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks) - (list 'org-agenda-mode-hook))) + (run-mode-hooks 'org-agenda-mode-hook)) (substitute-key-definition #'undo #'org-agenda-undo org-agenda-mode-map global-map) @@ -2660,7 +2660,7 @@ that have been changed along." (while (bufferp (setq buf (pop entry))) (when (pop entry) (with-current-buffer buf - (let ((last-undo-buffer buf) + (let (;; (last-undo-buffer buf) (inhibit-read-only t)) (unless (memq buf org-agenda-undo-has-started-in) (push buf org-agenda-undo-has-started-in) @@ -2812,7 +2812,7 @@ to limit entries to in this type." (defvar org-keys nil) (defvar org-match nil) ;;;###autoload -(defun org-agenda (&optional arg org-keys restriction) +(defun org-agenda (&optional arg keys restriction) "Dispatch agenda commands to collect entries to the agenda buffer. Prompts for a command to execute. Any prefix arg will be passed on to the selected command. The default selections are: @@ -2847,7 +2847,8 @@ Pressing `<' twice means to restrict to the current subtree or region \(if active)." (interactive "P") (catch 'exit - (let* ((prefix-descriptions nil) + (let* ((org-keys keys) + (prefix-descriptions nil) (org-agenda-buffer-name org-agenda-buffer-name) (org-agenda-window-setup (if (equal (buffer-name) org-agenda-buffer-name) @@ -2869,9 +2870,9 @@ Pressing `<' twice means to restrict to the current subtree or region (org-agenda-custom-commands (org-contextualize-keys org-agenda-custom-commands org-agenda-custom-commands-contexts)) - (buf (current-buffer)) + ;; (buf (current-buffer)) (bfn (buffer-file-name (buffer-base-buffer))) - entry key type org-match lprops ans) + entry type org-match lprops ans) ;; key ;; Turn off restriction unless there is an overriding one, (unless org-agenda-overriding-restriction (unless org-agenda-keep-restricted-file-list @@ -2923,47 +2924,51 @@ Pressing `<' twice means to restrict to the current subtree or region ((setq entry (assoc org-keys org-agenda-custom-commands)) (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) (progn - (setq type (nth 2 entry) org-match (eval (nth 3 entry)) + ;; FIXME: Is (nth 3 entry) supposed to have access (via dynvars) + ;; to some of the local variables? There's no doc about + ;; that for `org-agenda-custom-commands'. + (setq type (nth 2 entry) org-match (eval (nth 3 entry) t) lprops (nth 4 entry)) (when org-agenda-sticky (setq org-agenda-buffer-name (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match)) (format "*Org Agenda(%s)*" org-keys)))) (put 'org-agenda-redo-command 'org-lprops lprops) - (cond - ((eq type 'agenda) - (org-let lprops '(org-agenda-list current-prefix-arg))) - ((eq type 'agenda*) - (org-let lprops '(org-agenda-list current-prefix-arg nil nil t))) - ((eq type 'alltodo) - (org-let lprops '(org-todo-list current-prefix-arg))) - ((eq type 'search) - (org-let lprops '(org-search-view current-prefix-arg org-match nil))) - ((eq type 'stuck) - (org-let lprops '(org-agenda-list-stuck-projects - current-prefix-arg))) - ((eq type 'tags) - (org-let lprops '(org-tags-view current-prefix-arg org-match))) - ((eq type 'tags-todo) - (org-let lprops '(org-tags-view '(4) org-match))) - ((eq type 'todo) - (org-let lprops '(org-todo-list org-match))) - ((eq type 'tags-tree) - (org-check-for-org-mode) - (org-let lprops '(org-match-sparse-tree current-prefix-arg org-match))) - ((eq type 'todo-tree) - (org-check-for-org-mode) - (org-let lprops - '(org-occur (concat "^" org-outline-regexp "[ \t]*" - (regexp-quote org-match) "\\>")))) - ((eq type 'occur-tree) - (org-check-for-org-mode) - (org-let lprops '(org-occur org-match))) - ((functionp type) - (org-let lprops '(funcall type org-match))) - ((fboundp type) - (org-let lprops '(funcall type org-match))) - (t (user-error "Invalid custom agenda command type %s" type)))) + (cl-progv + (mapcar #'car lprops) + (mapcar (lambda (binding) (eval (cadr binding) t)) lprops) + (pcase type + (`agenda + (org-agenda-list current-prefix-arg)) + (`agenda* + (org-agenda-list current-prefix-arg nil nil t)) + (`alltodo + (org-todo-list current-prefix-arg)) + (`search + (org-search-view current-prefix-arg org-match nil)) + (`stuck + (org-agenda-list-stuck-projects current-prefix-arg)) + (`tags + (org-tags-view current-prefix-arg org-match)) + (`tags-todo + (org-tags-view '(4) org-match)) + (`todo + (org-todo-list org-match)) + (`tags-tree + (org-check-for-org-mode) + (org-match-sparse-tree current-prefix-arg org-match)) + (`todo-tree + (org-check-for-org-mode) + (org-occur (concat "^" org-outline-regexp "[ \t]*" + (regexp-quote org-match) "\\>"))) + (`occur-tree + (org-check-for-org-mode) + (org-occur org-match)) + ((pred functionp) + (funcall type org-match)) + ;; FIXME: Will signal an error since it's not `functionp'! + ((pred fboundp) (funcall type org-match)) + (_ (user-error "Invalid custom agenda command type %s" type))))) (org-agenda-run-series (nth 1 entry) (cddr entry)))) ((equal org-keys "C") (setq org-agenda-custom-commands org-agenda-custom-commands-orig) @@ -3242,70 +3247,79 @@ s Search for keywords M Like m, but only TODO entries (defvar org-agenda-overriding-cmd-arguments nil) (defun org-let (list &rest body) ;FIXME: So many kittens are suffering here. - (declare (indent 1)) + (declare (indent 1) (obsolete cl-progv "Mar 2021")) (eval (cons 'let (cons list body)))) (defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go? - (declare (indent 2)) + (declare (indent 2) (obsolete cl-progv "Mar 2021")) (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) (defun org-agenda-run-series (name series) "Run agenda NAME as a SERIES of agenda commands." - (org-let (nth 1 series) '(org-agenda-prepare name)) - ;; We need to reset agenda markers here, because when constructing a - ;; block agenda, the individual blocks do not do that. - (org-agenda-reset-markers) - (let* ((org-agenda-multi t) - (redo (list 'org-agenda-run-series name (list 'quote series))) - (cmds (car series)) - (gprops (nth 1 series)) - match ;; The byte compiler incorrectly complains about this. Keep it! - org-cmd type lprops) - (while (setq org-cmd (pop cmds)) - (setq type (car org-cmd)) - (setq match (eval (nth 1 org-cmd))) - (setq lprops (nth 2 org-cmd)) - (let ((org-agenda-overriding-arguments - (if (eq org-agenda-overriding-cmd org-cmd) - (or org-agenda-overriding-arguments - org-agenda-overriding-cmd-arguments)))) - (cond - ((eq type 'agenda) - (org-let2 gprops lprops - '(call-interactively 'org-agenda-list))) - ((eq type 'agenda*) - (org-let2 gprops lprops - '(funcall 'org-agenda-list nil nil t))) - ((eq type 'alltodo) - (org-let2 gprops lprops - '(call-interactively 'org-todo-list))) - ((eq type 'search) - (org-let2 gprops lprops - '(org-search-view current-prefix-arg match nil))) - ((eq type 'stuck) - (org-let2 gprops lprops - '(call-interactively 'org-agenda-list-stuck-projects))) - ((eq type 'tags) - (org-let2 gprops lprops - '(org-tags-view current-prefix-arg match))) - ((eq type 'tags-todo) - (org-let2 gprops lprops - '(org-tags-view '(4) match))) - ((eq type 'todo) - (org-let2 gprops lprops - '(org-todo-list match))) - ((fboundp type) - (org-let2 gprops lprops - '(funcall type match))) - (t (error "Invalid type in command series"))))) - (widen) - (let ((inhibit-read-only t)) - (add-text-properties (point-min) (point-max) - `(org-series t org-series-redo-cmd ,redo))) - (setq org-agenda-redo-command redo) - (goto-char (point-min))) - (org-agenda-fit-window-to-buffer) - (org-let (nth 1 series) '(org-agenda-finalize))) + (let* ((gprops (nth 1 series)) + (gvars (mapcar #'car gprops)) + (gvals (mapcar (lambda (binding) (eval (cadr binding) t)) gprops))) + (cl-progv gvars gvals (org-agenda-prepare name)) + ;; We need to reset agenda markers here, because when constructing a + ;; block agenda, the individual blocks do not do that. + (org-agenda-reset-markers) + (with-no-warnings + (defvar match)) ;Used via the `eval' below. + (let* ((org-agenda-multi t) + ;; FIXME: Redo should contain lists of (FUNS . ARGS) rather + ;; than expressions, so you don't need to `quote' the args + ;; and you just need to `apply' instead of `eval' when using it. + (redo (list 'org-agenda-run-series name (list 'quote series))) + (cmds (car series)) + match + org-cmd type lprops) + (while (setq org-cmd (pop cmds)) + (setq type (car org-cmd)) + (setq match (eval (nth 1 org-cmd) t)) + (setq lprops (nth 2 org-cmd)) + (let ((org-agenda-overriding-arguments + (if (eq org-agenda-overriding-cmd org-cmd) + (or org-agenda-overriding-arguments + org-agenda-overriding-cmd-arguments))) + (lvars (mapcar #'car lprops)) + (lvals (mapcar (lambda (binding) (eval (cadr binding) t)) lprops))) + (cl-progv (append gvars lvars) (append gvals lvals) + (pcase type + (`agenda + (call-interactively 'org-agenda-list)) + (`agenda* + (funcall 'org-agenda-list nil nil t)) + (`alltodo + (call-interactively 'org-todo-list)) + (`search + (org-search-view current-prefix-arg match nil)) + (`stuck + (call-interactively 'org-agenda-list-stuck-projects)) + (`tags + (org-tags-view current-prefix-arg match)) + (`tags-todo + (org-tags-view '(4) match)) + (`todo + (org-todo-list match)) + ((pred fboundp) + (funcall type match)) + (_ (error "Invalid type in command series")))))) + (widen) + (let ((inhibit-read-only t)) + (add-text-properties (point-min) (point-max) + `(org-series t org-series-redo-cmd ,redo))) + (setq org-agenda-redo-command redo) + (goto-char (point-min))) + (org-agenda-fit-window-to-buffer) + (cl-progv gvars gvals (org-agenda-finalize)))) + +(defun org-agenda--split-plist (plist) + ;; We could/should arguably use `map-keys' and `map-values'. + (let (keys vals) + (while plist + (push (pop plist) keys) + (push (pop plist) vals)) + (cons (nreverse keys) (nreverse vals)))) ;;;###autoload (defmacro org-batch-agenda (cmd-key &rest parameters) @@ -3315,7 +3329,13 @@ If CMD-KEY is a string of length 1, it is used as a key in longer string it is used as a tags/todo match string. Parameters are alternating variable names and values that will be bound before running the agenda command." - (org-eval-in-environment (org-make-parameter-alist parameters) + (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) + `(org--batch-agenda ,cmd-key ',vars (list ,@exps)))) + +(defun org--batch-agenda (cmd-key vars vals) + ;; `org-batch-agenda' is a macro because every other "parameter" is + ;; a variable name rather than an expression to evaluate. Yuck! + (cl-progv vars vals (let (org-agenda-sticky) (if (> (length cmd-key) 1) (org-tags-view nil cmd-key) @@ -3360,11 +3380,18 @@ extra String with extra planning info priority-l The priority letter if any was given priority-n The computed numerical priority agenda-day The day in the agenda where this is listed" - (org-eval-in-environment (append '((org-agenda-remove-tags t)) - (org-make-parameter-alist parameters)) - (if (> (length cmd-key) 2) - (org-tags-view nil cmd-key) - (org-agenda nil cmd-key))) + (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) + `(org--batch-agenda-csv ,cmd-key ',vars (list ,@exps)))) + +(defun org--batch-agenda-csv (cmd-key vars vals) + ;; `org-batch-agenda-csv' is a macro because every other "parameter" is + ;; a variable name rather than an expression to evaluate. Yuck! + (let ((org-agenda-remove-tags t)) + (cl-progv vars vals + ;; FIXME: Shouldn't this be 1 (see commit 10173ad6d610b)? + (if (> (length cmd-key) 2) + (org-tags-view nil cmd-key) + (org-agenda nil cmd-key)))) (set-buffer org-agenda-buffer-name) (let ((lines (org-split-string (buffer-string) "\n"))) (dolist (line lines) @@ -3372,9 +3399,9 @@ agenda-day The day in the agenda where this is listed" (setq org-agenda-info (org-fix-agenda-info (text-properties-at 0 line))) (princ - (mapconcat 'org-agenda-export-csv-mapper + (mapconcat #'org-agenda-export-csv-mapper '(org-category txt type todo tags date time extra - priority-letter priority agenda-day) + priority-letter priority agenda-day) ",")) (princ "\n"))))) @@ -3383,7 +3410,7 @@ agenda-day The day in the agenda where this is listed" This ensures the export commands can easily use it." (let (tmp re) (when (setq tmp (plist-get props 'tags)) - (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) + (setq props (plist-put props 'tags (mapconcat #'identity tmp ":")))) (when (setq tmp (plist-get props 'date)) (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) (let ((calendar-date-display-form '(year "-" month "-" day))) @@ -3419,19 +3446,22 @@ This ensures the export commands can easily use it." (org-trim (replace-regexp-in-string "," ";" res nil t)))) ;;;###autoload -(defun org-store-agenda-views (&rest parameters) +(defun org-store-agenda-views (&rest _parameters) "Store agenda views." (interactive) - (eval (list 'org-batch-store-agenda-views))) + (org--batch-store-agenda-views nil nil)) ;;;###autoload (defmacro org-batch-store-agenda-views (&rest parameters) "Run all custom agenda commands that have a file argument." + (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) + `(org--batch-store-agenda-views ',vars (list ,@exps)))) + +(defun org--batch-store-agenda-views (vars vals) (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) - (pop-up-frames nil) - (dir default-directory) - (pars (org-make-parameter-alist parameters)) - cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname) + (pop-up-frames nil) + (dir default-directory) + cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname) (save-window-excursion (while cmds (setq cmd (pop cmds) @@ -3448,14 +3478,18 @@ This ensures the export commands can easily use it." files (nth (if (listp cmd-or-set) 4 5) cmd)) (if (stringp files) (setq files (list files))) (when files - (org-eval-in-environment (append org-agenda-exporter-settings - opts pars) - (org-agenda nil thiscmdkey)) - (set-buffer bufname) - (while files - (org-eval-in-environment (append org-agenda-exporter-settings - opts pars) - (org-agenda-write (expand-file-name (pop files) dir) nil t bufname))) + (let* ((opts (append org-agenda-exporter-settings opts)) + (vars (append (mapcar #'car opts) vars)) + (vals (append (mapcar (lambda (binding) (eval (cadr binding) t)) + opts) + vals))) + (cl-progv vars vals + (org-agenda nil thiscmdkey)) + (set-buffer bufname) + (while files + (cl-progv vars vals + (org-agenda-write (expand-file-name (pop files) dir) + nil t bufname)))) (and (get-buffer bufname) (kill-buffer bufname))))))) @@ -3495,80 +3529,87 @@ the agenda to write." (if (called-interactively-p 'any) (not (y-or-n-p (format "Overwrite existing file %s? " file)))))) (user-error "Cannot write agenda to file %s" file)) - (org-let (if nosettings nil org-agenda-exporter-settings) - '(save-excursion - (save-window-excursion - (let ((bs (copy-sequence (buffer-string))) - (extension (file-name-extension file)) - (default-directory (file-name-directory file)) - beg content) - (with-temp-buffer - (rename-buffer org-agenda-write-buffer-name t) - (set-buffer-modified-p nil) - (insert bs) - (org-agenda-remove-marked-text 'invisible 'org-filtered) - (run-hooks 'org-agenda-before-write-hook) - (cond - ((bound-and-true-p org-mobile-creating-agendas) - (org-mobile-write-agenda-for-mobile file)) - ((string= "org" extension) - (let (content p m message-log-max) - (goto-char (point-min)) - (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) - (goto-char p) - (setq m (get-text-property (point) 'org-hd-marker)) - (when m - (push (save-excursion - (set-buffer (marker-buffer m)) - (goto-char m) - (org-copy-subtree 1 nil t t) - org-subtree-clip) - content))) - (find-file file) - (erase-buffer) - (dolist (s content) (org-paste-subtree 1 s)) - (write-file file) - (kill-buffer (current-buffer)) - (message "Org file written to %s" file))) - ((member extension '("html" "htm")) - (or (require 'htmlize nil t) - (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) - (set-buffer (htmlize-buffer (current-buffer))) - (when org-agenda-export-html-style - ;; replace <style> section with org-agenda-export-html-style - (goto-char (point-min)) - (kill-region (- (search-forward "<style") 6) - (search-forward "</style>")) - (insert org-agenda-export-html-style)) - (write-file file) - (kill-buffer (current-buffer)) - (message "HTML written to %s" file)) - ((string= "ps" extension) - (require 'ps-print) - (ps-print-buffer-with-faces file) - (message "Postscript written to %s" file)) - ((string= "pdf" extension) - (require 'ps-print) - (ps-print-buffer-with-faces - (concat (file-name-sans-extension file) ".ps")) - (call-process "ps2pdf" nil nil nil - (expand-file-name - (concat (file-name-sans-extension file) ".ps")) - (expand-file-name file)) - (delete-file (concat (file-name-sans-extension file) ".ps")) - (message "PDF written to %s" file)) - ((string= "ics" extension) - (require 'ox-icalendar) - (org-icalendar-export-current-agenda (expand-file-name file))) - (t - (let ((bs (buffer-string))) - (find-file file) - (erase-buffer) - (insert bs) - (save-buffer 0) - (kill-buffer (current-buffer)) - (message "Plain text written to %s" file)))))))) + (cl-progv + (if nosettings nil (mapcar #'car org-agenda-exporter-settings)) + (if nosettings nil (mapcar (lambda (binding) (eval (cadr binding) t)) + org-agenda-exporter-settings)) + (save-excursion + (save-window-excursion + (let ((bs (copy-sequence (buffer-string))) + (extension (file-name-extension file)) + (default-directory (file-name-directory file)) + ) ;; beg content + (with-temp-buffer + (rename-buffer org-agenda-write-buffer-name t) + (set-buffer-modified-p nil) + (insert bs) + (org-agenda-remove-marked-text 'invisible 'org-filtered) + (run-hooks 'org-agenda-before-write-hook) + (cond + ((bound-and-true-p org-mobile-creating-agendas) + (org-mobile-write-agenda-for-mobile file)) + ((string= "org" extension) + (let (content p m message-log-max) + (goto-char (point-min)) + (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) + (goto-char p) + (setq m (get-text-property (point) 'org-hd-marker)) + (when m + (push (with-current-buffer (marker-buffer m) + (goto-char m) + (org-copy-subtree 1 nil t t) + org-subtree-clip) + content))) + (find-file file) + (erase-buffer) + (dolist (s content) (org-paste-subtree 1 s)) + (write-file file) + (kill-buffer (current-buffer)) + (message "Org file written to %s" file))) + ((member extension '("html" "htm")) + (or (require 'htmlize nil t) + (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) + (declare-function htmlize-buffer "htmlize" (&optional buffer)) + (set-buffer (htmlize-buffer (current-buffer))) + (when org-agenda-export-html-style + ;; replace <style> section with org-agenda-export-html-style + (goto-char (point-min)) + (kill-region (- (search-forward "<style") 6) + (search-forward "</style>")) + (insert org-agenda-export-html-style)) + (write-file file) + (kill-buffer (current-buffer)) + (message "HTML written to %s" file)) + ((string= "ps" extension) + (require 'ps-print) + (ps-print-buffer-with-faces file) + (message "Postscript written to %s" file)) + ((string= "pdf" extension) + (require 'ps-print) + (ps-print-buffer-with-faces + (concat (file-name-sans-extension file) ".ps")) + (call-process "ps2pdf" nil nil nil + (expand-file-name + (concat (file-name-sans-extension file) ".ps")) + (expand-file-name file)) + (delete-file (concat (file-name-sans-extension file) ".ps")) + (message "PDF written to %s" file)) + ((string= "ics" extension) + (require 'ox-icalendar) + (declare-function org-icalendar-export-current-agenda + "ox-icalendar" (file)) + (org-icalendar-export-current-agenda (expand-file-name file))) + (t + (let ((bs (buffer-string))) + (find-file file) + (erase-buffer) + (insert bs) + (save-buffer 0) + (kill-buffer (current-buffer)) + (message "Plain text written to %s" file)))))))) (set-buffer (or agenda-bufname + ;; FIXME: I'm pretty sure called-interactively-p + ;; doesn't do what we want here! (and (called-interactively-p 'any) (buffer-name)) org-agenda-buffer-name))) (when open (org-open-file file))) @@ -3727,12 +3768,11 @@ the global options and expect it to be applied to the entire view.") "Alist of filter types and associated variables") (defun org-agenda-filter-any () "Is any filter active?" - (let ((form (cons 'or (mapcar (lambda (x) - (if (or (symbol-value (cdr x)) - (get :preset-filter x)) - t nil)) - org-agenda-filter-variables)))) - (eval form))) + (cl-some (lambda (x) + (or (symbol-value (cdr x)) + (get :preset-filter x))) + org-agenda-filter-variables)) + (defvar org-agenda-category-filter-preset nil "A preset of the category filter used for secondary agenda filtering. This must be a list of strings, each string must be a single category @@ -3970,7 +4010,7 @@ agenda display, configure `org-agenda-finalize-hook'." (when (get 'org-agenda-effort-filter :preset-filter) (org-agenda-filter-apply (get 'org-agenda-effort-filter :preset-filter) 'effort)) - (add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)) + (add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local)) (run-hooks 'org-agenda-finalize-hook)))) (defun org-agenda-mark-clocking-task () @@ -4039,10 +4079,10 @@ agenda display, configure `org-agenda-finalize-hook'." (defvar org-depend-tag-blocked) -(defun org-agenda-dim-blocked-tasks (&optional invisible) +(defun org-agenda-dim-blocked-tasks (&optional _invisible) "Dim currently blocked TODOs in the agenda display. When INVISIBLE is non-nil, hide currently blocked TODO instead of -dimming them." +dimming them." ;FIXME: The arg isn't used, actually! (interactive "P") (when (called-interactively-p 'interactive) (message "Dim or hide blocked tasks...")) @@ -4150,7 +4190,7 @@ functions do." (save-match-data (if fp (funcall form) - (eval form))))))) + (eval form t))))))) (defvar org-agenda-markers nil "List of all currently active markers created by `org-agenda'.") @@ -4304,11 +4344,11 @@ items if they have an hour specification like [h]h:mm." (day-cnt 0) (inhibit-redisplay (not debug-on-error)) (org-agenda-show-log-scoped org-agenda-show-log) - s e rtn rtnall file date d start-pos end-pos todayp - clocktable-start clocktable-end filter) + s rtn rtnall file date d start-pos end-pos todayp ;; e + clocktable-start clocktable-end) ;; filter (setq org-agenda-redo-command (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour)) - (dotimes (n (1- ndays)) + (dotimes (_ (1- ndays)) (push (1+ (car day-numbers)) day-numbers)) (setq day-numbers (nreverse day-numbers)) (setq clocktable-start (car day-numbers) @@ -4374,11 +4414,11 @@ items if they have an hour specification like [h]h:mm." (setq rtn (org-agenda-get-day-entries file date :closed))) (org-agenda-show-log-scoped - (setq rtn (apply 'org-agenda-get-day-entries + (setq rtn (apply #'org-agenda-get-day-entries file date (append '(:closed) org-agenda-entry-types)))) (t - (setq rtn (apply 'org-agenda-get-day-entries + (setq rtn (apply #'org-agenda-get-day-entries file date org-agenda-entry-types))))) (setq rtnall (append rtnall rtn)))) ;; all entries @@ -4418,7 +4458,7 @@ items if they have an hour specification like [h]h:mm." (setq p (plist-put p :tstart clocktable-start)) (setq p (plist-put p :tend clocktable-end)) (setq p (plist-put p :scope 'agenda)) - (setq tbl (apply 'org-clock-get-clocktable p)) + (setq tbl (apply #'org-clock-get-clocktable p)) (insert tbl))) (goto-char (point-min)) (or org-agenda-multi (org-agenda-fit-window-to-buffer)) @@ -4639,7 +4679,7 @@ is active." (setq re (regexp-quote (downcase w))))) (if neg (push re regexps-) (push re regexps+))) words) - (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+") + (push (mapconcat #'regexp-quote words "\\s-+") regexps+)) (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) (if (not regexps+) @@ -4804,6 +4844,8 @@ Press `\\[org-agenda-manipulate-query-add]', \ (defvar org-select-this-todo-keyword nil) (defvar org-last-arg nil) +(defvar crm-separator) + ;;;###autoload (defun org-todo-list (&optional arg) "Show all (not done) TODO entries from all agenda file in a single list. @@ -5059,7 +5101,7 @@ If any of these conditions is met, this function returns the end point of the entity, causing the search to continue from there. This is a function that can be put into `org-agenda-skip-function' for the duration of a command." (org-back-to-heading t) - (let* ((beg (point)) + (let* (;; (beg (point)) (end (if subtree (save-excursion (org-end-of-subtree t) (point)) (org-entry-end-position))) (planning-end (if subtree end (line-end-position 2))) @@ -5133,7 +5175,7 @@ a list of TODO keywords, or a state symbol `todo' or `done' or (`(,type . ,_) (error "Unknown TODO skip type: %S" type))))) ;;;###autoload -(defun org-agenda-list-stuck-projects (&rest ignore) +(defun org-agenda-list-stuck-projects (&rest _ignore) "Create agenda view for projects that are stuck. Stuck projects are project that have no next actions. For the definitions of what a project is and how to check if it stuck, customize the variable @@ -5171,12 +5213,12 @@ of what a project is and how to check if it stuck, customize the variable (org-agenda-skip-function ;; Skip entry if `org-agenda-skip-regexp' matches anywhere ;; in the subtree. - `(lambda () - (and (save-excursion - (let ((case-fold-search nil)) - (re-search-forward - ,skip-re (save-excursion (org-end-of-subtree t)) t))) - (progn (outline-next-heading) (point)))))) + (lambda () + (and (save-excursion + (let ((case-fold-search nil)) + (re-search-forward + skip-re (save-excursion (org-end-of-subtree t)) t))) + (progn (outline-next-heading) (point)))))) (org-tags-view nil matcher) (setq org-agenda-buffer-name (buffer-name)) (with-current-buffer org-agenda-buffer-name @@ -5192,16 +5234,22 @@ of what a project is and how to check if it stuck, customize the variable (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. (defvar diary-list-entries-hook) (defvar diary-time-regexp) +(defvar diary-modify-entry-list-string-function) +(defvar diary-file-name-prefix) +(defvar diary-display-function) + (defun org-get-entries-from-diary (date) "Get the (Emacs Calendar) diary entries for DATE." (require 'diary-lib) + (declare-function diary-fancy-display "diary-lib" ()) (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") - (diary-display-function 'diary-fancy-display) + (diary-display-function #'diary-fancy-display) (pop-up-frames nil) (diary-list-entries-hook (cons 'org-diary-default-entry diary-list-entries-hook)) (diary-file-name-prefix nil) ; turn this feature off - (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) + (diary-modify-entry-list-string-function + #'org-modify-diary-entry-string) (diary-time-regexp (concat "^" diary-time-regexp)) entries (org-disable-agenda-to-diary t)) @@ -5315,6 +5363,7 @@ So the example above may also be written as The function expects the lisp variables `entry' and `date' to be provided by the caller, because this is how the calendar works. Don't use this function from a program - use `org-agenda-get-day-entries' instead." + (with-no-warnings (defvar date) (defvar entry)) (when (> (- (float-time) org-agenda-last-marker-time) 5) @@ -5339,7 +5388,7 @@ function from a program - use `org-agenda-get-day-entries' instead." ;; the calendar. Org Agenda will list these entries itself. (when org-disable-agenda-to-diary (setq files nil)) (while (setq file (pop files)) - (setq rtn (apply 'org-agenda-get-day-entries file date args)) + (setq rtn (apply #'org-agenda-get-day-entries file date args)) (setq results (append results rtn))) (when results (setq results @@ -5400,27 +5449,29 @@ the documentation of `org-diary'." (setf args (cons :deadline* (delq :deadline* args))))) ;; Collect list of headlines. Return them flattened. (let ((case-fold-search nil) results deadlines) - (dolist (arg args (apply #'nconc (nreverse results))) - (pcase arg - ((and :todo (guard (org-agenda-today-p date))) - (push (org-agenda-get-todos) results)) - (:timestamp - (push (org-agenda-get-blocks) results) - (push (org-agenda-get-timestamps deadlines) results)) - (:sexp - (push (org-agenda-get-sexps) results)) - (:scheduled - (push (org-agenda-get-scheduled deadlines) results)) - (:scheduled* - (push (org-agenda-get-scheduled deadlines t) results)) - (:closed - (push (org-agenda-get-progress) results)) - (:deadline - (setf deadlines (org-agenda-get-deadlines)) - (push deadlines results)) - (:deadline* - (setf deadlines (org-agenda-get-deadlines t)) - (push deadlines results))))))))))) + (org-dlet + ((date date)) + (dolist (arg args (apply #'nconc (nreverse results))) + (pcase arg + ((and :todo (guard (org-agenda-today-p date))) + (push (org-agenda-get-todos) results)) + (:timestamp + (push (org-agenda-get-blocks) results) + (push (org-agenda-get-timestamps deadlines) results)) + (:sexp + (push (org-agenda-get-sexps) results)) + (:scheduled + (push (org-agenda-get-scheduled deadlines) results)) + (:scheduled* + (push (org-agenda-get-scheduled deadlines t) results)) + (:closed + (push (org-agenda-get-progress) results)) + (:deadline + (setf deadlines (org-agenda-get-deadlines)) + (push deadlines results)) + (:deadline* + (setf deadlines (org-agenda-get-deadlines t)) + (push deadlines results)))))))))))) (defsubst org-em (x y list) "Is X or Y a member of LIST?" @@ -5482,11 +5533,12 @@ and the timestamp type relevant for the sorting strategy in org-todo-regexp) (org-select-this-todo-keyword (concat "\\(" - (mapconcat 'identity + (mapconcat #'identity (org-split-string org-select-this-todo-keyword "|") - "\\|") "\\)")) + "\\|") + "\\)")) (t org-not-done-regexp)))) marker priority category level tags todo-state ts-date ts-date-type ts-date-pair @@ -5626,6 +5678,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', "Return the date stamp information for agenda display. Optional argument DEADLINES is a list of deadline items to be displayed in agenda view." + (with-no-warnings (defvar date)) (let* ((props (list 'face 'org-agenda-calendar-event 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp @@ -5768,12 +5821,15 @@ displayed in agenda view." (defun org-agenda-get-sexps () "Return the sexp information for agenda display." (require 'diary-lib) + (with-no-warnings (defvar date) (defvar entry)) (let* ((props (list 'face 'org-agenda-calendar-sexp 'mouse-face 'highlight 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (regexp "^&?%%(") + ;; FIXME: Is this `entry' binding intended to be dynamic, + ;; so as to "hide" any current binding for it? marker category extra level ee txt tags entry result beg b sexp sexp-entry todo-state warntime inherited-tags) (goto-char (point-min)) @@ -5854,6 +5910,7 @@ item should be skipped. If any of the SKIP-WEEKS arguments is the symbol `holidays', then any date that is known by the Emacs calendar to be a holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings, then those holidays will be skipped." + (with-no-warnings (defvar date) (defvar entry)) (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1))) (date2 (calendar-absolute-from-gregorian (list m2 d2 y2))) (d (calendar-absolute-from-gregorian date)) @@ -5870,9 +5927,10 @@ then those holidays will be skipped." (delq nil (mapcar (lambda(g) (member g skip-weeks)) h)))) entry))) -(defalias 'org-get-closed 'org-agenda-get-progress) +(defalias 'org-get-closed #'org-agenda-get-progress) (defun org-agenda-get-progress () "Return the logged TODO entries for agenda display." + (with-no-warnings (defvar date)) (let* ((props (list 'mouse-face 'highlight 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp @@ -5892,7 +5950,7 @@ then those holidays will be skipped." (when (memq 'clock items) (concat "\\<" org-clock-string)) (when (memq 'state items) (format "- +State \"%s\".*?" org-todo-regexp))))) - (parts-re (if parts (mapconcat 'identity parts "\\|") + (parts-re (if parts (mapconcat #'identity parts "\\|") (error "`org-agenda-log-mode-items' is empty"))) (regexp (concat "\\(" parts-re "\\)" @@ -6104,6 +6162,7 @@ See also the user option `org-agenda-clock-consistency-checks'." "Return the deadline information for agenda display. When WITH-HOUR is non-nil, only return deadlines with an hour specification like [h]h:mm." + (with-no-warnings (defvar date)) (let* ((props (list 'mouse-face 'highlight 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp @@ -6262,6 +6321,7 @@ FRACTION is what fraction of the head-warning time has passed." Optional argument DEADLINES is a list of deadline items to be displayed in agenda view. When WITH-HOUR is non-nil, only return scheduled items with an hour specification like [h]h:mm." + (with-no-warnings (defvar date)) (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp @@ -6462,6 +6522,7 @@ scheduled items with an hour specification like [h]h:mm." (defun org-agenda-get-blocks () "Return the date-range information for agenda display." + (with-no-warnings (defvar date)) (let* ((props (list 'face nil 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp @@ -6630,6 +6691,13 @@ Any match of REMOVE-RE will be removed from TXT." org-agenda-show-inherited-tags org-agenda-hide-tags-regexp)) + (with-no-warnings + ;; `time', `tag', `effort' are needed for the eval of the prefix format. + ;; Based on what I see in `org-compile-prefix-format', I added + ;; a few more. + (defvar breadcrumbs) (defvar category) (defvar category-icon) + (defvar effort) (defvar extra) + (defvar level) (defvar tag) (defvar time)) (let* ((category (or category (if buffer-file-name (file-name-sans-extension @@ -6641,9 +6709,9 @@ Any match of REMOVE-RE will be removed from TXT." "")) (effort (and (not (string= txt "")) (get-text-property 1 'effort txt))) - ;; time, tag, effort are needed for the eval of the prefix format (tag (if tags (nth (1- (length tags)) tags) "")) (time-grid-trailing-characters (nth 2 org-agenda-time-grid)) + (extra (or (and (not habitp) extra) "")) time (ts (when dotime (concat (if (stringp dotime) dotime "") @@ -6727,7 +6795,6 @@ Any match of REMOVE-RE will be removed from TXT." (concat time-grid-trailing-characters " ") time-grid-trailing-characters))) (t "")) - extra (or (and (not habitp) extra) "") category (if (symbolp category) (symbol-name category) category) level (or level "")) (if (string-match org-link-bracket-re category) @@ -6742,13 +6809,13 @@ Any match of REMOVE-RE will be removed from TXT." (>= (length category) org-prefix-category-max-length)) (setq category (substring category 0 (1- org-prefix-category-max-length))))) ;; Evaluate the compiled format - (setq rtn (concat (eval formatter) txt)) + (setq rtn (concat (eval formatter t) txt)) ;; And finally add the text properties (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) (org-add-props rtn nil 'org-category category - 'tags (mapcar 'org-downcase-keep-props tags) + 'tags (mapcar #'org-downcase-keep-props tags) 'org-priority-highest org-priority-highest 'org-priority-lowest org-priority-lowest 'time-of-day time-of-day @@ -6861,7 +6928,7 @@ and stored in the variable `org-prefix-format-compiled'." (cdr (assq key org-agenda-prefix-format))) (t " %-12:c%?-12t% s"))) (start 0) - varform vars var e c f opt) + varform vars var c f opt) ;; e (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)" s start) (setq var (or (cdr (assoc (match-string 4 s) @@ -6889,12 +6956,11 @@ and stored in the variable `org-prefix-format-compiled'." (setq varform `(format ,f (org-eval ,(read (match-string 4 s))))) (if opt (setq varform - `(if (or (equal "" ,var) (equal nil ,var)) + `(if (member ,var '("" nil)) "" (format ,f (concat ,var ,c)))) (setq varform - `(format ,f (if (or (equal ,var "") - (equal ,var nil)) "" + `(format ,f (if (member ,var '("" nil)) "" (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) (setq s (replace-match "%s" t nil s)) (push varform vars)) @@ -6910,10 +6976,10 @@ and stored in the variable `org-prefix-format-compiled'." `(format ,s ,@vars)))))) (defun org-set-sorting-strategy (key) - (if (symbolp (car org-agenda-sorting-strategy)) - ;; the old format - (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy) - (setq org-agenda-sorting-strategy-selected + (setq org-agenda-sorting-strategy-selected + (if (symbolp (car org-agenda-sorting-strategy)) + ;; the old format + org-agenda-sorting-strategy (or (cdr (assq key org-agenda-sorting-strategy)) (cdr (assq 'agenda org-agenda-sorting-strategy)) '(time-up category-keep priority-down))))) @@ -6988,8 +7054,8 @@ The optional argument TYPE tells the agenda type." (delq nil (mapcar org-agenda-before-sorting-filter-function list)))) - (setq list (mapcar 'org-agenda-highlight-todo list) - list (mapcar 'identity (sort list 'org-entries-lessp))) + (setq list (mapcar #'org-agenda-highlight-todo list) + list (mapcar #'identity (sort list #'org-entries-lessp))) (when max-effort (setq list (org-agenda-limit-entries list 'effort-minutes max-effort @@ -7003,7 +7069,7 @@ The optional argument TYPE tells the agenda type." (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries))) (when (and org-agenda-dim-blocked-tasks org-blocker-hook) (setq list (mapcar #'org-agenda--mark-blocked-entry list))) - (mapconcat 'identity list "\n"))) + (mapconcat #'identity list "\n"))) (defun org-agenda-limit-entries (list prop limit &optional fn) "Limit the number of agenda entries." @@ -7218,8 +7284,9 @@ their type." "Predicate for sorting agenda entries." ;; The following variables will be used when the form is evaluated. ;; So even though the compiler complains, keep them. - (let* ((ss org-agenda-sorting-strategy-selected) - (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) + (let ((ss org-agenda-sorting-strategy-selected)) + (org-dlet + ((timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) (org-cmp-ts a b ""))) (timestamp-down (if timestamp-up (- timestamp-up) nil)) (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss) @@ -7265,14 +7332,14 @@ their type." (alpha-down (if alpha-up (- alpha-up) nil)) (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) user-defined-up user-defined-down) - (when (and need-user-cmp org-agenda-cmp-user-defined - (functionp org-agenda-cmp-user-defined)) - (setq user-defined-up - (funcall org-agenda-cmp-user-defined a b) - user-defined-down (if user-defined-up (- user-defined-up) nil))) - (cdr (assoc - (eval (cons 'or org-agenda-sorting-strategy-selected)) - '((-1 . t) (1 . nil) (nil . nil)))))) + (when (and need-user-cmp org-agenda-cmp-user-defined + (functionp org-agenda-cmp-user-defined)) + (setq user-defined-up + (funcall org-agenda-cmp-user-defined a b) + user-defined-down (if user-defined-up (- user-defined-up) nil))) + (cdr (assoc + (eval (cons 'or org-agenda-sorting-strategy-selected) t) + '((-1 . t) (1 . nil) (nil . nil))))))) ;;; Agenda restriction lock @@ -7474,7 +7541,7 @@ This is used when toggling sticky agendas." (dolist (buf (buffer-list)) (when (with-current-buffer buf (eq major-mode 'org-agenda-mode)) (push buf blist))) - (mapc 'kill-buffer blist))) + (mapc #'kill-buffer blist))) (defun org-agenda-execute (arg) "Execute another agenda command, keeping same window. @@ -7487,6 +7554,7 @@ in the agenda." (defun org-agenda-redo (&optional all) "Rebuild possibly ALL agenda view(s) in the current buffer." (interactive "P") + (defvar org-agenda-tag-filter-while-redo) ;FIXME: Where is this var used? (let* ((p (or (and (looking-at "\\'") (1- (point))) (point))) (cpa (unless (eq all t) current-prefix-arg)) (org-agenda-doing-sticky-redo org-agenda-sticky) @@ -7525,8 +7593,11 @@ in the agenda." (and cols (org-columns-quit)) (message "Rebuilding agenda buffer...") (if series-redo-cmd - (eval series-redo-cmd) - (org-let lprops redo-cmd)) + (eval series-redo-cmd t) + (cl-progv + (mapcar #'car lprops) + (mapcar (lambda (binding) (eval (cadr binding) t)) lprops) + (eval redo-cmd t))) (setq org-agenda-undo-list nil org-agenda-pending-undo-list nil org-agenda-tag-filter tag-filter @@ -7752,7 +7823,7 @@ the variable `org-agenda-auto-exclude-function'." (negate (equal strip-or-accumulate '(4))) (cf (mapconcat #'identity org-agenda-category-filter "")) (tf (mapconcat #'identity org-agenda-tag-filter "")) - (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) "")))) + ;; (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) "")))) (ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) ""))) (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) ""))) (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/")))) @@ -7760,7 +7831,7 @@ the variable `org-agenda-auto-exclude-function'." (concat (if negate "Negative filter" "Filter") " [+cat-tag<0:10-/regexp/]: ") - 'org-agenda-filter-completion-function + #'org-agenda-filter-completion-function nil nil ff)) (keep (or (if (string-match "^\\+[+-]" f-string) (progn (setq f-string (substring f-string 1)) t)) @@ -7786,20 +7857,20 @@ the variable `org-agenda-auto-exclude-function'." "~~~" "-" (match-string 3 f-string))) (cond ((member (downcase s) tag-list) - (add-to-list 'ft (concat pm (downcase s)) 'append 'equal)) + (org-pushnew-to-end (concat pm (downcase s)) ft)) ((member s category-list) - (add-to-list 'fc (concat pm ; Remove temporary double quotes. - (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s)) - 'append 'equal)) + (org-pushnew-to-end (concat pm ; Remove temporary double quotes. + (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s)) + fc)) (t (message "`%s%s' filter ignored because tag/category is not represented" pm s)))) ((match-beginning 4) ;; effort - (add-to-list 'fe (concat pm (match-string 4 f-string)) t 'equal)) + (org-pushnew-to-end (concat pm (match-string 4 f-string)) fe)) ((match-beginning 5) ;; regexp - (add-to-list 'fr (concat pm (match-string 6 f-string)) t 'equal))) + (org-pushnew-to-end (concat pm (match-string 6 f-string)) fr))) (setq f-string (substring f-string (match-end 0)))) (org-agenda-filter-remove-all) (and fc (org-agenda-filter-apply @@ -7901,7 +7972,7 @@ also press `-' or `+' to switch between filtering and excluding." (expand (not (equal strip-or-accumulate '(64)))) (inhibit-read-only t) (current org-agenda-tag-filter) - a n tag) + a tag) ;; n (unless char (while (not (memq char valid-char-list)) (org-unlogged-message @@ -7982,7 +8053,7 @@ These will be lower-case, for filtering." (if tt (push tt tags-lists))) (setq tags-lists (nreverse (org-uniquify - (delq nil (apply 'append tags-lists))))) + (delq nil (apply #'append tags-lists))))) (dolist (tag tags-lists) (mapc (lambda (group) @@ -8126,10 +8197,11 @@ grouptags." (while (not (eobp)) (when (or (org-get-at-bol 'org-hd-marker) (org-get-at-bol 'org-marker)) - (let ((tags (org-get-at-bol 'tags)) - (cat (org-agenda-get-category)) - (txt (or (org-get-at-bol 'txt) ""))) - (unless (eval org-agenda-filter-form) + (org-dlet + ((tags (org-get-at-bol 'tags)) + (cat (org-agenda-get-category)) + (txt (or (org-get-at-bol 'txt) ""))) + (unless (eval org-agenda-filter-form t) (org-agenda-filter-hide-line type)))) (beginning-of-line 2))) (when (get-char-property (point) 'invisible) @@ -8312,12 +8384,12 @@ When optional argument BACKWARD is set, go backward." "Cannot execute this command outside of org-agenda-mode buffers")) ((looking-at (if backward "\\`" "\\'")) (message "Already at the %s block" (if backward "first" "last"))) - (t (let ((pos (prog1 (point) - (ignore-errors (if backward (backward-char 1) - (move-end-of-line 1))))) + (t (let ((_pos (prog1 (point) + (ignore-errors (if backward (backward-char 1) + (move-end-of-line 1))))) (f (if backward - 'previous-single-property-change - 'next-single-property-change)) + #'previous-single-property-change + #'next-single-property-change)) moved dest) (while (and (setq dest (funcall f (point) 'org-agenda-structural-header)) @@ -8488,7 +8560,7 @@ SPAN may be `day', `week', `fortnight', `month', `year'. The return value is a cons cell with the starting date and the number of days, so that the date SD will be in that range." (let* ((greg (calendar-gregorian-from-absolute sd)) - (dg (nth 1 greg)) + ;; (dg (nth 1 greg)) (mg (car greg)) (yg (nth 2 greg))) (cond @@ -8560,7 +8632,7 @@ so that the date SD will be in that range." (defun org-unhighlight-once () "Remove the highlight from its position, and this function from the hook." - (remove-hook 'pre-command-hook 'org-unhighlight-once) + (remove-hook 'pre-command-hook #'org-unhighlight-once) (org-unhighlight)) (defvar org-agenda-pre-follow-window-conf nil) @@ -8697,7 +8769,8 @@ When called with a prefix argument, include all archive files as well." (if org-agenda-include-deadlines " Ddl" "") (if org-agenda-use-time-grid " Grid" "") (if (and (boundp 'org-habit-show-habits) - org-habit-show-habits) " Habit" "") + org-habit-show-habits) + " Habit" "") (cond ((consp org-agenda-show-log) " LogAll") ((eq org-agenda-show-log 'clockcheck) " ClkCk") @@ -8709,36 +8782,39 @@ When called with a prefix argument, include all archive files as well." '(:eval (propertize (concat "[" (mapconcat - 'identity + #'identity (append (get 'org-agenda-category-filter :preset-filter) org-agenda-category-filter) "") "]") 'face 'org-agenda-filter-category - 'help-echo "Category used in filtering")) "") + 'help-echo "Category used in filtering")) + "") (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter)) '(:eval (propertize (concat (mapconcat - 'identity + #'identity (append (get 'org-agenda-tag-filter :preset-filter) org-agenda-tag-filter) "")) 'face 'org-agenda-filter-tags - 'help-echo "Tags used in filtering")) "") + 'help-echo "Tags used in filtering")) + "") (if (or org-agenda-effort-filter (get 'org-agenda-effort-filter :preset-filter)) '(:eval (propertize (concat (mapconcat - 'identity + #'identity (append (get 'org-agenda-effort-filter :preset-filter) org-agenda-effort-filter) "")) 'face 'org-agenda-filter-effort - 'help-echo "Effort conditions used in filtering")) "") + 'help-echo "Effort conditions used in filtering")) + "") (if (or org-agenda-regexp-filter (get 'org-agenda-regexp-filter :preset-filter)) '(:eval (propertize @@ -8749,7 +8825,8 @@ When called with a prefix argument, include all archive files as well." org-agenda-regexp-filter) "")) 'face 'org-agenda-filter-regexp - 'help-echo "Regexp used in filtering")) "") + 'help-echo "Regexp used in filtering")) + "") (if org-agenda-archives-mode (if (eq org-agenda-archives-mode t) " Archives" @@ -8780,7 +8857,7 @@ When called with a prefix argument, include all archive files as well." "Move cursor to next agenda item." (interactive "p") (let ((col (current-column))) - (dotimes (c n) + (dotimes (_ n) (when (next-single-property-change (point-at-eol) 'org-marker) (move-end-of-line 1) (goto-char (next-single-property-change (point) 'org-marker)))) @@ -8790,7 +8867,7 @@ When called with a prefix argument, include all archive files as well." (defun org-agenda-previous-item (n) "Move cursor to next agenda item." (interactive "p") - (dotimes (c n) + (dotimes (_ n) (let ((col (current-column)) (goto (save-excursion (move-end-of-line 0) @@ -8816,7 +8893,7 @@ When called with a prefix argument, include all archive files as well." (let* ((tags (org-get-at-bol 'tags))) (if tags (message "Tags are :%s:" - (org-no-properties (mapconcat 'identity tags ":"))) + (org-no-properties (mapconcat #'identity tags ":"))) (message "No tags associated with this line")))) (defun org-agenda-goto (&optional highlight) @@ -8957,6 +9034,8 @@ Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'." (funcall-interactively #'org-agenda-archive-with 'org-archive-to-archive-sibling)) +(defvar org-archive-from-agenda) + (defun org-agenda-archive-with (cmd &optional confirm) "Move the entry to the archive sibling." (interactive) @@ -9033,7 +9112,7 @@ When NO-UPDATE is non-nil, don't redo the agenda buffer." (marker (or (org-get-at-bol 'org-hd-marker) (org-agenda-error))) (buffer (marker-buffer marker)) - (pos (marker-position marker)) + ;; (pos (marker-position marker)) (rfloc (or rfloc (org-refile-get-location (if goto "Goto" "Refile to") buffer @@ -9319,6 +9398,8 @@ by a remote command from the agenda.") (interactive) (org-agenda-todo 'previousset)) +(defvar org-agenda-headline-snapshot-before-repeat) + (defun org-agenda-todo (&optional arg) "Cycle TODO state of line at point, also in Org file. This changes the line at point, all other lines in the agenda referring to @@ -9346,8 +9427,7 @@ the same tree node, and the headline of the tree node in the Org file." (call-interactively 'org-todo)) (and (bolp) (forward-char 1)) (setq newhead (org-get-heading)) - (when (and (bound-and-true-p - org-agenda-headline-snapshot-before-repeat) + (when (and org-agenda-headline-snapshot-before-repeat (not (equal org-agenda-headline-snapshot-before-repeat newhead)) todayp) @@ -9366,15 +9446,15 @@ the same tree node, and the headline of the tree node in the Org file." (org-move-to-column col) (org-agenda-mark-clocking-task))))) -(defun org-agenda-add-note (&optional arg) +(defun org-agenda-add-note (&optional _arg) "Add a time-stamped note to the entry at point." - (interactive "P") + (interactive) ;; "P" (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker)) - (hdmarker (org-get-at-bol 'org-hd-marker)) + (_hdmarker (org-get-at-bol 'org-hd-marker)) (inhibit-read-only t)) (with-current-buffer buffer (widen) @@ -9397,7 +9477,7 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags." (org-agenda-buffer (current-buffer)) (thetags (with-current-buffer (marker-buffer hdmarker) (org-get-tags hdmarker))) - props m pl undone-face done-face finish new dotime level cat tags) + props m undone-face done-face finish new dotime level cat tags) ;; pl (save-excursion (goto-char (point-max)) (beginning-of-line 1) @@ -9419,7 +9499,7 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags." (with-current-buffer (marker-buffer hdmarker) (org-with-wide-buffer (org-agenda-format-item extra newhead level cat tags dotime)))) - pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) + ;; pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) undone-face (org-get-at-bol 'undone-face) done-face (org-get-at-bol 'done-face)) (beginning-of-line 1) @@ -9508,8 +9588,8 @@ Called with a universal prefix arg, show the priority instead of setting it." (user-error "Priority commands are disabled")) (org-agenda-check-no-diary) (let* ((col (current-column)) - (marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) + ;; (marker (or (org-get-at-bol 'org-marker) + ;; (org-agenda-error))) (hdmarker (org-get-at-bol 'org-hd-marker)) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) @@ -9563,7 +9643,7 @@ Called with a universal prefix arg, show the priority instead of setting it." (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) (inhibit-read-only t) - newhead) + ) ;; newhead (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -9764,7 +9844,7 @@ ARG is passed through to `org-schedule'." #'org-agenda-schedule arg t nil (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) - (type (marker-insertion-type marker)) + ;; (type (marker-insertion-type marker)) (buffer (marker-buffer marker)) (pos (marker-position marker)) ts) @@ -9839,9 +9919,9 @@ ARG is passed through to `org-deadline'." (org-move-to-column col) (org-agenda-unmark-clocking-task))) -(defun org-agenda-clock-cancel (&optional arg) +(defun org-agenda-clock-cancel (&optional _arg) "Cancel the currently running clock." - (interactive "P") + (interactive) ;; "P" (unless (marker-buffer org-clock-marker) (user-error "No running clock")) (org-with-remote-undo (marker-buffer org-clock-marker) @@ -10085,7 +10165,7 @@ entries in that Org file." (unwind-protect (progn (fset 'calendar-cursor-to-date - (lambda (&optional error dummy) + (lambda (&optional _error _dummy) (calendar-gregorian-from-absolute (get-text-property point 'day)))) (call-interactively cmd)) @@ -10100,18 +10180,19 @@ entries in that Org file." (let* ((oldf (symbol-function 'calendar-cursor-to-date)) (point (point)) (date (calendar-gregorian-from-absolute - (get-text-property point 'day))) - ;; the following 2 vars are needed in the calendar - (displayed-month (car date)) + (get-text-property point 'day)))) + ;; the following 2 vars are needed in the calendar + (org-dlet + ((displayed-month (car date)) (displayed-year (nth 2 date))) - (unwind-protect - (progn - (fset 'calendar-cursor-to-date - (lambda (&optional error dummy) - (calendar-gregorian-from-absolute - (get-text-property point 'day)))) - (call-interactively cmd)) - (fset 'calendar-cursor-to-date oldf)))) + (unwind-protect + (progn + (fset 'calendar-cursor-to-date + (lambda (&optional _error _dummy) + (calendar-gregorian-from-absolute + (get-text-property point 'day)))) + (call-interactively cmd)) + (fset 'calendar-cursor-to-date oldf))))) (defun org-agenda-phases-of-moon () "Display the phases of the moon for the 3 months around the cursor date." @@ -10216,7 +10297,7 @@ When ARG is greater than one mark ARG lines." (setq arg (count-lines (region-beginning) (region-end))) (goto-char (region-beginning)) (deactivate-mark)) - (dotimes (i (or arg 1)) + (dotimes (_ (or arg 1)) (unless (org-get-at-bol 'org-agenda-diary-link) (let* ((m (org-get-at-bol 'org-hd-marker)) ov) @@ -10413,7 +10494,7 @@ The prefix arg is passed through to the command if possible." (find-buffer-visiting (nth 1 refile-location)) (error "This should not happen"))))) - (setq cmd `(lambda () (org-agenda-refile nil ',refile-location t))) + (setq cmd (lambda () (org-agenda-refile nil refile-location t))) (setq redo-at-end t))) (?t @@ -10421,10 +10502,10 @@ The prefix arg is passed through to the command if possible." "Todo state: " (with-current-buffer (marker-buffer (car entries)) (mapcar #'list org-todo-keywords-1))))) - (setq cmd `(lambda () - (let ((org-inhibit-blocking t) - (org-inhibit-logging 'note)) - (org-agenda-todo ,state)))))) + (setq cmd (lambda () + (let ((org-inhibit-blocking t) + (org-inhibit-logging 'note)) + (org-agenda-todo state)))))) ((and (or ?- ?+) action) (let ((tag (completing-read @@ -10434,9 +10515,9 @@ The prefix arg is passed through to the command if possible." (mapcar (lambda (x) (and (stringp (car x)) x)) org-current-tag-alist)))))) (setq cmd - `(lambda () - (org-agenda-set-tags ,tag - ,(if (eq action ?+) ''on ''off)))))) + (lambda () + (org-agenda-set-tags tag + (if (eq action ?+) 'on 'off)))))) ((and (or ?s ?d) c) (let* ((schedule? (eq c ?s)) @@ -10458,13 +10539,13 @@ The prefix arg is passed through to the command if possible." ;; depending on the number of marked items. (setq cmd (if schedule? - `(lambda () - (let ((org-log-reschedule - (and org-log-reschedule 'time))) - (org-agenda-schedule arg ,time))) - `(lambda () - (let ((org-log-redeadline (and org-log-redeadline 'time))) - (org-agenda-deadline arg ,time))))))) + (lambda () + (let ((org-log-reschedule + (and org-log-reschedule 'time))) + (org-agenda-schedule arg time))) + (lambda () + (let ((org-log-redeadline (and org-log-redeadline 'time))) + (org-agenda-deadline arg time))))))) (?S (unless (org-agenda-check-type nil 'agenda 'todo) @@ -10474,29 +10555,29 @@ The prefix arg is passed through to the command if possible." (if arg "week" "")) 7))) (setq cmd - `(lambda () - (let ((distance (1+ (random ,days)))) - (when arg - (let ((dist distance) - (day-of-week - (calendar-day-of-week - (calendar-gregorian-from-absolute (org-today))))) - (dotimes (i (1+ dist)) - (while (member day-of-week org-agenda-weekend-days) - (cl-incf distance) - (cl-incf day-of-week) - (when (= day-of-week 7) - (setq day-of-week 0))) - (cl-incf day-of-week) - (when (= day-of-week 7) - (setq day-of-week 0))))) - ;; Silently fail when try to replan a sexp entry. - (ignore-errors - (let* ((date (calendar-gregorian-from-absolute - (+ (org-today) distance))) - (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) - (nth 2 date)))) - (org-agenda-schedule nil time)))))))) + (lambda () + (let ((distance (1+ (random days)))) + (when arg + (let ((dist distance) + (day-of-week + (calendar-day-of-week + (calendar-gregorian-from-absolute (org-today))))) + (dotimes (_ (1+ dist)) + (while (member day-of-week org-agenda-weekend-days) + (cl-incf distance) + (cl-incf day-of-week) + (when (= day-of-week 7) + (setq day-of-week 0))) + (cl-incf day-of-week) + (when (= day-of-week 7) + (setq day-of-week 0))))) + ;; Silently fail when try to replan a sexp entry. + (ignore-errors + (let* ((date (calendar-gregorian-from-absolute + (+ (org-today) distance))) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) + (nth 2 date)))) + (org-agenda-schedule nil time)))))))) (?f (setq cmd @@ -10583,7 +10664,7 @@ When the optional argument `backward' is non-nil, move backward." (let ((inhibit-read-only t) lst line) (if (or (not (get-text-property (point) 'txt)) (save-excursion - (dotimes (n arg) + (dotimes (_ arg) (move-beginning-of-line (if backward 0 2)) (push (not (get-text-property (point) 'txt)) lst)) (delq nil lst))) @@ -10612,7 +10693,7 @@ tag and (if present) the flagging note." (interactive) (let ((hdmarker (org-get-at-bol 'org-hd-marker)) (win (selected-window)) - note heading newhead) + note) ;; heading newhead (unless hdmarker (user-error "No linked entry at point")) (if (and (eq this-command last-command) @@ -10640,11 +10721,11 @@ tag and note"))))) (defun org-agenda-remove-flag (marker) "Remove the FLAGGED tag and any flagging note in the entry." - (let (newhead) - (org-with-point-at marker - (org-toggle-tag "FLAGGED" 'off) - (org-entry-delete nil "THEFLAGGINGNOTE") - (setq newhead (org-get-heading))) + (let ((newhead + (org-with-point-at marker + (org-toggle-tag "FLAGGED" 'off) + (org-entry-delete nil "THEFLAGGINGNOTE") + (org-get-heading)))) (org-agenda-change-all-lines newhead marker) (message "Entry unflagged"))) @@ -10712,7 +10793,7 @@ to override `appt-message-warning-time'." (setq entries (delq nil (append entries - (apply 'org-agenda-get-day-entries + (apply #'org-agenda-get-day-entries file today scope))))) ;; Map through entries and find if we should filter them out (mapc diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 8fa523e..7efe413 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -172,7 +172,7 @@ because otherwise all these markers will point to nowhere." ,@body))) (defmacro org-eval-in-environment (environment form) - (declare (debug (form form)) (indent 1)) + (declare (debug (form form)) (indent 1) (obsolete cl-progv "Mar 2021")) `(eval (list 'let ,environment ',form))) ;;;###autoload @@ -366,15 +366,17 @@ error when the user input is empty." (allow-empty? nil) (t (user-error "Empty input is not valid"))))) +(declare-function org-time-stamp-inactive "org" (&optional arg)) + (defun org-completing-read (&rest args) "Completing-read with SPACE being a normal character." (let ((enable-recursive-minibuffers t) (minibuffer-local-completion-map (copy-keymap minibuffer-local-completion-map))) - (define-key minibuffer-local-completion-map " " 'self-insert-command) - (define-key minibuffer-local-completion-map "?" 'self-insert-command) + (define-key minibuffer-local-completion-map " " #'self-insert-command) + (define-key minibuffer-local-completion-map "?" #'self-insert-command) (define-key minibuffer-local-completion-map (kbd "C-c !") - 'org-time-stamp-inactive) + #'org-time-stamp-inactive) (apply #'completing-read args))) (defun org--mks-read-key (allowed-keys prompt navigation-keys) @@ -627,6 +629,30 @@ program is needed for, so that the error message can be more informative." (let ((message-log-max nil)) (apply #'message args))) +(defmacro org-dlet (binders &rest body) + "Like `let*' but using dynamic scoping." + (declare (indent 1) (debug let)) + (let ((vars (mapcar (lambda (binder) + (if (consp binder) (car binder) binder)) + binders))) + `(progn + (with-no-warnings + ,@(mapcar (lambda (var) `(defvar ,var)) vars)) + (let* ,binders ,@body)))) + +(defmacro org-pushnew-to-end (val var) + "Like `cl-pushnew' but pushes to the end of the list. +Uses `equal' for comparisons. + +Beware: this performs O(N) memory allocations, so if you use it in a loop, you +get an unnecessary O(N²) space complexity, so you're usually better off using +`cl-pushnew' (with a final `reverse' if you care about the order of elements)." + (declare (debug (form gv-place))) + (let ((v (make-symbol "v"))) + `(let ((,v ,val)) + (unless (member ,v ,var) + (setf ,var (append ,var (list ,v))))))) + (defun org-eval (form) "Eval FORM and return result." (condition-case error @@ -974,7 +1000,7 @@ IF WIDTH is nil and LINES is non-nil, the string is forced into at most that many lines, whatever width that takes. The return value is a list of lines, without newlines at the end." (let* ((words (split-string string)) - (maxword (apply 'max (mapcar 'org-string-width words))) + (maxword (apply #'max (mapcar #'org-string-width words))) w ll) (cond (width (org--do-wrap words (max maxword width))) @@ -1071,10 +1097,11 @@ that will be added to PLIST. Returns the string that was modified." string) (defun org-make-parameter-alist (flat) + ;; FIXME: "flat" is called a "plist"! "Return alist based on FLAT. FLAT is a list with alternating symbol names and values. The returned alist is a list of lists with the symbol name in car and -the value in cdr." +the value in cadr." (when flat (cons (list (car flat) (cadr flat)) (org-make-parameter-alist (cddr flat))))) diff --git a/lisp/org-num.el b/lisp/org-num.el index ebddaa3..46f8e7c 100644 --- a/lisp/org-num.el +++ b/lisp/org-num.el @@ -63,6 +63,7 @@ (require 'cl-lib) (require 'org-macs) +(require 'org) ;Otherwise `org-num--comment-re' burps on `org-comment-string' (defvar org-comment-string) (defvar org-complex-heading-regexp) @@ -90,7 +91,7 @@ output." (face :tag "Use face")) :safe (lambda (val) (or (null val) (facep val)))) -(defcustom org-num-format-function 'org-num-default-format +(defcustom org-num-format-function #'org-num-default-format "Function used to display numbering. It is called with one argument, a list of numbers, and should return a string, or nil. When nil, no numbering is displayed. diff --git a/testing/lisp/test-ob-java.el b/testing/lisp/test-ob-java.el index 47ea654..6935733 100644 --- a/testing/lisp/test-ob-java.el +++ b/testing/lisp/test-ob-java.el @@ -21,7 +21,7 @@ ;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;; Code: -(require 'org-test) +(require 'org-test "../testing/org-test") (require 'ob-core) (defvar org-babel-temporary-directory ; from ob-core diff --git a/testing/lisp/test-org-agenda.el b/testing/lisp/test-org-agenda.el index 0efcdc2..3c0479b 100644 --- a/testing/lisp/test-org-agenda.el +++ b/testing/lisp/test-org-agenda.el @@ -23,7 +23,7 @@ ;;; Code: -(require 'org-test) +(require 'org-test "../testing/org-test") (require 'org-agenda) (eval-and-compile (require 'cl-lib)) diff --git a/testing/lisp/test-org-attach.el b/testing/lisp/test-org-attach.el index 168e5d5..851bb11 100644 --- a/testing/lisp/test-org-attach.el +++ b/testing/lisp/test-org-attach.el @@ -24,7 +24,7 @@ ;;; Code: -(require 'org-test) +(require 'org-test "../testing/org-test") (require 'org-attach) (eval-and-compile (require 'cl-lib)) diff --git a/testing/lisp/test-org-src.el b/testing/lisp/test-org-src.el index 2b1527a..8fdcd6d 100644 --- a/testing/lisp/test-org-src.el +++ b/testing/lisp/test-org-src.el @@ -21,7 +21,7 @@ ;;; Code: -(require 'org-test) +(require 'org-test "../testing/org-test") diff --git a/testing/org-test.el b/testing/org-test.el index 6904e16..61fbe60 100644 --- a/testing/org-test.el +++ b/testing/org-test.el @@ -286,7 +286,15 @@ setting `pp-escape-newlines' to nil manually." ;;; Navigation Functions -(when (featurep 'jump) + +(defmacro org--compile-when (test &rest body) + (declare (debug t) (indent 1)) + (let ((exp `(progn ,@body))) + (if (eval test t) + exp + `(when ,test (eval exp t))))) + +(org--compile-when (featurep 'jump) (defjump org-test-jump (("lisp/\\1.el" . "testing/lisp/test-\\1.el") ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el") @@ -323,7 +331,8 @@ setting `pp-escape-newlines' to nil manually." " (should-not nil)\n" " (should-error (error \"errr...\")))\n\n\n" "(provide '" name ")\n\n" - ";;; " file-name " ends here\n") full-path)) + ";;; " file-name " ends here\n") + full-path)) (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function))))) (define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump) |