diff --git a/lisp/org/org.el b/lisp/org/org.el index 325a524..8206cf2 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -12970,125 +12970,127 @@ the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is the time/date that is used for everything that is not specified by the user." (require 'parse-time) - (let* ((org-time-stamp-rounding-minutes - (if (equal with-time '(16)) '(0 0) org-time-stamp-rounding-minutes)) - (org-dcst org-display-custom-times) - (ct (org-current-time)) - (def (or org-overriding-default-time default-time ct)) - (defdecode (decode-time def)) - (dummy (progn - (when (< (nth 2 defdecode) org-extend-today-until) - (setcar (nthcdr 2 defdecode) -1) - (setcar (nthcdr 1 defdecode) 59) - (setq def (apply 'encode-time defdecode) - defdecode (decode-time def))))) - (calendar-frame-setup nil) - (calendar-move-hook nil) - (calendar-view-diary-initially-flag nil) - (view-diary-entries-initially nil) - (calendar-view-holidays-initially-flag nil) - (view-calendar-holidays-initially nil) - (timestr (format-time-string - (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) - (prompt (concat (if prompt (concat prompt " ") "") - (format "Date+time [%s]: " timestr))) - ans (org-ans0 "") org-ans1 org-ans2 final) - - (cond - (from-string (setq ans from-string)) - (org-read-date-popup-calendar - (save-excursion - (save-window-excursion - (calendar) - (calendar-forward-day (- (time-to-days def) - (calendar-absolute-from-gregorian - (calendar-current-date)))) - (org-eval-in-calendar nil t) - (let* ((old-map (current-local-map)) - (map (copy-keymap calendar-mode-map)) - (minibuffer-local-map (copy-keymap minibuffer-local-map))) - (org-defkey map (kbd "RET") 'org-calendar-select) - (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1]) - 'org-calendar-select-mouse) - (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2]) - 'org-calendar-select-mouse) - (org-defkey minibuffer-local-map [(meta shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey minibuffer-local-map [(meta shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey minibuffer-local-map [(meta shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey minibuffer-local-map [(meta shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey minibuffer-local-map [?\e (shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey minibuffer-local-map [?\e (shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey minibuffer-local-map [?\e (shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey minibuffer-local-map [?\e (shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey minibuffer-local-map [(shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-week 1)))) - (org-defkey minibuffer-local-map [(shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-week 1)))) - (org-defkey minibuffer-local-map [(shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-day 1)))) - (org-defkey minibuffer-local-map [(shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-day 1)))) - (org-defkey minibuffer-local-map ">" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-left 1)))) - (org-defkey minibuffer-local-map "<" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-right 1)))) - (run-hooks 'org-read-date-minibuffer-setup-hook) - (unwind-protect - (progn - (use-local-map map) - (add-hook 'post-command-hook 'org-read-date-display) - (setq org-ans0 (read-string prompt default-input - 'org-read-date-history nil)) - ;; org-ans0: from prompt - ;; org-ans1: from mouse click - ;; org-ans2: from calendar motion - (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) - (remove-hook 'post-command-hook 'org-read-date-display) - (use-local-map old-map) - (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))))) - - (t ; Naked prompt only - (unwind-protect - (setq ans (read-string prompt default-input - 'org-read-date-history timestr)) - (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))) - - (setq final (org-read-date-analyze ans def defdecode)) - (setq org-read-date-final-answer ans) - - (if to-time - (apply 'encode-time final) - (if (and (boundp 'org-time-was-given) org-time-was-given) - (format "%04d-%02d-%02d %02d:%02d" - (nth 5 final) (nth 4 final) (nth 3 final) - (nth 2 final) (nth 1 final)) - (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) + (prog1 + (let* ((org-time-stamp-rounding-minutes + (if (equal with-time '(16)) '(0 0) org-time-stamp-rounding-minutes)) + (org-dcst org-display-custom-times) + (ct (org-current-time)) + (def (or org-overriding-default-time default-time ct)) + (defdecode (decode-time def)) + (dummy (progn + (when (< (nth 2 defdecode) org-extend-today-until) + (setcar (nthcdr 2 defdecode) -1) + (setcar (nthcdr 1 defdecode) 59) + (setq def (apply 'encode-time defdecode) + defdecode (decode-time def))))) + (calendar-frame-setup nil) + (calendar-move-hook nil) + (calendar-view-diary-initially-flag nil) + (view-diary-entries-initially nil) + (calendar-view-holidays-initially-flag nil) + (view-calendar-holidays-initially nil) + (timestr (format-time-string + (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) + (prompt (concat (if prompt (concat prompt " ") "") + (format "Date+time [%s]: " timestr))) + ans (org-ans0 "") org-ans1 org-ans2 final) + + (cond + (from-string (setq ans from-string)) + (org-read-date-popup-calendar + (save-excursion + (save-window-excursion + (calendar) + (calendar-forward-day (- (time-to-days def) + (calendar-absolute-from-gregorian + (calendar-current-date)))) + (org-eval-in-calendar nil t) + (let* ((old-map (current-local-map)) + (map (copy-keymap calendar-mode-map)) + (minibuffer-local-map (copy-keymap minibuffer-local-map))) + (org-defkey map (kbd "RET") 'org-calendar-select) + (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1]) + 'org-calendar-select-mouse) + (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2]) + 'org-calendar-select-mouse) + (org-defkey minibuffer-local-map [(meta shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey minibuffer-local-map [(meta shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey minibuffer-local-map [(meta shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey minibuffer-local-map [(meta shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey minibuffer-local-map [?\e (shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey minibuffer-local-map [?\e (shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey minibuffer-local-map [?\e (shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey minibuffer-local-map [?\e (shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey minibuffer-local-map [(shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-week 1)))) + (org-defkey minibuffer-local-map [(shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-week 1)))) + (org-defkey minibuffer-local-map [(shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-day 1)))) + (org-defkey minibuffer-local-map [(shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-day 1)))) + (org-defkey minibuffer-local-map ">" + (lambda () (interactive) + (org-eval-in-calendar '(scroll-calendar-left 1)))) + (org-defkey minibuffer-local-map "<" + (lambda () (interactive) + (org-eval-in-calendar '(scroll-calendar-right 1)))) + (run-hooks 'org-read-date-minibuffer-setup-hook) + (unwind-protect + (progn + (use-local-map map) + (add-hook 'post-command-hook 'org-read-date-display) + (setq org-ans0 (read-string prompt default-input + 'org-read-date-history nil)) + ;; org-ans0: from prompt + ;; org-ans1: from mouse click + ;; org-ans2: from calendar motion + (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) + (remove-hook 'post-command-hook 'org-read-date-display) + (use-local-map old-map) + (when org-read-date-overlay + (org-delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil))))))) + + (t ; Naked prompt only + (unwind-protect + (setq ans (read-string prompt default-input + 'org-read-date-history timestr)) + (when org-read-date-overlay + (org-delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil))))) + + (setq final (org-read-date-analyze ans def defdecode)) + (setq org-read-date-final-answer ans) + + (if to-time + (apply 'encode-time final) + (if (and (boundp 'org-time-was-given) org-time-was-given) + (format "%04d-%02d-%02d %02d:%02d" + (nth 5 final) (nth 4 final) (nth 3 final) + (nth 2 final) (nth 1 final)) + (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))) + (kill-buffer "*Calendar*"))) (defvar def) (defvar defdecode)