From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id WI2fDDNwNWDecgAA0tVLHw (envelope-from ) for ; Tue, 23 Feb 2021 21:14:27 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id sKxjCDNwNWDZeQAAB5/wlQ (envelope-from ) for ; Tue, 23 Feb 2021 21:14:27 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id D134D191B5 for ; Tue, 23 Feb 2021 22:14:25 +0100 (CET) Received: from localhost ([::1]:48434 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lEf0i-0001uL-4i for larch@yhetil.org; Tue, 23 Feb 2021 16:14:24 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:54698) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lEeyI-0000uI-Aj for emacs-orgmode@gnu.org; Tue, 23 Feb 2021 16:11:56 -0500 Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:52674) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lEeyB-000740-RB for emacs-orgmode@gnu.org; Tue, 23 Feb 2021 16:11:53 -0500 Received: from pmg2.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id D228A8090A; Tue, 23 Feb 2021 16:11:46 -0500 (EST) Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id C68BD80229; Tue, 23 Feb 2021 16:11:40 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1614114700; bh=ZYIsw3vL4vhw+bqdnb5MSxO/aPkEQNjZvHn3SEVQYnI=; h=From:To:Subject:Date:From; b=mBPYJPUohuO2qj77Cs65YoqVZU+BYdAq3X+hQ0GCL+j/MtyHB0KOD0zp/8u9fecEK gFdV+GKTpAhpkaRnc2qX5b+FUZmaYcuYSqi7cZGfhf6qVdPfcv2cOHSVchueLgYU5u jjFK4NyBtqw58YJ6Nlm+MG4+H/siTP+2NREvUiBrK9E/wPL/YSS/qHuB2ysQyx2xOt u6Zq8Vq03amjpgtDcyk1U0g/rMP/MH8RP+WfT2EsScTL/CKwDJ2ScQHVP0YNdWccQ/ SMZX/y37qul3W2+KJeEhl/Xtyp82x68oXGGDd0KMHQplhubFVOJlYbOQrPKJwwZ6TZ QFwsRrqChHe6A== Received: from alfajor (unknown [216.154.41.47]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 6B3FF12041A; Tue, 23 Feb 2021 16:11:40 -0500 (EST) From: Stefan Monnier To: emacs-orgmode@gnu.org Subject: Using lexical-binding Message-ID: Date: Tue, 23 Feb 2021 16:11:39 -0500 User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-SPAM-INFO: Spam detection results: 0 ALL_TRUSTED -1 Passed through trusted hosts only via SMTP AWL -0.089 Adjusted score from AWL reputation of From: address BAYES_00 -1.9 Bayes spam probability is 0 to 1% DKIM_SIGNED 0.1 Message has a DKIM or DK signature, not necessarily valid DKIM_VALID -0.1 Message has at least one valid DKIM or DK signature DKIM_VALID_AU -0.1 Message has a valid DKIM or DK signature from author's domain Received-SPF: pass client-ip=132.204.25.50; envelope-from=monnier@iro.umontreal.ca; helo=mailscanner.iro.umontreal.ca X-Spam_score_int: -42 X-Spam_score: -4.3 X-Spam_bar: ---- X-Spam_report: (-4.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Migadu-Flow: FLOW_IN X-Migadu-Spam-Score: -2.07 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=iro.umontreal.ca header.s=mail header.b=mBPYJPUo; dmarc=pass (policy=none) header.from=iro.umontreal.ca; spf=pass (aspmx1.migadu.com: domain of emacs-orgmode-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=emacs-orgmode-bounces@gnu.org X-Migadu-Queue-Id: D134D191B5 X-Spam-Score: -2.07 X-Migadu-Scanner: scn1.migadu.com X-TUID: Vysx5v1YOakZ --=-=-= Content-Type: text/plain 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. --=-=-= Content-Type: text/x-diff; charset=iso-8859-1 Content-Disposition: inline; filename=0001-org-agenda.el-First-attempt-at-using-lexical-binding.patch Content-Transfer-Encoding: quoted-printable >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 =20 +# Files generated during `make packages/org` in a clone of `elpa.git`. + +/org-pkg.el +/org-autoloads.el +/lisp/org-autoloads.el + # texi2pdf --tidy =20 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 =20 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)' =20 org-version.inc: org.texi @@ -88,8 +88,8 @@ ifneq ($(SERVERMK),) endif =20 %_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 "$(=3D iso-week 52)) - (1- year)) - ((and (=3D month 12) (<=3D iso-week 1)) - (1+ year)) - (t year))) + ;; (weekyear (cond ((and (=3D month 1) (>=3D iso-week 52)) + ;; (1- year)) + ;; ((and (=3D month 12) (<=3D iso-week 1)) + ;; (1+ year)) + ;; (t year))) (weekstring (if (=3D 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)) =20 (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 s= ubtree 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 s= ubtree 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-key= s 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)) lp= rops))) + (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)))) =20 ;;;###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 list= ed" (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"))))) =20 @@ -3374,7 +3400,7 @@ agenda-day The day in the agenda where this is list= ed" 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)))) =20 ;;;###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)) =20 ;;;###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-comm= ands)) - (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))))))) =20 @@ -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=3D "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=3D "ps" extension) - (require 'ps-print) - (ps-print-buffer-with-faces file) - (message "Postscript written to %s" file)) - ((string=3D "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=3D "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=3D "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-h= tmlize")) + (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=3D "ps" extension) + (require 'ps-print) + (ps-print-buffer-with-faces file) + (message "Postscript written to %s" file)) + ((string=3D "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=3D "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 t= he 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)))) =20 (defun org-agenda-mark-clocking-task () @@ -4030,10 +4069,10 @@ agenda display, configure `org-agenda-finalize-hook= '." =20 (defvar org-depend-tag-blocked) =20 -(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))))))) =20 (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) =20 +(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 retu= rns 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 comm= and." (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))))) =20 ;;;###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 para= m. (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 di= splay." (org-add-to-diary-list original-date "Org mode dummy" "" nil))))) =20 (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)) =20 (defvar org-diary-last-run-time nil) =20 @@ -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 e= ntry)) (when (> (- (float-time) org-agenda-last-marker-time) 5) @@ -5338,7 +5387,7 @@ function from a program - use `org-agenda-get-day-ent= ries' 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 str= ategy 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-d= eadlines', "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 e= ntry)) (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 arg= uments 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 e= ntry)) (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))) =20 -(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-consistenc= y-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 ha= s 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." =20 (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)) =20 + (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=3D 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." (>=3D (length category) org-prefix-category-max-length)) (setq category (substring category 0 (1- org-prefix-category-max-leng= th))))) ;; Evaluate the compiled format - (setq rtn (concat (eval formatter) txt)) + (setq rtn (concat (eval formatter t) txt)) =20 ;; 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-compile= d'." (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.]*\\)\\([ .;,:!?=3D|/<>]= ?\\)\\([cltseib]\\|(.+)\\)" s start) (setq var (or (cdr (assoc (match-string 4 s) @@ -6888,12 +6955,11 @@ and stored in the variable `org-prefix-format-compi= led'." (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-compi= led'." `(format ,s ,@vars)))))) =20 (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-strate= gy) - (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"))) =20 (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))))))) =20 ;;; Agenda restriction lock =20 @@ -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))) =20 (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-fil= ter) ""))) (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-fil= ter) ""))) (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', `yea= r'. 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." =20 (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)) =20 (defvar org-agenda-pre-follow-window-conf nil) @@ -8696,7 +8768,8 @@ When called with a prefix argument, include all archi= ve 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 arc= hive 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 archi= ve 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 archi= ve 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 archi= ve 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 archi= ve 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")))) =20 (defun org-agenda-goto (&optional highlight) @@ -8956,6 +9033,8 @@ Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-d= o-in-region'." (funcall-interactively #'org-agenda-archive-with 'org-archive-to-archive-sibling)) =20 +(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 buff= er." (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)) =20 +(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 no= de in the Org file." (org-move-to-column col) (org-agenda-mark-clocking-task))))) =20 -(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 n= ew 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 n= ew 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))) =20 -(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=20 + ((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))))) =20 (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"))))) =20 - (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))) =20 (?t @@ -10420,10 +10501,10 @@ The prefix arg is passed through to the command i= f 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)))))) =20 ((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)))))) =20 ((and (or ?s ?d) c) (let* ((schedule? (eq c ?s)) @@ -10457,13 +10538,13 @@ The prefix arg is passed through to the command i= f 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))))))) =20 (?S (unless (org-agenda-check-type nil 'agenda 'todo) @@ -10473,29 +10554,29 @@ The prefix arg is passed through to the command i= f 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 (=3D day-of-week 7) - (setq day-of-week 0))) - (cl-incf day-of-week) - (when (=3D 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 (=3D day-of-week 7) + (setq day-of-week 0))) + (cl-incf day-of-week) + (when (=3D 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)))))))) =20 (?f (setq cmd @@ -10582,7 +10663,7 @@ When the optional argument `backward' is non-nil, m= ove 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"))))) =20 (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"))) =20 @@ -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 nowhe= re." ,@body))) =20 (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))) =20 ;;;###autoload @@ -366,15 +366,17 @@ error when the user input is empty." (allow-empty? nil) (t (user-error "Empty input is not valid"))))) =20 +(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))) =20 (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))) =20 +(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=B2) space complexity, so you're usually better off = using +`cl-pushnew' (with a final `reverse' if you care about the order of elemen= ts)." + (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) =20 (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) =20 @@ -982,7 +1010,7 @@ IF WIDTH is nil and LINES is non-nil, the string is fo= rced 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 th= at was modified." string) =20 (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))))) --=20 2.30.0 --=-=-=--