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
From f10dc28a72c8c0fb179b0446b4869c71b24c4e52 Mon Sep 17 00:00:00 2001
From: Laurence Warne <laurencewa...@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
