[PATCH] Create commands for org-read-date-minibuffer-local-map

[PATCH] Create commands for org-read-date-minibuffer-local-map

[Laurence Warne]

[-- Attachment #1.1: Type: text/plain, Size: 400 bytes --]

Hi,

I have attached a small patch which switches out inline commands in
org-read-date-minibuffer-local-map for new analogous commands.

The intent is to aid documentation and user configuration, so the user gets
a nice description and source code when any corresponding key is looked up
via help, and can rebind it without copying the lambda themselves.

Any comments are welcome!

Thanks, Laurence

[-- Attachment #1.2: Type: text/html, Size: 535 bytes --]

[-- Attachment #2: 0001-Create-commands-for-org-read-date-minibuffer-local-m.patch --]
[-- Type: text/x-patch, Size: 10470 bytes --]

From f10dc28a72c8c0fb179b0446b4869c71b24c4e52 Mon Sep 17 00:00:00 2001
From: Laurence Warne <laurencewarne@gmail.com>
Date: Sun, 24 Mar 2024 15:10:25 +0000
Subject: [PATCH] Create commands for org-read-date-minibuffer-local-map

Create commands for org-read-date-minibuffer-local-map for use in
place of the inline lambda commands in order to aid user discoverability.

* org.el (org-calendar-goto-today-or-insert-dot)
(org-calendar-goto-today, org-calendar-backward-month)
(org-calendar-forward-month, org-calendar-backward-year)
(org-calendar-forward-year, org-calendar-backward-week)
(org-calendar-forward-week, org-calendar-backward-day)
(org-calendar-forward-day, org-calendar-view-entries)
(org-calendar-scroll-month-left, org-calendar-scroll-month-right)
(org-calendar-scroll-three-months-left)
(org-calendar-scroll-three-months-right): New functions
* org-keys.el (org-read-date-minibuffer-local-map): Use new functions
for keybindings instead of inline functions
---
 lisp/org-keys.el | 99 +++++++++++++++++-------------------------------
 lisp/org.el      | 86 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 120 insertions(+), 65 deletions(-)

diff --git a/lisp/org-keys.el b/lisp/org-keys.el
index eb5b98726..50e05efa1 100644
--- a/lisp/org-keys.el
+++ b/lisp/org-keys.el
@@ -90,6 +90,21 @@
 (declare-function org-end-of-line "org" (&optional n))
 (declare-function org-entry-put "org" (pom property value))
 (declare-function org-eval-in-calendar "org" (form &optional keepdate))
+(declare-function org-calendar-goto-today-or-insert-dot "org" ())
+(declare-function org-calendar-goto-today "org" ())
+(declare-function org-calendar-backward-month "org" ())
+(declare-function org-calendar-forward-month "org" ())
+(declare-function org-calendar-backward-year "org" ())
+(declare-function org-calendar-forward-year "org" ())
+(declare-function org-calendar-backward-week "org" ())
+(declare-function org-calendar-forward-week "org" ())
+(declare-function org-calendar-backward-day "org" ())
+(declare-function org-calendar-forward-day "org" ())
+(declare-function org-calendar-view-entries "org" ())
+(declare-function org-calendar-scroll-month-left "org" ())
+(declare-function org-calendar-scroll-month-right "org" ())
+(declare-function org-calendar-scroll-three-months-left "org" ())
+(declare-function org-calendar-scroll-three-months-right "org" ())
 (declare-function org-evaluate-time-range "org" (&optional to-buffer))
 (declare-function org-export-dispatch "org" (&optional arg))
 (declare-function org-feed-goto-inbox "org" (feed))
@@ -349,71 +364,25 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
 (defvar org-read-date-minibuffer-local-map
   (let* ((map (make-sparse-keymap)))
     (set-keymap-parent map minibuffer-local-map)
-    (org-defkey map (kbd ".")
-                (lambda () (interactive)
-		  ;; Are we at the beginning of the prompt?
-		  (if (looking-back "^[^:]+: "
-				    (let ((inhibit-field-text-motion t))
-				      (line-beginning-position)))
-		      (org-eval-in-calendar '(calendar-goto-today))
-		    (insert "."))))
-    (org-defkey map (kbd "C-.")
-                (lambda () (interactive)
-		  (org-eval-in-calendar '(calendar-goto-today))))
-    (org-defkey map (kbd "M-S-<left>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-backward-month 1))))
-    (org-defkey map (kbd "ESC S-<left>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-backward-month 1))))
-    (org-defkey map (kbd "M-S-<right>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-forward-month 1))))
-    (org-defkey map (kbd "ESC S-<right>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-forward-month 1))))
-    (org-defkey map (kbd "M-S-<up>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-backward-year 1))))
-    (org-defkey map (kbd "ESC S-<up>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-backward-year 1))))
-    (org-defkey map (kbd "M-S-<down>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-forward-year 1))))
-    (org-defkey map (kbd "ESC S-<down>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-forward-year 1))))
-    (org-defkey map (kbd "S-<up>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-backward-week 1))))
-    (org-defkey map (kbd "S-<down>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-forward-week 1))))
-    (org-defkey map (kbd "S-<left>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-backward-day 1))))
-    (org-defkey map (kbd "S-<right>")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-forward-day 1))))
-    (org-defkey map (kbd "!")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(diary-view-entries))
-                  (message "")))
-    (org-defkey map (kbd ">")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-scroll-left 1))))
-    (org-defkey map (kbd "<")
-                (lambda () (interactive)
-                  (org-eval-in-calendar '(calendar-scroll-right 1))))
-    (org-defkey map (kbd "C-v")
-                (lambda () (interactive)
-                  (org-eval-in-calendar
-                   '(calendar-scroll-left-three-months 1))))
-    (org-defkey map (kbd "M-v")
-                (lambda () (interactive)
-                  (org-eval-in-calendar
-                   '(calendar-scroll-right-three-months 1))))
+    (org-defkey map (kbd ".") #'org-calendar-goto-today-or-insert-dot)
+    (org-defkey map (kbd "C-.") #'org-calendar-goto-today)
+    (org-defkey map (kbd "M-S-<left>") #'org-calendar-backward-month)
+    (org-defkey map (kbd "ESC S-<left>") #'org-calendar-backward-month)
+    (org-defkey map (kbd "M-S-<right>") #'org-calendar-forward-month)
+    (org-defkey map (kbd "ESC S-<right>") #'org-calendar-forward-month)
+    (org-defkey map (kbd "M-S-<up>") #'org-calendar-backward-year)
+    (org-defkey map (kbd "ESC S-<up>") #'org-calendar-backward-year)
+    (org-defkey map (kbd "M-S-<down>") #'org-calendar-forward-year)
+    (org-defkey map (kbd "ESC S-<down>") #'org-calendar-forward-year)
+    (org-defkey map (kbd "S-<up>") #'org-calendar-backward-week)
+    (org-defkey map (kbd "S-<down>") #'org-calendar-forward-week)
+    (org-defkey map (kbd "S-<left>") #'org-calendar-backward-day)
+    (org-defkey map (kbd "S-<right>") #'org-calendar-forward-day)
+    (org-defkey map (kbd "!") #'org-calendar-view-entries)
+    (org-defkey map (kbd ">") #'org-calendar-scroll-month-left)
+    (org-defkey map (kbd "<") #'org-calendar-scroll-month-right)
+    (org-defkey map (kbd "C-v") #'org-calendar-scroll-three-months-left)
+    (org-defkey map (kbd "M-v") #'org-calendar-scroll-three-months-right)
     map)
   "Keymap for minibuffer commands when using `org-read-date'.")
 
diff --git a/lisp/org.el b/lisp/org.el
index 909ce0024..074f846f0 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -14419,6 +14419,92 @@ Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date."
     (select-window sw)
     (select-frame-set-input-focus sf)))
 
+(defun org-calendar-goto-today-or-insert-dot ()
+  "Go to the current date, or insert a dot.
+
+If at the beginning of the prompt, behave as `org-calendar-goto-today' else
+insert \".\"."
+  (interactive)
+  ;; Are we at the beginning of the prompt?
+  (if (looking-back "^[^:]+: "
+		    (let ((inhibit-field-text-motion t))
+		      (line-beginning-position)))
+      (org-eval-in-calendar '(calendar-goto-today))
+    (insert ".")))
+
+(defun org-calendar-goto-today ()
+  "Reposition the calendar window so the current date is visible."
+  (interactive)
+  (org-eval-in-calendar '(calendar-goto-today)))
+
+(defun org-calendar-backward-month ()
+  "Move the cursor backward by one month."
+  (interactive)
+  (org-eval-in-calendar '(calendar-backward-month 1)))
+
+(defun org-calendar-forward-month ()
+  "Move the cursor forward by one month."
+  (interactive)
+  (org-eval-in-calendar '(calendar-forward-month 1)))
+
+(defun org-calendar-backward-year ()
+  "Move the cursor backward by one year."
+  (interactive)
+  (org-eval-in-calendar '(calendar-backward-year 1)))
+
+(defun org-calendar-forward-year ()
+  "Move the cursor forward by one year."
+  (interactive)
+  (org-eval-in-calendar '(calendar-forward-year 1)))
+
+(defun org-calendar-backward-week ()
+  "Move the cursor backward by one week."
+  (interactive)
+  (org-eval-in-calendar '(calendar-backward-week 1)))
+
+(defun org-calendar-forward-week ()
+  "Move the cursor forward by one week."
+  (interactive)
+  (org-eval-in-calendar '(calendar-forward-week 1)))
+
+(defun org-calendar-backward-day ()
+  "Move the cursor backward by one day."
+  (interactive)
+  (org-eval-in-calendar '(calendar-backward-day 1)))
+
+(defun org-calendar-forward-day ()
+  "Move the cursor forward by one day."
+  (interactive)
+  (org-eval-in-calendar '(calendar-forward-day 1)))
+
+(defun org-calendar-view-entries ()
+  "Prepare and display a buffer with diary entries."
+  (interactive)
+  (org-eval-in-calendar '(diary-view-entries))
+  (message ""))
+
+(defun org-calendar-scroll-month-left ()
+  "Scroll the displayed calendar left by one month."
+  (interactive)
+  (org-eval-in-calendar '(calendar-scroll-left 1)))
+
+(defun org-calendar-scroll-month-right ()
+  "Scroll the displayed calendar right by one month."
+  (interactive)
+  (org-eval-in-calendar '(calendar-scroll-right 1)))
+
+(defun org-calendar-scroll-three-months-left ()
+  "Scroll the displayed calendar left by three months."
+  (interactive)
+  (org-eval-in-calendar
+   '(calendar-scroll-left-three-months 1)))
+
+(defun org-calendar-scroll-three-months-right ()
+  "Scroll the displayed calendar right by three months."
+  (interactive)
+  (org-eval-in-calendar
+   '(calendar-scroll-right-three-months 1)))
+
 (defun org-calendar-select ()
   "Return to `org-read-date' with the date currently selected.
 This is used by `org-read-date' in a temporary keymap for the calendar buffer."
-- 
2.39.2

Re: [PATCH] Create commands for org-read-date-minibuffer-local-map

[Ihor Radchenko]

Laurence Warne <laurencewarne@gmail.com> writes:

> I have attached a small patch which switches out inline commands in
> org-read-date-minibuffer-local-map for new analogous commands.
>
> The intent is to aid documentation and user configuration, so the user gets
> a nice description and source code when any corresponding key is looked up
> via help, and can rebind it without copying the lambda themselves.

Thank you!
Applied, onto main; with minor amendments to the commit message format.
I also added TINYCHANGE cookie as I do not see in our records that you
have FSF copyright assignment (see
https://orgmode.org/worg/org-contribute.html#first-patch)
https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=990b89d32

You are also now listed as an Org mode contributor.
https://git.sr.ht/~bzg/worg/commit/fbc3129d

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: [PATCH] Create commands for org-read-date-minibuffer-local-map

[Laurence Warne]

[-- Attachment #1: Type: text/plain, Size: 520 bytes --]

> You are also now listed as an Org mode contributor.
> https://git.sr.ht/~bzg/worg/commit/fbc3129d
<https://git.sr.ht/~bzg/worg/commit/fbc3129d>

Nice, thanks!

> Applied, onto main; with minor amendments to the commit message format.
> I also added TINYCHANGE cookie as I do not see in our records that you
> have FSF copyright assignment

I believe I have signed it previously in order to contribute to Emacs core
and ELPA packages, is that not applicable here?  Apologies - I am not too
familiar with the process (:

[-- Attachment #2: Type: text/html, Size: 1074 bytes --]

Re: [PATCH] Create commands for org-read-date-minibuffer-local-map

[Ihor Radchenko]

Laurence Warne <laurencewarne@gmail.com> writes:

>> Applied, onto main; with minor amendments to the commit message format.
>> I also added TINYCHANGE cookie as I do not see in our records that you
>> have FSF copyright assignment
>
> I believe I have signed it previously in order to contribute to Emacs core
> and ELPA packages, is that not applicable here?  Apologies - I am not too
> familiar with the process (:

It is applicable. It is just that you were not listed in our
housekeeping list at https://orgmode.org/worg/contributors.html.

Bastien, may you please check FSF records?

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: [PATCH] Create commands for org-read-date-minibuffer-local-map

[Bastien Guerry]

Ihor Radchenko <yantar92@posteo.net> writes:

> Bastien, may you please check FSF records?

Yes, Laurence copyright status is okay.

-- 
 Bastien Guerry

Re: [PATCH] Create commands for org-read-date-minibuffer-local-map

[Ihor Radchenko]

Bastien Guerry <bzg@gnu.org> writes:

> Ihor Radchenko <yantar92@posteo.net> writes:
>
>> Bastien, may you please check FSF records?
>
> Yes, Laurence copyright status is okay.

Updated our records.
https://git.sr.ht/~bzg/worg/commit/aaa9cd38

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: [PATCH] Create commands for org-read-date-minibuffer-local-map

[Laurence Warne]

[-- Attachment #1: Type: text/plain, Size: 15 bytes --]

Great, thanks!

[-- Attachment #2: Type: text/html, Size: 51 bytes --]