From: Stefan Monnier <monnier@iro.umontreal.ca>
To: Kyle Meyer <kyle@kyleam.com>
Cc: Marco Wahl <marcowahlsoft@gmail.com>, emacs-orgmode@gnu.org
Subject: Re: Using lexical-binding
Date: Sat, 06 Mar 2021 17:33:06 -0500 [thread overview]
Message-ID: <jwv4khnap6r.fsf-monnier+emacs@gnu.org> (raw)
In-Reply-To: <87r1ks9plr.fsf@kyleam.com> (Kyle Meyer's message of "Sat, 06 Mar 2021 12:08:48 -0500")
[-- Attachment #1: Type: text/plain, Size: 92 bytes --]
>> Should I send a rebased patch for inclusion
> Yes, please.
Here it is,
Stefan
[-- Attachment #2: 0001-lisp-org-agenda.el-Use-lexical-binding.patch --]
[-- Type: text/x-diff, Size: 87197 bytes --]
From ba61c9660fc09321f9dfe5f746705f5d1202c474 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Tue, 23 Feb 2021 15:47:29 -0500
Subject: [PATCH] * lisp/org-agenda.el: Use lexical-binding
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
- 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`.
---
.gitignore | 6 +
contrib/lisp/ob-arduino.el | 2 +-
contrib/lisp/ob-clojure-literate.el | 2 +-
contrib/lisp/ob-sclang.el | 2 +-
doc/Makefile | 14 +-
lisp/org-agenda.el | 871 +++++++++++++++-------------
lisp/org-macs.el | 39 +-
lisp/org-num.el | 3 +-
testing/lisp/test-ob-java.el | 2 +-
testing/lisp/test-org-agenda.el | 2 +-
testing/lisp/test-org-attach.el | 2 +-
testing/lisp/test-org-src.el | 2 +-
testing/org-test.el | 13 +-
13 files changed, 543 insertions(+), 417 deletions(-)
diff --git a/.gitignore b/.gitignore
index 1a72cc20b0..4bb81c359b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -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 57a15ffa8e..8a1fd76d67 100644
--- a/contrib/lisp/ob-arduino.el
+++ b/contrib/lisp/ob-arduino.el
@@ -33,7 +33,7 @@
\f
(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 b1cc386ee3..cd2dcff974 100644
--- a/contrib/lisp/ob-clojure-literate.el
+++ b/contrib/lisp/ob-clojure-literate.el
@@ -20,7 +20,7 @@
;;; Code:
\f
(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 5ab26867b0..0b01fc5a92 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 96fda14454..dc6882927e 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 ed976bfdf4..001ca4b1b9 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-suppressed-warnings ((lexical match))
+ (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-suppressed-warnings ((lexical date entry)) (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-suppressed-warnings ((lexical date)) (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-suppressed-warnings ((lexical date entry)) (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-suppressed-warnings ((lexical date entry)) (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-suppressed-warnings ((lexical date)) (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-suppressed-warnings ((lexical date)) (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-suppressed-warnings ((lexical date)) (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-suppressed-warnings ((lexical date)) (defvar date))
(let* ((props (list 'face nil
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
@@ -6630,6 +6691,15 @@ Any match of REMOVE-RE will be removed from TXT."
org-agenda-show-inherited-tags
org-agenda-hide-tags-regexp))
+ (with-suppressed-warnings
+ ((lexical breadcrumbs category category-icon effort extra
+ level tag time))
+ ;; `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 +6711,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 +6797,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 +6811,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 +6930,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 +6958,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 +6978,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 +7056,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 +7071,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 +7286,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 +7334,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 +7543,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 +7556,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 +7595,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 +7825,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 +7833,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 +7859,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 +7974,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 +8055,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 +8199,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 +8386,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 +8562,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 +8634,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 +8771,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 +8784,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 +8827,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 +8859,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 +8869,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 +8895,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 +9036,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 +9114,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 +9400,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 +9429,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 +9448,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 +9479,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 +9501,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 +9590,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 +9645,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 +9846,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 +9921,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 +10167,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 +10182,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 +10299,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 +10496,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 +10504,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 +10517,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 +10541,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 +10557,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 +10666,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 +10695,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 +10723,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 +10795,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 8fa523e51c..63f0a0acb7 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-suppressed-warnings ((lexical ,@vars))
+ ,@(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 ebddaa32b4..46f8e7cd73 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 47ea654f56..69357338a7 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 0efcdc2187..3c0479bcc6 100644
--- a/testing/lisp/test-org-agenda.el
+++ b/testing/lisp/test-org-agenda.el
@@ -23,7 +23,7 @@
\f
;;; 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 168e5d56f7..851bb111e6 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 2b1527a5cd..8fdcd6d6ae 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")
\f
diff --git a/testing/org-test.el b/testing/org-test.el
index 6904e16d10..61fbe60ddb 100644
--- a/testing/org-test.el
+++ b/testing/org-test.el
@@ -286,7 +286,15 @@ setting `pp-escape-newlines' to nil manually."
\f
;;; 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)
--
2.30.1
next prev parent reply other threads:[~2021-03-06 22:34 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-02-23 21:11 Using lexical-binding Stefan Monnier
2021-02-24 0:26 ` Kyle Meyer
2021-02-24 3:44 ` Kyle Meyer
2021-02-24 4:01 ` Samuel Wales
2021-02-24 4:33 ` Stefan Monnier
2021-02-25 5:42 ` Kyle Meyer
2021-02-25 5:41 ` Kyle Meyer
2021-03-04 6:03 ` Kyle Meyer
2021-03-04 9:11 ` Marco Wahl
2021-03-06 16:10 ` Stefan Monnier
2021-03-06 17:08 ` Kyle Meyer
2021-03-06 22:33 ` Stefan Monnier [this message]
2021-03-09 5:35 ` Kyle Meyer
2021-03-09 14:09 ` Stefan Monnier
2021-03-10 4:16 ` Kyle Meyer
2021-03-10 16:32 ` Stefan Monnier
2021-03-19 16:23 ` Greg Minshall
2021-03-20 3:34 ` Greg Minshall
2021-03-20 4:48 ` Kyle Meyer
2021-03-20 5:33 ` Greg Minshall
2021-03-21 16:04 ` Kyle Meyer
2021-03-21 17:14 ` Greg Minshall
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=jwv4khnap6r.fsf-monnier+emacs@gnu.org \
--to=monnier@iro.umontreal.ca \
--cc=emacs-orgmode@gnu.org \
--cc=kyle@kyleam.com \
--cc=marcowahlsoft@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).