haji-ali/org-minical.el

## org-minical.el
;;; org-minical.el --- Org Date picker in minibuffer  -*- lexical-binding: t; -*-

;; Copyright (C) 2023, Al Haji-Ali

;; Author: Al Haji-Ali <abdo.haji.ali at gmail.com>
;; Created: Author
;; Version: 0.0.1
;; Package-Requires: ((emacs "28.1"))
;; Keywords: calendar

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;;
;;; Commentary:
;;
;; This package provides `org-minical-read-date' which is an advice around
;; `org-read-date' to show the calendar in the minibuffer whenever
;; `org-read-date-popup-calendar' is equal to 'minibuffer.
;;
;;; Code:
(require 'calendar)
(require 'org-macs)

;; dynamically scoped parameter from org
(defvar org-minical-exit-on-click nil
  "Non-nil causes clicks on calendar to exit minibuffer.")
(defvar org-minical--minibuffer-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-minical--eval-in-calendar '(calendar-goto-today))
                    (insert "."))))
    (org-defkey map (kbd "C-.")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-goto-today))))
    (org-defkey map (kbd "M-S-<left>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-backward-month 1))))
    (org-defkey map (kbd "ESC S-<left>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-backward-month 1))))
    (org-defkey map (kbd "M-S-<right>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-forward-month 1))))
    (org-defkey map (kbd "ESC S-<right>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-forward-month 1))))
    (org-defkey map (kbd "M-S-<up>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-backward-year 1))))
    (org-defkey map (kbd "ESC S-<up>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-backward-year 1))))
    (org-defkey map (kbd "M-S-<down>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-forward-year 1))))
    (org-defkey map (kbd "ESC S-<down>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-forward-year 1))))
    (org-defkey map (kbd "S-<up>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-backward-week 1))))
    (org-defkey map (kbd "S-<down>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-forward-week 1))))
    (org-defkey map (kbd "S-<left>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-backward-day 1))))
    (org-defkey map (kbd "S-<right>")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(calendar-forward-day 1))))
    (org-defkey map (kbd "!")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar '(diary-view-entries))
                  (message "")))
    (org-defkey map (kbd ">")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar
                   '(org-minical--calendar-scroll 1))))
    (org-defkey map (kbd "<")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar
                   '(org-minical--calendar-scroll -1))))
    (org-defkey map (kbd "C-v")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar
                   '(org-minical--calendar-scroll 3))))
    (org-defkey map (kbd "M-v")
                (lambda () (interactive)
                  (org-minical--eval-in-calendar
                   '(org-minical--calendar-scroll -3))))
    map)
  "Keymap for minibuffer commands when using `org-read-date'.
Modified from `org-read-date-minibuffer-local-map' but uses
custom commands that do not assume a displayed calendar window.")

(defvar org-minical--candidates-ov nil)

;; Org dynamically scoped variables
(defvar org-plain-time-of-day-regexp)
(defvar org-overriding-default-time nil)
(defvar org-read-date-overlay nil)
(defvar org-read-date-history nil)
(defvar org-read-date-analyze-futurep nil)
(defvar org-read-date-analyze-forced-year nil)
(defvar org-read-date-inactive)
(defvar org-def)
(defvar org-defdecode)
(defvar org-with-time)
(defvar org-time-was-given)
(defvar org-end-time-was-given)

;; Calendar dynamically scoped variables
(defvar displayed-month)
(defvar displayed-year)

(defun org-minical-mouse--candidate-map (pos)
  "Return keymap for date at POS."
  (define-keymap
    "<mouse-1>"
    (lambda nil
      (interactive)
      (org-minical--eval-in-calendar
       `(goto-char ,pos))
      (when org-minical-exit-on-click
        (exit-minibuffer)))))

(defun org-minical--get-calendar-string ()
  "Get string in calendar buffer, ready for the minibuffer."
  (let* ((buffer calendar-buffer)
         (object (with-current-buffer buffer
                   (buffer-string))))
    (save-excursion
      ;; Add all face properties on overlays in BUFFER to text properties in OBJECT.
      (let ((overlays (with-current-buffer buffer
                        (overlays-in (point-min) (point-max)))))
        (dolist (overlay overlays)
          (when (overlay-get overlay 'face)
            (let* ((start (overlay-start overlay))
                   (end (overlay-end overlay))
                   (face (overlay-get overlay 'face)))
              (put-text-property (1- start) (1- end) 'face face object)))))

      ;; Convert all 'font-lock-face in OBJECT into 'face properties.
      (let ((pos 0)
            (next-pos))
        (while (setq next-pos (next-single-property-change pos
                                                           'font-lock-face
                                                           object))
          (when-let (face (get-text-property pos 'font-lock-face object))
            (put-text-property pos next-pos 'face face object))
          (setq pos next-pos)))

      ;; Add a keymap to all string with a 'mouse-face
      (let ((pos 0) next-pos)
        (while (setq next-pos (next-single-property-change pos
                                                           'mouse-face
                                                           object))
          (when (get-text-property pos 'mouse-face object)
            (put-text-property pos next-pos
                               'keymap
                               (org-minical-mouse--candidate-map (+ pos 2))
                               object))
          (setq pos next-pos))))
    object))

(cl-defgeneric org-minical--resize-minibuffer (height)
  "Resize active minibuffer window to HEIGHT.
Slightly modified from `vertico--resize-window'"
  (setq-local truncate-lines (< (point) (* 0.8
                                           (cl-loop for win in
                                                    (get-buffer-window-list)
                                                    minimize (window-width win))))
              resize-mini-windows 'grow-only
              max-mini-window-height 1.0)
  (unless (frame-root-window-p (active-minibuffer-window))
    (let ((dp (- (max (cdr (window-text-pixel-size))
                      (* (default-line-height) (1+ height)))
                 (window-pixel-height))))
      (when (or (and (> dp 0) (/= height 0))
                (and (< dp 0) (eq resize-mini-windows t)))
        (window-resize nil dp nil nil 'pixelwise)))))

(defun org-minical--calendar-scroll (&optional arg)
  "Scroll the displayed calendar left by ARG months.
If ARG is negative the calendar is scrolled right.  Maintains the relative
position of the cursor with respect to the calendar as well as
possible.
Modified from `calendar-scroll-left' to not select the calendar window
\(in case the buffer is invisible)."
  (unless arg (setq arg 1))
  ;; The following line is deleted form calendar-scroll-left
  ;; (if (setq event (event-start event)) (select-window (posn-window event)))
  (calendar-cursor-to-nearest-date)
  (unless (zerop arg)
    (let ((old-date (calendar-cursor-to-date))
          (today (calendar-current-date))
          (month displayed-month)
          (year displayed-year))
      (calendar-increment-month month year arg)
      (calendar-generate-window month year)
      (calendar-cursor-to-visible-date
       (cond
        ((calendar-date-is-visible-p old-date) old-date)
        ((calendar-date-is-visible-p today) today)
        (t (list month 1 year))))))
  (run-hooks 'calendar-move-hook))

(defun org-minical--eval-in-calendar (form &optional keepdate)
  "Eval FORM in the calendar buffer and return to current buffer.
Unless KEEPDATE is non-nil, update prompt to the cursor date.
Modified from `org-eval-in-calendar'."
  (let (date time)
    (prog1
        (with-current-buffer calendar-buffer
          (prog1 (eval form t)
            (setq date (calendar-cursor-to-date))
            (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))))
      (when (and (not keepdate) date)
        (setq
         time (org-encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))
        ;; Should be in mini-buffer
        (let* ((ans (buffer-substring (line-beginning-position)
                                      (point-max)))
               (org-end-time-was-given nil)
               (f (org-read-date-analyze ans org-def org-defdecode))
               (txt-prompt (format-time-string "%Y-%m-%d" time)))
          ;; Change prompt
          (when (or org-with-time
                    (and (boundp 'org-time-was-given)
                         org-time-was-given))
            (setq
             txt-prompt
             (concat
              txt-prompt
              (format-time-string " %H:%M" (org-encode-time f)))))
          (when (and org-end-time-was-given
                     (string-match org-plain-time-of-day-regexp txt-prompt))
            (setq txt-prompt
                  (concat (substring txt-prompt 0 (match-end 0)) "-"
                          org-end-time-was-given
                          (substring txt-prompt (match-end 0)))))
          ;; Update prompt
          (delete-region (line-beginning-position) (point-max))
          (insert txt-prompt))))))

(defun org-minical--read-date-display ()
  "Call `org-read-date-display' and update the calendar to match the date.
Should be changed to an advice."
  (when org-read-date-display-live
    (when org-read-date-overlay
      (delete-overlay org-read-date-overlay))
    (when (minibufferp (current-buffer))
      (save-excursion
        (end-of-line 1)
        (while (not (equal (buffer-substring
                            (max (point-min) (- (point) 4)) (point))
                           "    "))
          (insert " ")))
      (let* ((ans (buffer-substring (line-beginning-position)
                                            (point-max)))
             (org-end-time-was-given nil)
             (f (org-read-date-analyze ans org-def org-defdecode))
             (fmt (org-time-stamp-format
                   (or org-with-time
                       (and (boundp 'org-time-was-given) org-time-was-given))
                   org-read-date-inactive
                   org-display-custom-times))
             (txt (format-time-string fmt (org-encode-time f)))
             (txt (concat "=> " txt)))
        (when (and org-end-time-was-given
                   (string-match org-plain-time-of-day-regexp txt))
          (setq txt (concat (substring txt 0 (match-end 0)) "-"
                            org-end-time-was-given
                            (substring txt (match-end 0)))))
        (when org-read-date-analyze-futurep
          (setq txt (concat txt " (=>F)")))
        (setq org-read-date-overlay
              (make-overlay (1- (line-end-position)) (line-end-position)))
        (org-overlay-display org-read-date-overlay txt 'secondary-selection)

        (org-minical--eval-in-calendar
         `(calendar-goto-date
           (list ,(decoded-time-month f)
                 ,(decoded-time-day f)
                 ,(decoded-time-year f)))
         t)))))

(defun org-minical@org-read-date (old-fn
                                  &optional with-time to-time from-string prompt
                                  default-time default-input inactive)
  "Read a date, possibly a time, and make things smooth for the user.
Same as `org-read-date' but displays everything in the minibuffer"
  (if (or from-string
          (not (eq org-read-date-popup-calendar 'minibuffer)))
      (funcall old-fn with-time to-time from-string prompt
               default-time default-input inactive)
    (require 'parse-time)
    (let* ((org-with-time with-time)
           (org-timestamp-rounding-minutes
            (if (equal org-with-time '(16))
                '(0 0)
              org-timestamp-rounding-minutes))
           (org-def (or org-overriding-default-time default-time
                        (org-current-time)))
           (org-defdecode (decode-time org-def))
           (mouse-autoselect-window nil)	; Don't let the mouse jump
           (calendar-move-hook nil)
           (calendar-view-diary-initially-flag nil)
           (calendar-view-holidays-initially-flag nil)
           org-ans0)
      ;; Rationalize `org-def' and `org-defdecode', if required.
      ;; Only consider `org-extend-today-until' when explicit reference
      ;; time is not given.
      (when (and (not default-time)
                 (not org-overriding-default-time)
                 (< (nth 2 org-defdecode) org-extend-today-until))
        (setf (nth 2 org-defdecode) -1)
        (setf (nth 1 org-defdecode) 59)
        (setq org-def (org-encode-time org-defdecode))
        (setq org-defdecode (decode-time org-def)))
      (let* ((timestr (format-time-string
                       (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d")
                       org-def))
             (prompt (concat (if prompt (concat prompt " ") "")
                             (format "Date+time [%s]: " timestr))))
        (save-excursion
          (calendar-basic-setup nil t))
        (minibuffer-with-setup-hook
            (lambda ()
              (setq-local scroll-margin 0
                          completion-auto-help nil
                          completion-show-inline-help nil
                          org-minical--candidates-ov
                          (make-overlay (point-max) (point-max) nil t t))
              (setq-local
               mwheel-scroll-up-function
               (lambda (n)
                 (org-minical--eval-in-calendar
                  `(org-minical--calendar-scroll ,(- n))))
               mwheel-scroll-down-function
               (lambda (n)
                 (org-minical--eval-in-calendar
                  `(org-minical--calendar-scroll ,n))))
              (add-hook 'post-command-hook
                        (lambda ()
                          ;; First update the prompt display
                          (org-minical--read-date-display)
                          ;; Then update the overlay
                          (when org-minical--candidates-ov
                            (let ((lines (org-minical--get-calendar-string))
                                  ;; Overlays affect point position and undo
                                  ;; list!
                                  (buffer-undo-list t))
                              (move-overlay org-minical--candidates-ov
                                            (point-max) (point-max))
                              (overlay-put org-minical--candidates-ov
                                           'after-string
                                           (concat #(" " 0 1 (cursor t))
                                                   (and lines "\n") lines))
                              (org-minical--resize-minibuffer
                               (length (split-string lines "\n"))))))
                        nil
                        'local))
          (unwind-protect
              (with-current-buffer calendar-buffer
                (calendar-forward-day (- (time-to-days org-def)
                                         (calendar-absolute-from-gregorian
                                          (calendar-current-date))))
                (org-minical--eval-in-calendar nil t)
                (let* ((minibuffer-local-map
                        (copy-keymap org-minical--minibuffer-map)))
                  (unwind-protect
                      (progn
                        (setq org-read-date-inactive inactive)
                        (setq org-ans0
                              (read-string prompt
                                           default-input
                                           'org-read-date-history
                                           nil)))
                    ;; Delete overlay from calendar buffer
                    (delete-overlay org-date-ovl)
                    (when org-read-date-overlay
                      (delete-overlay org-read-date-overlay)
                      (setq org-read-date-overlay nil))))))))
      ;; Call `org-read-date' with the answer to parse it
      (funcall old-fn with-time to-time org-ans0 nil
               default-time default-input inactive))))

(advice-add #'org-read-date :around #'org-minical@org-read-date)

(provide 'org-minical)

;;; org-minical.el ends here
	;;; org-minical.el --- Org Date picker in minibuffer -- lexical-binding: t; --

	;; Copyright (C) 2023, Al Haji-Ali

	;; Author: Al Haji-Ali <abdo.haji.ali at gmail.com>
	;; Created: Author
	;; Version: 0.0.1
	;; Package-Requires: ((emacs "28.1"))
	;; Keywords: calendar

	;; This program is free software; you can redistribute it and/or modify
	;; it under the terms of the GNU General Public License as published by
	;; the Free Software Foundation, either version 3 of the License, or
	;; (at your option) any later version.

	;; This program is distributed in the hope that it will be useful,
	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	;; GNU General Public License for more details.

	;; You should have received a copy of the GNU General Public License
	;; along with this program. If not, see <http://www.gnu.org/licenses/>.
	;;
	;;
	;;; Commentary:
	;;
	;; This package provides `org-minical-read-date' which is an advice around
	;; `org-read-date' to show the calendar in the minibuffer whenever
	;; `org-read-date-popup-calendar' is equal to 'minibuffer.
	;;
	;;; Code:
	(require 'calendar)
	(require 'org-macs)

	;; dynamically scoped parameter from org
	(defvar org-minical-exit-on-click nil
	"Non-nil causes clicks on calendar to exit minibuffer.")
	(defvar org-minical--minibuffer-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-minical--eval-in-calendar '(calendar-goto-today))
	(insert "."))))
	(org-defkey map (kbd "C-.")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-goto-today))))
	(org-defkey map (kbd "M-S-<left>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-backward-month 1))))
	(org-defkey map (kbd "ESC S-<left>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-backward-month 1))))
	(org-defkey map (kbd "M-S-<right>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-forward-month 1))))
	(org-defkey map (kbd "ESC S-<right>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-forward-month 1))))
	(org-defkey map (kbd "M-S-<up>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-backward-year 1))))
	(org-defkey map (kbd "ESC S-<up>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-backward-year 1))))
	(org-defkey map (kbd "M-S-<down>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-forward-year 1))))
	(org-defkey map (kbd "ESC S-<down>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-forward-year 1))))
	(org-defkey map (kbd "S-<up>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-backward-week 1))))
	(org-defkey map (kbd "S-<down>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-forward-week 1))))
	(org-defkey map (kbd "S-<left>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-backward-day 1))))
	(org-defkey map (kbd "S-<right>")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(calendar-forward-day 1))))
	(org-defkey map (kbd "!")
	(lambda () (interactive)
	(org-minical--eval-in-calendar '(diary-view-entries))
	(message "")))
	(org-defkey map (kbd ">")
	(lambda () (interactive)
	(org-minical--eval-in-calendar
	'(org-minical--calendar-scroll 1))))
	(org-defkey map (kbd "<")
	(lambda () (interactive)
	(org-minical--eval-in-calendar
	'(org-minical--calendar-scroll -1))))
	(org-defkey map (kbd "C-v")
	(lambda () (interactive)
	(org-minical--eval-in-calendar
	'(org-minical--calendar-scroll 3))))
	(org-defkey map (kbd "M-v")
	(lambda () (interactive)
	(org-minical--eval-in-calendar
	'(org-minical--calendar-scroll -3))))
	map)
	"Keymap for minibuffer commands when using `org-read-date'.
	Modified from `org-read-date-minibuffer-local-map' but uses
	custom commands that do not assume a displayed calendar window.")

	(defvar org-minical--candidates-ov nil)

	;; Org dynamically scoped variables
	(defvar org-plain-time-of-day-regexp)
	(defvar org-overriding-default-time nil)
	(defvar org-read-date-overlay nil)
	(defvar org-read-date-history nil)
	(defvar org-read-date-analyze-futurep nil)
	(defvar org-read-date-analyze-forced-year nil)
	(defvar org-read-date-inactive)
	(defvar org-def)
	(defvar org-defdecode)
	(defvar org-with-time)
	(defvar org-time-was-given)
	(defvar org-end-time-was-given)

	;; Calendar dynamically scoped variables
	(defvar displayed-month)
	(defvar displayed-year)

	(defun org-minical-mouse--candidate-map (pos)
	"Return keymap for date at POS."
	(define-keymap
	"<mouse-1>"
	(lambda nil
	(interactive)
	(org-minical--eval-in-calendar
	`(goto-char ,pos))
	(when org-minical-exit-on-click
	(exit-minibuffer)))))

	(defun org-minical--get-calendar-string ()
	"Get string in calendar buffer, ready for the minibuffer."
	(let* ((buffer calendar-buffer)
	(object (with-current-buffer buffer
	(buffer-string))))
	(save-excursion
	;; Add all face properties on overlays in BUFFER to text properties in OBJECT.
	(let ((overlays (with-current-buffer buffer
	(overlays-in (point-min) (point-max)))))
	(dolist (overlay overlays)
	(when (overlay-get overlay 'face)
	(let* ((start (overlay-start overlay))
	(end (overlay-end overlay))
	(face (overlay-get overlay 'face)))
	(put-text-property (1- start) (1- end) 'face face object)))))

	;; Convert all 'font-lock-face in OBJECT into 'face properties.
	(let ((pos 0)
	(next-pos))
	(while (setq next-pos (next-single-property-change pos
	'font-lock-face
	object))
	(when-let (face (get-text-property pos 'font-lock-face object))
	(put-text-property pos next-pos 'face face object))
	(setq pos next-pos)))

	;; Add a keymap to all string with a 'mouse-face
	(let ((pos 0) next-pos)
	(while (setq next-pos (next-single-property-change pos
	'mouse-face
	object))
	(when (get-text-property pos 'mouse-face object)
	(put-text-property pos next-pos
	'keymap
	(org-minical-mouse--candidate-map (+ pos 2))
	object))
	(setq pos next-pos))))
	object))

	(cl-defgeneric org-minical--resize-minibuffer (height)
	"Resize active minibuffer window to HEIGHT.
	Slightly modified from `vertico--resize-window'"
	(setq-local truncate-lines (< (point) (* 0.8
	(cl-loop for win in
	(get-buffer-window-list)
	minimize (window-width win))))
	resize-mini-windows 'grow-only
	max-mini-window-height 1.0)
	(unless (frame-root-window-p (active-minibuffer-window))
	(let ((dp (- (max (cdr (window-text-pixel-size))
	(* (default-line-height) (1+ height)))
	(window-pixel-height))))
	(when (or (and (> dp 0) (/= height 0))
	(and (< dp 0) (eq resize-mini-windows t)))
	(window-resize nil dp nil nil 'pixelwise)))))

	(defun org-minical--calendar-scroll (&optional arg)
	"Scroll the displayed calendar left by ARG months.
	If ARG is negative the calendar is scrolled right. Maintains the relative
	position of the cursor with respect to the calendar as well as
	possible.
	Modified from `calendar-scroll-left' to not select the calendar window
	\(in case the buffer is invisible)."
	(unless arg (setq arg 1))
	;; The following line is deleted form calendar-scroll-left
	;; (if (setq event (event-start event)) (select-window (posn-window event)))
	(calendar-cursor-to-nearest-date)
	(unless (zerop arg)
	(let ((old-date (calendar-cursor-to-date))
	(today (calendar-current-date))
	(month displayed-month)
	(year displayed-year))
	(calendar-increment-month month year arg)
	(calendar-generate-window month year)
	(calendar-cursor-to-visible-date
	(cond
	((calendar-date-is-visible-p old-date) old-date)
	((calendar-date-is-visible-p today) today)
	(t (list month 1 year))))))
	(run-hooks 'calendar-move-hook))

	(defun org-minical--eval-in-calendar (form &optional keepdate)
	"Eval FORM in the calendar buffer and return to current buffer.
	Unless KEEPDATE is non-nil, update prompt to the cursor date.
	Modified from `org-eval-in-calendar'."
	(let (date time)
	(prog1
	(with-current-buffer calendar-buffer
	(prog1 (eval form t)
	(setq date (calendar-cursor-to-date))
	(move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))))
	(when (and (not keepdate) date)
	(setq
	time (org-encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))
	;; Should be in mini-buffer
	(let* ((ans (buffer-substring (line-beginning-position)
	(point-max)))
	(org-end-time-was-given nil)
	(f (org-read-date-analyze ans org-def org-defdecode))
	(txt-prompt (format-time-string "%Y-%m-%d" time)))
	;; Change prompt
	(when (or org-with-time
	(and (boundp 'org-time-was-given)
	org-time-was-given))
	(setq
	txt-prompt
	(concat
	txt-prompt
	(format-time-string " %H:%M" (org-encode-time f)))))
	(when (and org-end-time-was-given
	(string-match org-plain-time-of-day-regexp txt-prompt))
	(setq txt-prompt
	(concat (substring txt-prompt 0 (match-end 0)) "-"
	org-end-time-was-given
	(substring txt-prompt (match-end 0)))))
	;; Update prompt
	(delete-region (line-beginning-position) (point-max))
	(insert txt-prompt))))))

	(defun org-minical--read-date-display ()
	"Call `org-read-date-display' and update the calendar to match the date.
	Should be changed to an advice."
	(when org-read-date-display-live
	(when org-read-date-overlay
	(delete-overlay org-read-date-overlay))
	(when (minibufferp (current-buffer))
	(save-excursion
	(end-of-line 1)
	(while (not (equal (buffer-substring
	(max (point-min) (- (point) 4)) (point))
	" "))
	(insert " ")))
	(let* ((ans (buffer-substring (line-beginning-position)
	(point-max)))
	(org-end-time-was-given nil)
	(f (org-read-date-analyze ans org-def org-defdecode))
	(fmt (org-time-stamp-format
	(or org-with-time
	(and (boundp 'org-time-was-given) org-time-was-given))
	org-read-date-inactive
	org-display-custom-times))
	(txt (format-time-string fmt (org-encode-time f)))
	(txt (concat "=> " txt)))
	(when (and org-end-time-was-given
	(string-match org-plain-time-of-day-regexp txt))
	(setq txt (concat (substring txt 0 (match-end 0)) "-"
	org-end-time-was-given
	(substring txt (match-end 0)))))
	(when org-read-date-analyze-futurep
	(setq txt (concat txt " (=>F)")))
	(setq org-read-date-overlay
	(make-overlay (1- (line-end-position)) (line-end-position)))
	(org-overlay-display org-read-date-overlay txt 'secondary-selection)

	(org-minical--eval-in-calendar
	`(calendar-goto-date
	(list ,(decoded-time-month f)
	,(decoded-time-day f)
	,(decoded-time-year f)))
	t)))))

	(defun org-minical@org-read-date (old-fn
	&optional with-time to-time from-string prompt
	default-time default-input inactive)
	"Read a date, possibly a time, and make things smooth for the user.
	Same as `org-read-date' but displays everything in the minibuffer"
	(if (or from-string
	(not (eq org-read-date-popup-calendar 'minibuffer)))
	(funcall old-fn with-time to-time from-string prompt
	default-time default-input inactive)
	(require 'parse-time)
	(let* ((org-with-time with-time)
	(org-timestamp-rounding-minutes
	(if (equal org-with-time '(16))
	'(0 0)
	org-timestamp-rounding-minutes))
	(org-def (or org-overriding-default-time default-time
	(org-current-time)))
	(org-defdecode (decode-time org-def))
	(mouse-autoselect-window nil) ; Don't let the mouse jump
	(calendar-move-hook nil)
	(calendar-view-diary-initially-flag nil)
	(calendar-view-holidays-initially-flag nil)
	org-ans0)
	;; Rationalize `org-def' and `org-defdecode', if required.
	;; Only consider `org-extend-today-until' when explicit reference
	;; time is not given.
	(when (and (not default-time)
	(not org-overriding-default-time)
	(< (nth 2 org-defdecode) org-extend-today-until))
	(setf (nth 2 org-defdecode) -1)
	(setf (nth 1 org-defdecode) 59)
	(setq org-def (org-encode-time org-defdecode))
	(setq org-defdecode (decode-time org-def)))
	(let* ((timestr (format-time-string
	(if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d")
	org-def))
	(prompt (concat (if prompt (concat prompt " ") "")
	(format "Date+time [%s]: " timestr))))
	(save-excursion
	(calendar-basic-setup nil t))
	(minibuffer-with-setup-hook
	(lambda ()
	(setq-local scroll-margin 0
	completion-auto-help nil
	completion-show-inline-help nil
	org-minical--candidates-ov
	(make-overlay (point-max) (point-max) nil t t))
	(setq-local
	mwheel-scroll-up-function
	(lambda (n)
	(org-minical--eval-in-calendar
	`(org-minical--calendar-scroll ,(- n))))
	mwheel-scroll-down-function
	(lambda (n)
	(org-minical--eval-in-calendar
	`(org-minical--calendar-scroll ,n))))
	(add-hook 'post-command-hook
	(lambda ()
	;; First update the prompt display
	(org-minical--read-date-display)
	;; Then update the overlay
	(when org-minical--candidates-ov
	(let ((lines (org-minical--get-calendar-string))
	;; Overlays affect point position and undo
	;; list!
	(buffer-undo-list t))
	(move-overlay org-minical--candidates-ov
	(point-max) (point-max))
	(overlay-put org-minical--candidates-ov
	'after-string
	(concat #(" " 0 1 (cursor t))
	(and lines "\n") lines))
	(org-minical--resize-minibuffer
	(length (split-string lines "\n"))))))
	nil
	'local))
	(unwind-protect
	(with-current-buffer calendar-buffer
	(calendar-forward-day (- (time-to-days org-def)
	(calendar-absolute-from-gregorian
	(calendar-current-date))))
	(org-minical--eval-in-calendar nil t)
	(let* ((minibuffer-local-map
	(copy-keymap org-minical--minibuffer-map)))
	(unwind-protect
	(progn
	(setq org-read-date-inactive inactive)
	(setq org-ans0
	(read-string prompt
	default-input
	'org-read-date-history
	nil)))
	;; Delete overlay from calendar buffer
	(delete-overlay org-date-ovl)
	(when org-read-date-overlay
	(delete-overlay org-read-date-overlay)
	(setq org-read-date-overlay nil))))))))
	;; Call `org-read-date' with the answer to parse it
	(funcall old-fn with-time to-time org-ans0 nil
	default-time default-input inactive))))

	(advice-add #'org-read-date :around #'org-minical@org-read-date)

	(provide 'org-minical)

	;;; org-minical.el ends here