0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-05 12:12:58 +00:00

Merge branch 'hotfix-7.8.06'

Conflicts:
	lisp/org.el
This commit is contained in:
Bastien Guerry 2012-03-31 11:04:40 +02:00
commit 967783215b
9 changed files with 90 additions and 87 deletions

View file

@ -42,7 +42,8 @@
(defcustom org-babel-maxima-command (defcustom org-babel-maxima-command
(if (boundp 'maxima-command) maxima-command "maxima") (if (boundp 'maxima-command) maxima-command "maxima")
"Command used to call maxima on the shell.") "Command used to call maxima on the shell."
:group 'org-babel)
(defun org-babel-maxima-expand (body params) (defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments." "Expand a block of Maxima code according to its header arguments."

View file

@ -91,7 +91,7 @@
(defvar org-agenda-buffer-name) (defvar org-agenda-buffer-name)
(defvar org-agenda-overriding-header) (defvar org-agenda-overriding-header)
(defvar org-agenda-title-append nil) (defvar org-agenda-title-append nil)
(defvar entry) (defvar org-entry)
(defvar date) (defvar date)
(defvar org-agenda-undo-list) (defvar org-agenda-undo-list)
(defvar org-agenda-pending-undo-list) (defvar org-agenda-pending-undo-list)
@ -4551,8 +4551,8 @@ function from a program - use `org-agenda-get-day-entries' instead."
(org-compile-prefix-format 'agenda) (org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda) (org-set-sorting-strategy 'agenda)
(setq args (or args '(:deadline :scheduled :timestamp :sexp))) (setq args (or args '(:deadline :scheduled :timestamp :sexp)))
(let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) (let* ((files (if (and org-entry (stringp org-entry) (string-match "\\S-" org-entry))
(list entry) (list org-entry)
(org-agenda-files t))) (org-agenda-files t)))
(time (org-float-time)) (time (org-float-time))
file rtn results) file rtn results)
@ -4957,7 +4957,7 @@ holiday will also be skipped."
(not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) (not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
(not (and (memq 'holidays skip-weeks) (not (and (memq 'holidays skip-weeks)
(calendar-check-holidays date))) (calendar-check-holidays date)))
entry))) org-entry)))
(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) (defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
"Like `org-class', but honor `calendar-date-style'. "Like `org-class', but honor `calendar-date-style'.

View file

@ -242,7 +242,7 @@ in org-export-latex-classes."
(envs (append org-beamer-environments-extra (envs (append org-beamer-environments-extra
org-beamer-environments-default)) org-beamer-environments-default))
(props (org-get-text-property-any 0 'org-props text)) (props (org-get-text-property-any 0 'org-props text))
(in "") (out "") option action defaction environment extra (in "") (out "") org-beamer-option org-beamer-action org-beamer-defaction org-beamer-environment org-beamer-extra
columns-option column-option columns-option column-option
env have-text ass tmp) env have-text ass tmp)
(if (= frame-level 0) (setq frame-level nil)) (if (= frame-level 0) (setq frame-level nil))
@ -273,10 +273,10 @@ in org-export-latex-classes."
(setq in (org-fill-template (setq in (org-fill-template
"\\begin{frame}%a%A%o%T%S%x" "\\begin{frame}%a%A%o%T%S%x"
(list (cons "a" (or action "")) (list (cons "a" (or org-beamer-action ""))
(cons "A" (or defaction "")) (cons "A" (or org-beamer-defaction ""))
(cons "o" (or option org-beamer-frame-default-options "")) (cons "o" (or org-beamer-option org-beamer-frame-default-options ""))
(cons "x" (if extra (concat "\n" extra) "")) (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) ""))
(cons "h" "%s") (cons "h" "%s")
(cons "T" (if (string-match "\\S-" text) (cons "T" (if (string-match "\\S-" text)
"\n\\frametitle{%s}" "")) "\n\\frametitle{%s}" ""))
@ -301,10 +301,10 @@ in org-export-latex-classes."
(setq have-text (string-match "\\S-" text)) (setq have-text (string-match "\\S-" text))
(setq in (org-fill-template (setq in (org-fill-template
(nth 2 ass) (nth 2 ass)
(list (cons "a" (or action "")) (list (cons "a" (or org-beamer-action ""))
(cons "A" (or defaction "")) (cons "A" (or org-beamer-defaction ""))
(cons "o" (or option "")) (cons "o" (or org-beamer-option ""))
(cons "x" (if extra (concat "\n" extra) "")) (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) ""))
(cons "h" "%s") (cons "h" "%s")
(cons "H" (if have-text (concat "{" text "}") "")) (cons "H" (if have-text (concat "{" text "}") ""))
(cons "U" (if have-text (concat "[" text "]") "")))) (cons "U" (if have-text (concat "[" text "]") ""))))
@ -328,31 +328,31 @@ in org-export-latex-classes."
(cons text (cdr (assoc level default)))) (cons text (cdr (assoc level default))))
(t nil)))) (t nil))))
(defvar extra) (defvar org-beamer-extra)
(defvar option) (defvar org-beamer-option)
(defvar action) (defvar org-beamer-action)
(defvar defaction) (defvar org-beamer-defaction)
(defvar environment) (defvar org-beamer-environment)
(defun org-beamer-get-special (props) (defun org-beamer-get-special (props)
"Extract an option, action, and default action string from text. "Extract an option, action, and default action string from text.
The variables option, action, defaction, extra are all scoped into The variables org-beamer-option, org-beamer-action, org-beamer-defaction,
this function dynamically." org-beamer-extra are all scoped into this function dynamically."
(let (tmp) (let (tmp)
(setq environment (org-beamer-assoc-not-empty "BEAMER_env" props)) (setq org-beamer-environment (org-beamer-assoc-not-empty "BEAMER_env" props))
(setq extra (org-beamer-assoc-not-empty "BEAMER_extra" props)) (setq org-beamer-extra (org-beamer-assoc-not-empty "BEAMER_extra" props))
(when extra (when org-beamer-extra
(setq extra (replace-regexp-in-string "\\\\n" "\n" extra))) (setq org-beamer-extra (replace-regexp-in-string "\\\\n" "\n" org-beamer-extra)))
(setq tmp (org-beamer-assoc-not-empty "BEAMER_envargs" props)) (setq tmp (org-beamer-assoc-not-empty "BEAMER_envargs" props))
(when tmp (when tmp
(setq tmp (copy-sequence tmp)) (setq tmp (copy-sequence tmp))
(if (string-match "\\[<[^][<>]*>\\]" tmp) (if (string-match "\\[<[^][<>]*>\\]" tmp)
(setq defaction (match-string 0 tmp) (setq org-beamer-defaction (match-string 0 tmp)
tmp (replace-match "" t t tmp))) tmp (replace-match "" t t tmp)))
(if (string-match "\\[[^][]*\\]" tmp) (if (string-match "\\[[^][]*\\]" tmp)
(setq option (match-string 0 tmp) (setq org-beamer-option (match-string 0 tmp)
tmp (replace-match "" t t tmp))) tmp (replace-match "" t t tmp)))
(if (string-match "<[^<>]*>" tmp) (if (string-match "<[^<>]*>" tmp)
(setq action (match-string 0 tmp) (setq org-beamer-action (match-string 0 tmp)
tmp (replace-match "" t t tmp)))))) tmp (replace-match "" t t tmp))))))
(defun org-beamer-assoc-not-empty (elt list) (defun org-beamer-assoc-not-empty (elt list)

View file

@ -112,7 +112,7 @@
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
(defvar description nil) ; dynamically scoped from org.el (defvar org-bibtex-description nil) ; dynamically scoped from org.el
(defvar org-id-locations) (defvar org-id-locations)
(declare-function bibtex-beginning-of-entry "bibtex" ()) (declare-function bibtex-beginning-of-entry "bibtex" ())
@ -476,7 +476,7 @@ With optional argument OPTIONAL, also prompt for optional fields."
:btype (or (cdr (assoc "=type=" entry)) "[no type]") :btype (or (cdr (assoc "=type=" entry)) "[no type]")
:type "bibtex" :type "bibtex"
:link link :link link
:description description)))) :description org-bibtex-description))))
(defun org-create-file-search-in-bibtex () (defun org-create-file-search-in-bibtex ()
"Create the search string and description for a BibTeX database entry." "Create the search string and description for a BibTeX database entry."
@ -494,7 +494,7 @@ With optional argument OPTIONAL, also prompt for optional fields."
(bibtex-autokey-titleword-case-convert-function 'identity) (bibtex-autokey-titleword-case-convert-function 'identity)
(bibtex-autokey-titleword-length 'infty) (bibtex-autokey-titleword-length 'infty)
(bibtex-autokey-year-title-separator ": ")) (bibtex-autokey-year-title-separator ": "))
(setq description (bibtex-generate-autokey))) (setq org-bibtex-description (bibtex-generate-autokey)))
;; Now parse the entry, get the key and return it. ;; Now parse the entry, get the key and return it.
(save-excursion (save-excursion
(bibtex-beginning-of-entry) (bibtex-beginning-of-entry)

View file

@ -1704,7 +1704,7 @@ from the `before-change-functions' in the current buffer."
(remove-hook 'before-change-functions (remove-hook 'before-change-functions
'org-clock-remove-overlays 'local)))) 'org-clock-remove-overlays 'local))))
(defvar state) ;; dynamically scoped into this function (defvar org-clock-state) ;; dynamically scoped into this function
(defun org-clock-out-if-current () (defun org-clock-out-if-current ()
"Clock out if the current entry contains the running clock. "Clock out if the current entry contains the running clock.
This is used to stop the clock after a TODO entry is marked DONE, This is used to stop the clock after a TODO entry is marked DONE,
@ -1713,9 +1713,9 @@ and is only done if the variable `org-clock-out-when-done' is not nil."
org-clock-out-when-done org-clock-out-when-done
(marker-buffer org-clock-marker) (marker-buffer org-clock-marker)
(or (and (eq t org-clock-out-when-done) (or (and (eq t org-clock-out-when-done)
(member state org-done-keywords)) (member org-clock-state org-done-keywords))
(and (listp org-clock-out-when-done) (and (listp org-clock-out-when-done)
(member state org-clock-out-when-done))) (member org-clock-state org-clock-out-when-done)))
(equal (or (buffer-base-buffer (org-clocking-buffer)) (equal (or (buffer-base-buffer (org-clocking-buffer))
(org-clocking-buffer)) (org-clocking-buffer))
(or (buffer-base-buffer (current-buffer)) (or (buffer-base-buffer (current-buffer))

View file

@ -315,11 +315,11 @@ nor a function, elements of KEYWORDS are used directly."
(replace-match "") (replace-match "")
(just-one-space)) (just-one-space))
(defvar rest) (defvar org-mouse-rest)
(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase (defun org-mouse-replace-match-and-surround (newtext &optional fixedcase
literal string subexp) literal string subexp)
"The same as `replace-match', but surrounds the replacement with spaces." "The same as `replace-match', but surrounds the replacement with spaces."
(apply 'replace-match rest) (apply 'replace-match org-mouse-rest)
(save-excursion (save-excursion
(goto-char (match-beginning (or subexp 0))) (goto-char (match-beginning (or subexp 0)))
(just-one-space) (just-one-space)
@ -990,7 +990,7 @@ This means, between the beginning of line and the point."
(replace-match replace-text)) (replace-match replace-text))
(forward-line)))) (forward-line))))
(defvar _cmd) ;dynamically scoped from `org-with-remote-undo'. (defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'.
(defun org-mouse-do-remotely (command) (defun org-mouse-do-remotely (command)
; (org-agenda-check-no-diary) ; (org-agenda-check-no-diary)
@ -1021,7 +1021,7 @@ This means, between the beginning of line and the point."
(setq marker (copy-marker (point))) (setq marker (copy-marker (point)))
(goto-char (max (point-at-bol) (- (point-at-eol) anticol))) (goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
(funcall command) (funcall command)
(message "_cmd: %S" _cmd) (message "_cmd: %S" org-mouse-cmd)
(message "this-command: %S" this-command) (message "this-command: %S" this-command)
(unless (eq (marker-position marker) (marker-position endmarker)) (unless (eq (marker-position marker) (marker-position endmarker))
(setq newhead (org-get-heading)))) (setq newhead (org-get-heading))))

View file

@ -79,17 +79,17 @@ seen. This is run after a few special cases are taken care of."
(add-hook 'org-export-latex-after-blockquotes-hook (add-hook 'org-export-latex-after-blockquotes-hook
'org-special-blocks-convert-latex-special-cookies) 'org-special-blocks-convert-latex-special-cookies)
(defvar line) (defvar org-special-blocks-line)
(defun org-special-blocks-convert-html-special-cookies () (defun org-special-blocks-convert-html-special-cookies ()
"Converts the special cookies into div blocks." "Converts the special cookies into div blocks."
;; Uses the dynamically-bound variable `line'. ;; Uses the dynamically-bound variable `org-special-blocks-line'.
(when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" line) (when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-special-blocks-line)
(message "%s" (match-string 1)) (message "%s" (match-string 1))
(when (equal (match-string 2 line) "START") (when (equal (match-string 2 org-special-blocks-line) "START")
(org-close-par-maybe) (org-close-par-maybe)
(insert "\n<div class=\"" (match-string 1 line) "\">") (insert "\n<div class=\"" (match-string 1 org-special-blocks-line) "\">")
(org-open-par)) (org-open-par))
(when (equal (match-string 2 line) "END") (when (equal (match-string 2 org-special-blocks-line) "END")
(org-close-par-maybe) (org-close-par-maybe)
(insert "\n</div>") (insert "\n</div>")
(org-open-par)) (org-open-par))

View file

@ -2368,7 +2368,7 @@ of the new mark."
(looking-at org-table-auto-recalculate-regexp)) (looking-at org-table-auto-recalculate-regexp))
(org-table-recalculate) t)) (org-table-recalculate) t))
(defvar modes) (defvar org-table-modes)
(defsubst org-set-calc-mode (var &optional value) (defsubst org-set-calc-mode (var &optional value)
(if (stringp var) (if (stringp var)
(setq var (assoc var '(("D" calc-angle-mode deg) (setq var (assoc var '(("D" calc-angle-mode deg)
@ -2376,10 +2376,10 @@ of the new mark."
("F" calc-prefer-frac t) ("F" calc-prefer-frac t)
("S" calc-symbolic-mode t))) ("S" calc-symbolic-mode t)))
value (nth 2 var) var (nth 1 var))) value (nth 2 var) var (nth 1 var)))
(if (memq var modes) (if (memq var org-table-modes)
(setcar (cdr (memq var modes)) value) (setcar (cdr (memq var org-table-modes)) value)
(cons var (cons value modes))) (cons var (cons value org-table-modes)))
modes) org-table-modes)
(defun org-table-eval-formula (&optional arg equation (defun org-table-eval-formula (&optional arg equation
suppress-align suppress-const suppress-align suppress-const

View file

@ -4877,8 +4877,8 @@ This is for getting out of special buffers like remember.")
;; FIXME: Occasionally check by commenting these, to make sure ;; FIXME: Occasionally check by commenting these, to make sure
;; no other functions uses these, forgetting to let-bind them. ;; no other functions uses these, forgetting to let-bind them.
(defvar entry) (defvar org-entry)
(defvar last-state) (defvar org-last-state)
(defvar date) (defvar date)
;; Defined somewhere in this file, but used before definition. ;; Defined somewhere in this file, but used before definition.
@ -4929,6 +4929,7 @@ sure that we are at the beginning of the line.")
Stars are put in group 1 and the trimmed body in group 2.") Stars are put in group 1 and the trimmed body in group 2.")
(defvar bidi-paragraph-direction) (defvar bidi-paragraph-direction)
(defvar buffer-face-mode-face)
;;;###autoload ;;;###autoload
(define-derived-mode org-mode outline-mode "Org" (define-derived-mode org-mode outline-mode "Org"
@ -10438,8 +10439,8 @@ on the system \"/user@host:\"."
targets tgs txt re files f desc descre fast-path-p level pos0) targets tgs txt re files f desc descre fast-path-p level pos0)
(message "Getting targets...") (message "Getting targets...")
(with-current-buffer (or default-buffer (current-buffer)) (with-current-buffer (or default-buffer (current-buffer))
(while (setq entry (pop entries)) (while (setq org-entry (pop entries))
(setq files (car entry) desc (cdr entry)) (setq files (car org-entry) desc (cdr org-entry))
(setq fast-path-p nil) (setq fast-path-p nil)
(cond (cond
((null files) (setq files (list (current-buffer)))) ((null files) (setq files (list (current-buffer))))
@ -11928,7 +11929,7 @@ of repeating deadline/scheduled time stamps to new date.
This function is run automatically after each state change to a DONE state." This function is run automatically after each state change to a DONE state."
;; last-state is dynamically scoped into this function ;; last-state is dynamically scoped into this function
(let* ((repeat (org-get-repeat)) (let* ((repeat (org-get-repeat))
(aa (assoc last-state org-todo-kwd-alist)) (aa (assoc org-last-state org-todo-kwd-alist))
(interpret (nth 1 aa)) (interpret (nth 1 aa))
(head (nth 2 aa)) (head (nth 2 aa))
(whata '(("d" . day) ("m" . month) ("y" . year))) (whata '(("d" . day) ("m" . month) ("y" . year)))
@ -11941,7 +11942,7 @@ This function is run automatically after each state change to a DONE state."
(setq to-state (or (org-entry-get nil "REPEAT_TO_STATE") (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE")
org-todo-repeat-to-state)) org-todo-repeat-to-state))
(unless (and to-state (member to-state org-todo-keywords-1)) (unless (and to-state (member to-state org-todo-keywords-1))
(setq to-state (if (eq interpret 'type) last-state head))) (setq to-state (if (eq interpret 'type) org-last-state head)))
(org-todo to-state) (org-todo to-state)
(when (or org-log-repeat (org-entry-get nil "CLOCK")) (when (or org-log-repeat (org-entry-get nil "CLOCK"))
(org-entry-put nil "LAST_REPEAT" (format-time-string (org-entry-put nil "LAST_REPEAT" (format-time-string
@ -11955,7 +11956,7 @@ This function is run automatically after each state change to a DONE state."
(setq org-log-note-how 'note)) (setq org-log-note-how 'note))
;; Set up for taking a record ;; Set up for taking a record
(org-add-log-setup 'state (or done-word (car org-done-keywords)) (org-add-log-setup 'state (or done-word (car org-done-keywords))
last-state org-last-state
'findpos org-log-repeat))) 'findpos org-log-repeat)))
(org-back-to-heading t) (org-back-to-heading t)
(org-add-planning-info nil nil 'closed) (org-add-planning-info nil nil 'closed)
@ -13751,10 +13752,11 @@ Returns the new tags string, or nil to not change the current settings."
(condition-case nil (condition-case nil
(setq tg (org-icompleting-read (setq tg (org-icompleting-read
"Tag: " "Tag: "
(delete-dups
(append (or buffer-tags (append (or buffer-tags
(with-current-buffer buf (with-current-buffer buf
(org-get-buffer-tags))) (mapcar 'car (org-get-buffer-tags))))
(mapcar 'car table)))) (mapcar 'car table)))))
(quit (setq tg ""))) (quit (setq tg "")))
(when (string-match "\\S-" tg) (when (string-match "\\S-" tg)
(add-to-list 'buffer-tags (list tg)) (add-to-list 'buffer-tags (list tg))
@ -14715,7 +14717,7 @@ in the current file."
(org-re-property property) (org-re-property property)
nil t) nil t)
(setq cnt (1+ cnt)) (setq cnt (1+ cnt))
(replace-match "")) (delete-region (match-beginning 0) (1+ (point-at-eol))))
(message "Property \"%s\" removed from %d entries" property cnt))))) (message "Property \"%s\" removed from %d entries" property cnt)))))
(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el (defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
@ -15021,8 +15023,8 @@ So these are more for recording a certain time/date."
(defvar org-read-date-analyze-forced-year nil) (defvar org-read-date-analyze-forced-year nil)
(defvar org-read-date-inactive) (defvar org-read-date-inactive)
(defun org-read-date (&optional with-time to-time from-string prompt (defun org-read-date (&optional org-with-time to-time from-string prompt
default-time default-input inactive) default-time default-input)
"Read a date, possibly a time, and make things smooth for the user. "Read a date, possibly a time, and make things smooth for the user.
The prompt will suggest to enter an ISO date, but you can also enter anything The prompt will suggest to enter an ISO date, but you can also enter anything
which will at least partially be understood by `parse-time-string'. which will at least partially be understood by `parse-time-string'.
@ -15075,24 +15077,24 @@ the time/date that is used for everything that is not specified by the
user." user."
(require 'parse-time) (require 'parse-time)
(let* ((org-time-stamp-rounding-minutes (let* ((org-time-stamp-rounding-minutes
(if (equal with-time '(16)) '(0 0) org-time-stamp-rounding-minutes)) (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes))
(org-dcst org-display-custom-times) (org-dcst org-display-custom-times)
(ct (org-current-time)) (ct (org-current-time))
(def (or org-overriding-default-time default-time ct)) (org-def (or org-overriding-default-time default-time ct))
(defdecode (decode-time def)) (org-defdecode (decode-time org-def))
(dummy (progn (dummy (progn
(when (< (nth 2 defdecode) org-extend-today-until) (when (< (nth 2 org-defdecode) org-extend-today-until)
(setcar (nthcdr 2 defdecode) -1) (setcar (nthcdr 2 org-defdecode) -1)
(setcar (nthcdr 1 defdecode) 59) (setcar (nthcdr 1 org-defdecode) 59)
(setq def (apply 'encode-time defdecode) (setq org-def (apply 'encode-time org-defdecode)
defdecode (decode-time def))))) org-defdecode (decode-time org-def)))))
(calendar-frame-setup nil) (calendar-frame-setup nil)
(calendar-setup nil) (calendar-setup nil)
(calendar-move-hook nil) (calendar-move-hook nil)
(calendar-view-diary-initially-flag nil) (calendar-view-diary-initially-flag nil)
(calendar-view-holidays-initially-flag nil) (calendar-view-holidays-initially-flag nil)
(timestr (format-time-string (timestr (format-time-string
(if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def))
(prompt (concat (if prompt (concat prompt " ") "") (prompt (concat (if prompt (concat prompt " ") "")
(format "Date+time [%s]: " timestr))) (format "Date+time [%s]: " timestr)))
ans (org-ans0 "") org-ans1 org-ans2 final) ans (org-ans0 "") org-ans1 org-ans2 final)
@ -15105,7 +15107,7 @@ user."
(calendar) (calendar)
(unwind-protect (unwind-protect
(progn (progn
(calendar-forward-day (- (time-to-days def) (calendar-forward-day (- (time-to-days org-def)
(calendar-absolute-from-gregorian (calendar-absolute-from-gregorian
(calendar-current-date)))) (calendar-current-date))))
(org-eval-in-calendar nil t) (org-eval-in-calendar nil t)
@ -15192,7 +15194,7 @@ user."
(delete-overlay org-read-date-overlay) (delete-overlay org-read-date-overlay)
(setq org-read-date-overlay nil))))) (setq org-read-date-overlay nil)))))
(setq final (org-read-date-analyze ans def defdecode)) (setq final (org-read-date-analyze ans org-def org-defdecode))
(when org-read-date-analyze-forced-year (when org-read-date-analyze-forced-year
(message "Year was forced into %s" (message "Year was forced into %s"
@ -15214,9 +15216,9 @@ user."
(nth 2 final) (nth 1 final)) (nth 2 final) (nth 1 final))
(format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
(defvar def) (defvar org-def)
(defvar defdecode) (defvar org-defdecode)
(defvar with-time) (defvar org-with-time)
(defun org-read-date-display () (defun org-read-date-display ()
"Display the current date prompt interpretation in the minibuffer." "Display the current date prompt interpretation in the minibuffer."
(when org-read-date-display-live (when org-read-date-display-live
@ -15232,11 +15234,11 @@ user."
(let* ((ans (concat (buffer-substring (point-at-bol) (point-max)) (let* ((ans (concat (buffer-substring (point-at-bol) (point-max))
" " (or org-ans1 org-ans2))) " " (or org-ans1 org-ans2)))
(org-end-time-was-given nil) (org-end-time-was-given nil)
(f (org-read-date-analyze ans def defdecode)) (f (org-read-date-analyze ans org-def org-defdecode))
(fmts (if org-dcst (fmts (if org-dcst
org-time-stamp-custom-formats org-time-stamp-custom-formats
org-time-stamp-formats)) org-time-stamp-formats))
(fmt (if (or with-time (fmt (if (or org-with-time
(and (boundp 'org-time-was-given) org-time-was-given)) (and (boundp 'org-time-was-given) org-time-was-given))
(cdr fmts) (cdr fmts)
(car fmts))) (car fmts)))
@ -15254,7 +15256,7 @@ user."
(make-overlay (1- (point-at-eol)) (point-at-eol))) (make-overlay (1- (point-at-eol)) (point-at-eol)))
(org-overlay-display org-read-date-overlay txt 'secondary-selection)))) (org-overlay-display org-read-date-overlay txt 'secondary-selection))))
(defun org-read-date-analyze (ans def defdecode) (defun org-read-date-analyze (ans org-def org-defdecode)
"Analyze the combined answer of the date prompt." "Analyze the combined answer of the date prompt."
;; FIXME: cleanup and comment ;; FIXME: cleanup and comment
(let ((nowdecode (decode-time (current-time))) (let ((nowdecode (decode-time (current-time)))
@ -15266,7 +15268,7 @@ user."
(when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
(setq ans "+0")) (setq ans "+0"))
(when (setq delta (org-read-date-get-relative ans (current-time) def)) (when (setq delta (org-read-date-get-relative ans (current-time) org-def))
(setq ans (replace-match "" t t ans) (setq ans (replace-match "" t t ans)
deltan (car delta) deltan (car delta)
deltaw (nth 1 delta) deltaw (nth 1 delta)
@ -15360,19 +15362,19 @@ user."
(substring ans (match-end 7)))))) (substring ans (match-end 7))))))
(setq tl (parse-time-string ans) (setq tl (parse-time-string ans)
day (or (nth 3 tl) (nth 3 defdecode)) day (or (nth 3 tl) (nth 3 org-defdecode))
month (or (nth 4 tl) month (or (nth 4 tl)
(if (and org-read-date-prefer-future (if (and org-read-date-prefer-future
(nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode))) (nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode)))
(prog1 (1+ (nth 4 nowdecode)) (setq futurep t)) (prog1 (1+ (nth 4 nowdecode)) (setq futurep t))
(nth 4 defdecode))) (nth 4 org-defdecode)))
year (or (and (not kill-year) (nth 5 tl)) year (or (and (not kill-year) (nth 5 tl))
(if (and org-read-date-prefer-future (if (and org-read-date-prefer-future
(nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode))) (nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode)))
(prog1 (1+ (nth 5 nowdecode)) (setq futurep t)) (prog1 (1+ (nth 5 nowdecode)) (setq futurep t))
(nth 5 defdecode))) (nth 5 org-defdecode)))
hour (or (nth 2 tl) (nth 2 defdecode)) hour (or (nth 2 tl) (nth 2 org-defdecode))
minute (or (nth 1 tl) (nth 1 defdecode)) minute (or (nth 1 tl) (nth 1 org-defdecode))
second (or (nth 0 tl) 0) second (or (nth 0 tl) 0)
wday (nth 6 tl)) wday (nth 6 tl))
@ -15443,7 +15445,7 @@ user."
(condition-case nil (condition-case nil
(ignore (encode-time second minute hour day month year)) (ignore (encode-time second minute hour day month year))
(error (error
(setq year (nth 5 defdecode)) (setq year (nth 5 org-defdecode))
(setq org-read-date-analyze-forced-year t)))) (setq org-read-date-analyze-forced-year t))))
(setq org-read-date-analyze-futurep futurep) (setq org-read-date-analyze-futurep futurep)
(list second minute hour day month year))) (list second minute hour day month year)))