From: Stefan Monnier <monnier@iro.umontreal.ca>
To: emacs-orgmode@gnu.org
Subject: Using lexical-binding
Date: Tue, 23 Feb 2021 16:11:39 -0500 [thread overview]
Message-ID: <jwvblcapl1p.fsf-monnier+emacs@gnu.org> (raw)
[-- Attachment #1: Type: text/plain, Size: 2597 bytes --]
As part of the on-going work to use lexical-binding in all the files
bundled with Emacs, I took a stab at converting org-agenda.el to
lexical-binding.
Since I'm not using it, I can't really test the result in any meaningful
way. Furthermore, just like `calendar.el`, it relies on dynamic scoping
and `eval` in all kinds of ways, so it's very difficult to be sure the
result is "sufficiently similar" to the old behavior not to break some
funky use somewhere out there.
Anyway, here's my first cut (the patch is made against the head of
Org's `master` rather than Emacs's `master`, since I suspect that could
make things easier for you). The commit message is basically empty
because it's not intended to be installed yet. I'm instead hoping for
some feedback, such as "tried it, works" or "burps all over the place",
or "pretends everything is fine but doesn't do the right thing any
more", or (even better) actual feedback about the code itself and the
approach(es) I chose to use.
Stefan
- 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 believe I have quashed all the compiler warnings (some had nothing
to do with lexical scoping), except for a reference to the function
`add-to-diary-list` which I can't find anywhere (is it some old
function that has disappeared, maybe?).
- 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 `prg-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.
[-- Attachment #2: 0001-org-agenda.el-First-attempt-at-using-lexical-binding.patch --]
[-- Type: text/x-diff, Size: 74080 bytes --]
From d34f993044ee817f7ee18342bcc686285329bea5 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] * org-agenda.el: First attempt at using `lexical-binding`
---
.gitignore | 6 +
doc/Makefile | 14 +-
lisp/org-agenda.el | 827 +++++++++++++++++++++++++--------------------
lisp/org-macs.el | 41 ++-
4 files changed, 502 insertions(+), 386 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/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 aef6420377..16ec70c773 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,61 +3247,70 @@ s Search for keywords M Like m, but only TODO entries
(defvar org-agenda-overriding-cmd-arguments nil)
(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)
@@ -3306,7 +3320,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)
@@ -3351,11 +3371,17 @@ 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
+ (if (> (length cmd-key) 2) ;FIXME: Shouldn't this be 1?
+ (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)
@@ -3363,9 +3389,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")))))
@@ -3374,7 +3400,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)))
@@ -3410,19 +3436,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)
@@ -3439,14 +3468,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)))))))
@@ -3486,80 +3519,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)))
@@ -3718,12 +3758,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
@@ -3961,7 +4000,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 ()
@@ -4030,10 +4069,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..."))
@@ -4141,7 +4180,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'.")
@@ -4295,11 +4334,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)
@@ -4365,11 +4404,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
@@ -4409,7 +4448,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))
@@ -4630,7 +4669,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+)
@@ -4795,6 +4834,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.
@@ -5050,7 +5091,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)))
@@ -5124,7 +5165,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
@@ -5162,12 +5203,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
@@ -5183,16 +5224,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))
@@ -5281,9 +5328,10 @@ Needed to avoid empty dates which mess up holiday display."
(org-add-to-diary-list original-date "Org mode dummy" "" nil)))))
(defun org-add-to-diary-list (&rest args)
- (if (fboundp 'diary-add-to-list)
- (apply 'diary-add-to-list args)
- (apply 'add-to-diary-list args)))
+ (apply (if (fboundp 'diary-add-to-list)
+ #'diary-add-to-list
+ #'add-to-diary-list)
+ args))
(defvar org-diary-last-run-time nil)
@@ -5314,6 +5362,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)
@@ -5338,7 +5387,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
@@ -5481,11 +5530,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
@@ -5625,6 +5675,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
@@ -5767,12 +5818,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))
@@ -5853,6 +5907,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))
@@ -5869,9 +5924,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
@@ -5891,7 +5947,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 "\\)"
@@ -6103,6 +6159,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
@@ -6261,6 +6318,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
@@ -6461,6 +6519,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
@@ -6629,6 +6688,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
@@ -6640,7 +6708,6 @@ 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))
time
@@ -6741,13 +6808,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
@@ -6860,7 +6927,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)
@@ -6888,12 +6955,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))
@@ -6909,10 +6975,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)))))
@@ -6987,8 +7053,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
@@ -7002,7 +7068,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."
@@ -7217,8 +7283,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)
@@ -7264,14 +7331,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
@@ -7473,7 +7540,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.
@@ -7486,6 +7553,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)
@@ -7524,8 +7592,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
@@ -7751,7 +7822,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 "/"))))
@@ -7759,7 +7830,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))
@@ -7785,20 +7856,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
@@ -7900,7 +7971,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
@@ -7981,7 +8052,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)
@@ -8125,10 +8196,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)
@@ -8311,12 +8383,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))
@@ -8487,7 +8559,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
@@ -8559,7 +8631,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)
@@ -8696,7 +8768,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")
@@ -8708,36 +8781,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
@@ -8748,7 +8824,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"
@@ -8779,7 +8856,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))))
@@ -8789,7 +8866,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)
@@ -8815,7 +8892,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)
@@ -8956,6 +9033,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)
@@ -9032,7 +9111,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
@@ -9318,6 +9397,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
@@ -9345,8 +9426,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)
@@ -9365,15 +9445,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)
@@ -9396,7 +9476,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)
@@ -9418,7 +9498,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)
@@ -9507,8 +9587,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))
@@ -9562,7 +9642,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)
@@ -9763,7 +9843,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)
@@ -9838,9 +9918,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)
@@ -10084,7 +10164,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))
@@ -10099,18 +10179,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."
@@ -10215,7 +10296,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)
@@ -10412,7 +10493,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
@@ -10420,10 +10501,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
@@ -10433,9 +10514,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))
@@ -10457,13 +10538,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)
@@ -10473,29 +10554,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
@@ -10582,7 +10663,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)))
@@ -10611,7 +10692,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)
@@ -10639,11 +10720,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")))
@@ -10711,7 +10792,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 d40ed1a045..962564d120 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 "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,11 +629,37 @@ 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-let (list &rest body)
+ (declare (obsolete cl-progv "2021"))
(eval (cons 'let (cons list body))))
(put 'org-let 'lisp-indent-function 1)
(defun org-let2 (list1 list2 &rest body)
+ (declare (obsolete cl-progv "2021"))
(eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
(put 'org-let2 'lisp-indent-function 2)
@@ -982,7 +1010,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)))
@@ -1079,10 +1107,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)))))
--
2.30.0
next reply other threads:[~2021-02-23 21:14 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-02-23 21:11 Stefan Monnier [this message]
2021-02-24 0:26 ` Using lexical-binding 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
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=jwvblcapl1p.fsf-monnier+emacs@gnu.org \
--to=monnier@iro.umontreal.ca \
--cc=emacs-orgmode@gnu.org \
/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).