* Using lexical-binding
@ 2021-02-23 21:11 Stefan Monnier
2021-02-24 0:26 ` Kyle Meyer
2021-02-25 5:41 ` Kyle Meyer
0 siblings, 2 replies; 22+ messages in thread
From: Stefan Monnier @ 2021-02-23 21:11 UTC (permalink / raw)
To: emacs-orgmode
[-- 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
^ permalink raw reply related [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
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:33 ` Stefan Monnier
2021-02-25 5:41 ` Kyle Meyer
1 sibling, 2 replies; 22+ messages in thread
From: Kyle Meyer @ 2021-02-24 0:26 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-orgmode
Stefan Monnier writes:
> 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.
Thank you.
> [...]
> 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",
With a quick test of a few main commands, burps in one of four.
Contents /tmp/scratch.org:
--8<---------------cut here---------------start------------->8---
* TODO a :t:
SCHEDULED: <2021-02-23 Tue>
foo
* DONE b
* TODO c
DEADLINE: <2021-02-23 Tue>
--8<---------------cut here---------------end--------------->8---
Running with emacs 27.1 and -Q:
(require 'org-agenda)
(setq org-agenda-files '("/tmp/scratch.org"))
(global-set-key (kbd "C-c a") #'org-agenda)
;; Commands:
;; (org-todo-list) ; works
;; (org-search-view nil "foo") ; works
;; (org-tags-view nil "+t") ; works
;; (org-agenda-list) ; fails: void-variable date
There are also some `make test' failures:
7 unexpected results:
FAILED test-org-agenda/diary-inclusion
FAILED test-org-agenda/empty
FAILED test-org-agenda/one-line
FAILED test-org-agenda/scheduled-non-todo
FAILED test-org-agenda/set-priority
FAILED test-org-agenda/sticky-agenda-name
FAILED test-org-agenda/sticky-agenda-name-after-reload
> 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.
While I'm not sure I can provide any useful feedback about approaches,
I'll see if I can tweak your patch to resolve the org-agenda-list
failure or any of the above test failures.
> - I believe I have quashed all the compiler warnings (some had nothing
> to do with lexical scoping),
Hmm, I wonder why I'm not seeing the ones unrelated to the lexical
scoping change. `make compile' and `make single' are quiet for me on
Org's current master (d21d200bc) with Emacs 27. If I use an Emacs built
from a recent Emacs commit (6172454ff3), I see a couple of "docstring
wider than 80 characters" warnings (will fix), but nothing in
org-agenda.el.
> 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?).
It looks like add-to-diary-list became an obsolete alias for
diary-add-to-list in Emacs 23.1 and was removed in Emacs 25.1,
specifically 3f65970414 (Remove calendar code obsolete since at least
version 23.1, 2014-10-05).
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
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
1 sibling, 1 reply; 22+ messages in thread
From: Kyle Meyer @ 2021-02-24 3:44 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-orgmode
Kyle Meyer writes:
> Stefan Monnier writes:
[...]
> ;; (org-agenda-list) ; fails: void-variable date
>
> There are also some `make test' failures:
>
> 7 unexpected results:
> FAILED test-org-agenda/diary-inclusion
> FAILED test-org-agenda/empty
> FAILED test-org-agenda/one-line
> FAILED test-org-agenda/scheduled-non-todo
> FAILED test-org-agenda/set-priority
> FAILED test-org-agenda/sticky-agenda-name
> FAILED test-org-agenda/sticky-agenda-name-after-reload
>
>> 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.
>
> While I'm not sure I can provide any useful feedback about approaches,
> I'll see if I can tweak your patch to resolve the org-agenda-list
> failure or any of the above test failures.
With the changes below on top of your patch, the simple org-agenda-list
call from above works and the test failures are gone.
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 16ec70c77..81409d6ac 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -5448,27 +5448,29 @@ (defun org-agenda-get-day-entries (file date &rest args)
(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?"
@@ -6710,6 +6712,7 @@ (defun org-agenda-format-item (extra txt &optional level category tags dotime
(get-text-property 1 'effort txt)))
(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 "")
@@ -6793,7 +6796,6 @@ (defun org-agenda-format-item (extra txt &optional level category tags dotime
(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)
^ permalink raw reply related [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-02-24 3:44 ` Kyle Meyer
@ 2021-02-24 4:01 ` Samuel Wales
0 siblings, 0 replies; 22+ messages in thread
From: Samuel Wales @ 2021-02-24 4:01 UTC (permalink / raw)
To: Kyle Meyer; +Cc: emacs-orgmode, Stefan Monnier
just a thanks to maintainers of emacs and org including those of you
fixing this and those who wrote the tests. i had no idea org wasn't
fully lexical yet. i look forward to whatever good that brings.
On 2/23/21, Kyle Meyer <kyle@kyleam.com> wrote:
> Kyle Meyer writes:
>
>> Stefan Monnier writes:
> [...]
>> ;; (org-agenda-list) ; fails: void-variable date
>>
>> There are also some `make test' failures:
>>
>> 7 unexpected results:
>> FAILED test-org-agenda/diary-inclusion
>> FAILED test-org-agenda/empty
>> FAILED test-org-agenda/one-line
>> FAILED test-org-agenda/scheduled-non-todo
>> FAILED test-org-agenda/set-priority
>> FAILED test-org-agenda/sticky-agenda-name
>> FAILED test-org-agenda/sticky-agenda-name-after-reload
>>
>>> 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.
>>
>> While I'm not sure I can provide any useful feedback about approaches,
>> I'll see if I can tweak your patch to resolve the org-agenda-list
>> failure or any of the above test failures.
>
> With the changes below on top of your patch, the simple org-agenda-list
> call from above works and the test failures are gone.
>
> diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
> index 16ec70c77..81409d6ac 100644
> --- a/lisp/org-agenda.el
> +++ b/lisp/org-agenda.el
> @@ -5448,27 +5448,29 @@ (defun org-agenda-get-day-entries (file date &rest
> args)
> (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?"
> @@ -6710,6 +6712,7 @@ (defun org-agenda-format-item (extra txt &optional
> level category tags dotime
> (get-text-property 1 'effort txt)))
> (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 "")
> @@ -6793,7 +6796,6 @@ (defun org-agenda-format-item (extra txt &optional
> level category tags dotime
> (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)
>
>
--
The Kafka Pandemic
Please learn what misopathy is.
https://thekafkapandemic.blogspot.com/2013/10/why-some-diseases-are-wronged.html
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-02-24 0:26 ` Kyle Meyer
2021-02-24 3:44 ` Kyle Meyer
@ 2021-02-24 4:33 ` Stefan Monnier
2021-02-25 5:42 ` Kyle Meyer
1 sibling, 1 reply; 22+ messages in thread
From: Stefan Monnier @ 2021-02-24 4:33 UTC (permalink / raw)
To: Kyle Meyer; +Cc: emacs-orgmode
> With a quick test of a few main commands, burps in one of four.
Excellent, and thanks for the subsequent patch (I don't think I'd have
come up with the move of `extra` on my own).
>> - I believe I have quashed all the compiler warnings (some had nothing
>> to do with lexical scoping),
>
> Hmm, I wonder why I'm not seeing the ones unrelated to the lexical
> scoping change.
I don't think there were many of them. As for why there were some:
1- the change away from `org-let` and friends causes some code to become
visible to the compiler (it was hidden behind the "eval wall" until
then).
2- I have some extra warnings in my local Emacs.
>> 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?).
>
> It looks like add-to-diary-list became an obsolete alias for
> diary-add-to-list in Emacs 23.1 and was removed in Emacs 25.1,
> specifically 3f65970414 (Remove calendar code obsolete since at least
> version 23.1, 2014-10-05).
Ah, thanks for tracking it down, so I guess we can drop this altogether.
And we can also drop the `condition-case` in `org-diary-default-entry`
because that change in calling convention is even older than the change
of name from `add-to-diary-list` to `diary-add-to-list`.
Stefan
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-02-23 21:11 Using lexical-binding Stefan Monnier
2021-02-24 0:26 ` Kyle Meyer
@ 2021-02-25 5:41 ` Kyle Meyer
2021-03-04 6:03 ` Kyle Meyer
1 sibling, 1 reply; 22+ messages in thread
From: Kyle Meyer @ 2021-02-25 5:41 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-orgmode
Stefan Monnier writes:
> 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.
I probably don't use many fancy agenda features, but I do work regularly
from it. Running with these changes throughout today, I didn't notice
any issues. Within the next few days, I'll try to test some non-default
settings and more obscure features that I don't use as part of my normal
workflow, and see if I can find any problems.
I'll also push the current changes to scratch/sm/agenda-lexical with the
hope that others will test and report back.
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-02-24 4:33 ` Stefan Monnier
@ 2021-02-25 5:42 ` Kyle Meyer
0 siblings, 0 replies; 22+ messages in thread
From: Kyle Meyer @ 2021-02-25 5:42 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-orgmode
Stefan Monnier writes:
>> It looks like add-to-diary-list became an obsolete alias for
>> diary-add-to-list in Emacs 23.1 and was removed in Emacs 25.1,
>> specifically 3f65970414 (Remove calendar code obsolete since at least
>> version 23.1, 2014-10-05).
>
> Ah, thanks for tracking it down, so I guess we can drop this altogether.
> And we can also drop the `condition-case` in `org-diary-default-entry`
> because that change in calling convention is even older than the change
> of name from `add-to-diary-list` to `diary-add-to-list`.
Yes, sounds good. Done in Org's 0b117f72a.
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
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
0 siblings, 2 replies; 22+ messages in thread
From: Kyle Meyer @ 2021-03-04 6:03 UTC (permalink / raw)
To: Stefan Monnier; +Cc: emacs-orgmode
Kyle Meyer writes:
> Stefan Monnier writes:
>
>> 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.
>
> I probably don't use many fancy agenda features, but I do work regularly
> from it. Running with these changes throughout today, I didn't notice
> any issues. Within the next few days, I'll try to test some non-default
> settings and more obscure features that I don't use as part of my normal
> workflow, and see if I can find any problems.
I've continued to run with these changes and still haven't noticed any
problems. I've also tested various features (sticky agendas, block
agendas, option setting from custom commands) and didn't spot anything.
> I'll also push the current changes to scratch/sm/agenda-lexical with the
> hope that others will test and report back.
Has anyone else tried this out?
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-03-04 6:03 ` Kyle Meyer
@ 2021-03-04 9:11 ` Marco Wahl
2021-03-06 16:10 ` Stefan Monnier
1 sibling, 0 replies; 22+ messages in thread
From: Marco Wahl @ 2021-03-04 9:11 UTC (permalink / raw)
To: Kyle Meyer; +Cc: emacs-orgmode, Stefan Monnier
> Kyle Meyer writes:
>> Stefan Monnier writes:
>>
>>> 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.
>>
>> I probably don't use many fancy agenda features, but I do work regularly
>> from it. Running with these changes throughout today, I didn't notice
>> any issues. Within the next few days, I'll try to test some non-default
>> settings and more obscure features that I don't use as part of my normal
>> workflow, and see if I can find any problems.
>
> I've continued to run with these changes and still haven't noticed any
> problems. I've also tested various features (sticky agendas, block
> agendas, option setting from custom commands) and didn't spot anything.
>
>> I'll also push the current changes to scratch/sm/agenda-lexical with the
>> hope that others will test and report back.
>
> Has anyone else tried this out?
I'm using that branch for several days now without any problem. LGTM!
I did nothing special for the test though. At least I use column mode,
Org habits and interaction with calendar.
Thanks!
--
Marco
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
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
1 sibling, 1 reply; 22+ messages in thread
From: Stefan Monnier @ 2021-03-06 16:10 UTC (permalink / raw)
To: Kyle Meyer; +Cc: emacs-orgmode
Should I send a rebased patch for inclusion or do you want to give more
time for people to try it out?
Stefan
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-03-06 16:10 ` Stefan Monnier
@ 2021-03-06 17:08 ` Kyle Meyer
2021-03-06 22:33 ` Stefan Monnier
0 siblings, 1 reply; 22+ messages in thread
From: Kyle Meyer @ 2021-03-06 17:08 UTC (permalink / raw)
To: Stefan Monnier; +Cc: Marco Wahl, emacs-orgmode
Stefan Monnier writes:
> Should I send a rebased patch for inclusion
Yes, please.
> or do you want to give more time for people to try it out?
My guess is that we won't hear much more without bringing the changes
into master, and I'm in favor of doing so given that Marco and I have
both used it for a good amount of time without finding issues. (Thanks,
Marco, for trying it out.)
Thank you.
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-03-06 17:08 ` Kyle Meyer
@ 2021-03-06 22:33 ` Stefan Monnier
2021-03-09 5:35 ` Kyle Meyer
0 siblings, 1 reply; 22+ messages in thread
From: Stefan Monnier @ 2021-03-06 22:33 UTC (permalink / raw)
To: Kyle Meyer; +Cc: Marco Wahl, emacs-orgmode
[-- 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
^ permalink raw reply related [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-03-06 22:33 ` Stefan Monnier
@ 2021-03-09 5:35 ` Kyle Meyer
2021-03-09 14:09 ` Stefan Monnier
0 siblings, 1 reply; 22+ messages in thread
From: Kyle Meyer @ 2021-03-09 5:35 UTC (permalink / raw)
To: Stefan Monnier; +Cc: Marco Wahl, emacs-orgmode
Looking at this one more time before applying, I noticed a couple of
backward compatibility issues.
Stefan Monnier writes:
> Subject: [PATCH] * lisp/org-agenda.el: Use lexical-binding
[...]
> + (pcase type
> + ('agenda
> + (org-agenda-list current-prefix-arg))
Unfortunately Org's minimum Emacs version is still Emacs 24.3. I'd like
to drop Emacs 24 support soon, but that hasn't been discussed or
announced.
And...
> + (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))
... I believe with-suppressed-warnings isn't available until Emacs 27.1,
right?
Any objections to me squashing the below changes into your patch?
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 001ca4b1b..d08cab061 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -2938,30 +2938,30 @@ (defun org-agenda (&optional arg keys restriction)
(mapcar #'car lprops)
(mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
(pcase type
- ('agenda
+ (`agenda
(org-agenda-list current-prefix-arg))
- ('agenda*
+ (`agenda*
(org-agenda-list current-prefix-arg nil nil t))
- ('alltodo
+ (`alltodo
(org-todo-list current-prefix-arg))
- ('search
+ (`search
(org-search-view current-prefix-arg org-match nil))
- ('stuck
+ (`stuck
(org-agenda-list-stuck-projects current-prefix-arg))
- ('tags
+ (`tags
(org-tags-view current-prefix-arg org-match))
- ('tags-todo
+ (`tags-todo
(org-tags-view '(4) org-match))
- ('todo
+ (`todo
(org-todo-list org-match))
- ('tags-tree
+ (`tags-tree
(org-check-for-org-mode)
(org-match-sparse-tree current-prefix-arg org-match))
- ('todo-tree
+ (`todo-tree
(org-check-for-org-mode)
(org-occur (concat "^" org-outline-regexp "[ \t]*"
(regexp-quote org-match) "\\>")))
- ('occur-tree
+ (`occur-tree
(org-check-for-org-mode)
(org-occur org-match))
((pred functionp)
@@ -3263,7 +3263,7 @@ (defun org-agenda-run-series (name series)
;; 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))
+ (org-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
@@ -3285,21 +3285,21 @@ (defun org-agenda-run-series (name series)
(lvals (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)))
(cl-progv (append gvars lvars) (append gvals lvals)
(pcase type
- ('agenda
+ (`agenda
(call-interactively 'org-agenda-list))
- ('agenda*
+ (`agenda*
(funcall 'org-agenda-list nil nil t))
- ('alltodo
+ (`alltodo
(call-interactively 'org-todo-list))
- ('search
+ (`search
(org-search-view current-prefix-arg match nil))
- ('stuck
+ (`stuck
(call-interactively 'org-agenda-list-stuck-projects))
- ('tags
+ (`tags
(org-tags-view current-prefix-arg match))
- ('tags-todo
+ (`tags-todo
(org-tags-view '(4) match))
- ('todo
+ (`todo
(org-todo-list match))
((pred fboundp)
(funcall type match))
@@ -5363,7 +5363,7 @@ (defun org-diary (&rest args)
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))
+ (org-with-suppressed-warnings ((lexical date entry)) (defvar date) (defvar entry))
(when (> (- (float-time)
org-agenda-last-marker-time)
5)
@@ -5678,7 +5678,7 @@ (defun org-agenda-get-timestamps (&optional 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))
+ (org-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
@@ -5821,7 +5821,7 @@ (defun org-agenda-get-timestamps (&optional deadlines)
(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))
+ (org-with-suppressed-warnings ((lexical date entry)) (defvar date) (defvar entry))
(let* ((props (list 'face 'org-agenda-calendar-sexp
'mouse-face 'highlight
'help-echo
@@ -5910,7 +5910,7 @@ (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
`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))
+ (org-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))
@@ -5930,7 +5930,7 @@ (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
(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))
+ (org-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
@@ -6162,7 +6162,7 @@ (defun org-agenda-get-deadlines (&optional with-hour)
"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))
+ (org-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
@@ -6321,7 +6321,7 @@ (defun org-agenda-get-scheduled (&optional deadlines with-hour)
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))
+ (org-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
@@ -6522,7 +6522,7 @@ (defun org-agenda-get-scheduled (&optional deadlines with-hour)
(defun org-agenda-get-blocks ()
"Return the date-range information for agenda display."
- (with-suppressed-warnings ((lexical date)) (defvar date))
+ (org-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
@@ -6691,7 +6691,7 @@ (defun org-agenda-format-item (extra txt &optional level category tags dotime
org-agenda-show-inherited-tags
org-agenda-hide-tags-regexp))
- (with-suppressed-warnings
+ (org-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.
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 63f0a0acb..92fdef0a0 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -629,6 +629,12 @@ (defun org-unlogged-message (&rest args)
(let ((message-log-max nil))
(apply #'message args)))
+(if (fboundp 'with-suppressed-warnings) ; Introduced in Emacs 27.1.
+ (defalias 'org-with-suppressed-warnings 'with-suppressed-warnings)
+ (defmacro org-with-suppressed-warnings (_warnings &rest body)
+ (declare (debug (sexp &optional body)) (indent 1))
+ `(progn ,@body)))
+
(defmacro org-dlet (binders &rest body)
"Like `let*' but using dynamic scoping."
(declare (indent 1) (debug let))
@@ -636,7 +642,7 @@ (defmacro org-dlet (binders &rest body)
(if (consp binder) (car binder) binder))
binders)))
`(progn
- (with-suppressed-warnings ((lexical ,@vars))
+ (org-with-suppressed-warnings ((lexical ,@vars))
,@(mapcar (lambda (var) `(defvar ,var)) vars))
(let* ,binders ,@body))))
^ permalink raw reply related [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-03-09 5:35 ` Kyle Meyer
@ 2021-03-09 14:09 ` Stefan Monnier
2021-03-10 4:16 ` Kyle Meyer
0 siblings, 1 reply; 22+ messages in thread
From: Stefan Monnier @ 2021-03-09 14:09 UTC (permalink / raw)
To: Kyle Meyer; +Cc: Marco Wahl, emacs-orgmode
Hi Kyle,
>> Subject: [PATCH] * lisp/org-agenda.el: Use lexical-binding
> [...]
>> + (pcase type
>> + ('agenda
>> + (org-agenda-list current-prefix-arg))
>
> Unfortunately Org's minimum Emacs version is still Emacs 24.3.
Sorry 'bout that. I keep forgetting about this detail of `pcase` past.
Any chance you could put this in the `Package-Requires:`?
>> + (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))
>
> ... I believe with-suppressed-warnings isn't available until Emacs 27.1,
> right?
Ooh, right, and that is not just a little detail, I very much know
about that. I don't have any excuse for this one (it's just
a careless copy&paste).
> Any objections to me squashing the below changes into your patch?
Of course not.
> +(if (fboundp 'with-suppressed-warnings) ; Introduced in Emacs 27.1.
> + (defalias 'org-with-suppressed-warnings 'with-suppressed-warnings)
> + (defmacro org-with-suppressed-warnings (_warnings &rest body)
> + (declare (debug (sexp &optional body)) (indent 1))
> + `(progn ,@body)))
Note that all the uses I introduced of `with-suppressed-warnings` only
wrap a very small amount of code, so you could also replace them with
`with-no-warnings` (added back in Emacs-22).
Stefan
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
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
0 siblings, 2 replies; 22+ messages in thread
From: Kyle Meyer @ 2021-03-10 4:16 UTC (permalink / raw)
To: Stefan Monnier; +Cc: Marco Wahl, emacs-orgmode
Stefan Monnier writes:
> Any chance you could put this in the `Package-Requires:`?
Sure, added (5263eff5a).
> Note that all the uses I introduced of `with-suppressed-warnings` only
> wrap a very small amount of code, so you could also replace them with
> `with-no-warnings` (added back in Emacs-22).
Good point. I've switched to using with-suppressed-warnings and applied
the patch to master (129c33ddd).
Thanks again.
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-03-10 4:16 ` Kyle Meyer
@ 2021-03-10 16:32 ` Stefan Monnier
2021-03-19 16:23 ` Greg Minshall
1 sibling, 0 replies; 22+ messages in thread
From: Stefan Monnier @ 2021-03-10 16:32 UTC (permalink / raw)
To: Kyle Meyer; +Cc: Marco Wahl, emacs-orgmode
Thanks.
So now, I'm just waiting for that code to make its way to Emacs's
`master` branch (which I guess first means to make its way to an Org
release, so I had better find something else to do in the mean time).
Stefan
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
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
1 sibling, 2 replies; 22+ messages in thread
From: Greg Minshall @ 2021-03-19 16:23 UTC (permalink / raw)
To: Kyle Meyer; +Cc: Marco Wahl, emacs-orgmode, Stefan Monnier
hi. i just upgraded to
: Org mode version 9.4.4 (9.4.4-27-gb712b9-elpa @ /home/minshall/.emacs.d/elpa/org-20210315/)
and, have also just started playing with
(org-babel-map-inline-src-blocks), the documentation for which says
----
During evaluation of BODY the following local variables
are set relative to the currently matched code block.
...
----
but, iiuc, that relies on dynamic binding. so, as =lexical-binding= is
=t=, i don't have access to those appealing variables.
am i missing something? or, is this a place where the "API" is no
longer compatible? should those variables somehow be passed as a
parameter (alist?) to =,@body=? or, (let ((lexical-binding nil)) ...)?
(if that would work.)
cheers, Greg
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-03-19 16:23 ` Greg Minshall
@ 2021-03-20 3:34 ` Greg Minshall
2021-03-20 4:48 ` Kyle Meyer
1 sibling, 0 replies; 22+ messages in thread
From: Greg Minshall @ 2021-03-20 3:34 UTC (permalink / raw)
To: Kyle Meyer, Marco Wahl, emacs-orgmode, Stefan Monnier
> but, iiuc, that relies on dynamic binding. so, as =lexical-binding= is
> =t=, i don't have access to those appealing variables.
from reading the elisp manual, it seems that one could define those
variables to be "special variables", and, iiuc, one can achieve this by
using a =defvar= without a value, previous to the =let= where values are
assigned. something like (for just full-block):
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index af2c9912e..a0528bb06 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1121,6 +1121,7 @@ end-body --------- point at the end of the body"
(while (re-search-forward org-babel-src-block-regexp nil t)
(when (org-babel-active-location-p)
(goto-char (match-beginning 0))
+ (defvar full-block)
(let ((full-block (match-string 0))
(beg-block (match-beginning 0))
(end-block (match-end 0))
i could do a patch in this style, for all these variables.
cheers, Greg
^ permalink raw reply related [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
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
1 sibling, 1 reply; 22+ messages in thread
From: Kyle Meyer @ 2021-03-20 4:48 UTC (permalink / raw)
To: Greg Minshall; +Cc: Marco Wahl, emacs-orgmode, Stefan Monnier
Greg Minshall writes:
> hi. i just upgraded to
> : Org mode version 9.4.4 (9.4.4-27-gb712b9-elpa @ /home/minshall/.emacs.d/elpa/org-20210315/)
>
> and, have also just started playing with
> (org-babel-map-inline-src-blocks), the documentation for which says
> ----
> During evaluation of BODY the following local variables
> are set relative to the currently matched code block.
> ...
> ----
Is there a specific error/misbehavior that you're seeing?
The patch in this thread switched only one file, lisp/org-agenda.el,
over to lexical binding. org-babel-map-inline-src-blocks is in ob-core,
and that file has used lexical binding since 6cefae163 (ob-core: Use
lexical binding, 2016-06-20).
> but, iiuc, that relies on dynamic binding. so, as =lexical-binding= is
> =t=, i don't have access to those appealing variables.
org-babel-map-inline-src-blocks is a macro, and these variables are
defined in its expansion. Try:
(pp-macroexpand-expression
'(org-babel-map-src-blocks nil
(message "%d %s %s" beg-block lang body)))
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-03-20 4:48 ` Kyle Meyer
@ 2021-03-20 5:33 ` Greg Minshall
2021-03-21 16:04 ` Kyle Meyer
0 siblings, 1 reply; 22+ messages in thread
From: Greg Minshall @ 2021-03-20 5:33 UTC (permalink / raw)
To: Kyle Meyer; +Cc: Marco Wahl, emacs-orgmode, Stefan Monnier
Kyle,
thanks. i see. i wondered why the talk was all about agendas.
since, in my (brand new, experimenting) use of
=org-babel-map-src-blocks=, i'm calling a function, and that function is
trying to de-reference, e.g., =beg-block=, i get an error.
it is (or does seem to be) the case that if the macro included all the
valueless =defvars=, a function called from it has access to all those.
i don't know if this would be a useful modification.
cheers, Greg
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-03-20 5:33 ` Greg Minshall
@ 2021-03-21 16:04 ` Kyle Meyer
2021-03-21 17:14 ` Greg Minshall
0 siblings, 1 reply; 22+ messages in thread
From: Kyle Meyer @ 2021-03-21 16:04 UTC (permalink / raw)
To: Greg Minshall; +Cc: Marco Wahl, emacs-orgmode, Stefan Monnier
Greg Minshall writes:
> Kyle,
>
> thanks. i see. i wondered why the talk was all about agendas.
>
> since, in my (brand new, experimenting) use of
> =org-babel-map-src-blocks=, i'm calling a function, and that function is
> trying to de-reference, e.g., =beg-block=, i get an error.
Thanks for the details.
> it is (or does seem to be) the case that if the macro included all the
> valueless =defvars=, a function called from it has access to all those.
> i don't know if this would be a useful modification.
Hmm, given that the lexical-binding change to ob-core was back in Org
9.0 (November 2016), it seems like dynamic scoping wasn't really being
relied on (or, if it was, downstream code has already been adjusted).
In my view it'd be better to stick with lexical scoping for these
variables, with callers explicitly passing the subset of needed
variables to the underlying function(s).
^ permalink raw reply [flat|nested] 22+ messages in thread
* Re: Using lexical-binding
2021-03-21 16:04 ` Kyle Meyer
@ 2021-03-21 17:14 ` Greg Minshall
0 siblings, 0 replies; 22+ messages in thread
From: Greg Minshall @ 2021-03-21 17:14 UTC (permalink / raw)
To: Kyle Meyer; +Cc: Marco Wahl, emacs-orgmode, Stefan Monnier
Kyle,
> Hmm, given that the lexical-binding change to ob-core was back in Org
> 9.0 (November 2016), it seems like dynamic scoping wasn't really being
> relied on (or, if it was, downstream code has already been adjusted).
> In my view it'd be better to stick with lexical scoping for these
> variables, with callers explicitly passing the subset of needed
> variables to the underlying function(s).
yes, that makes sense. thanks.
cheers, Greg
^ permalink raw reply [flat|nested] 22+ messages in thread
end of thread, other threads:[~2021-03-21 17:15 UTC | newest]
Thread overview: 22+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
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
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
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.