From d34f993044ee817f7ee18342bcc686285329bea5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier 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 "$(= 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 ")) - (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 ")) + (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