tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

Adding release tag 

-----BEGIN PGP SIGNATURE-----
 
 iQEzBAABCgAdFiEEG+FaXQip1ZWVgUdrFDesAvc/kaIFAlyjAccACgkQFDesAvc/
 kaKhFgf/cHi+zTjUVUZ00jrGiSkKDnK0PxxjB8VVW+eUZwKBTFjFTS6690Smif/f
 ehHbSqmfSUbytvCxs4vp/oYVwXzohKhEVRYrHSnJWXYOEo8L6esa8HcqhAJvoZ28
 MVVO6Ba5suo01LZvYYfN+uktV5Tm3xPo7nkkKeByp2VUaj9Q8oFL7/9tFCe4fR+y
 d2rghk6XkXaGgWSEzPDWmVazGTUn4Ws0I4xh27RGkiXmod3G7OuPqKhueHWrAEzT
 28z111jn5BlY9FKpZtdZgVE0EUUM1izbZxBqPUvZIoky4YIQzMINNJkHy0N6C3vd
 A7pVqgcKxxK8X7iLNHIMG16+X+geMg==
 =GI4N
 -----END PGP SIGNATURE-----

Merge tag 'release_9.2.3' into emacs-sync

Adding release tag

# gpg: Signature made Tue 02 Apr 2019 02:31:35 AM EDT
# gpg:                using RSA key 1BE15A5D08A9D5959581476B1437AC02F73F91A2
# gpg: Can't check signature: No public key
This commit is contained in:
Kyle Meyer 2019-04-02 19:03:25 -04:00
parent 90c50d4aa8 01182eb775
commit 3061f90a63
46 changed files with 1183 additions and 925 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
contrib/lisp/org-contacts.el
View File

@ -1013,7 +1013,7 @@ to do our best."
(setq phones-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property tel)))
(setq result "")
(while phones-list
(setq result (concat result "TEL:" (org-link-unescape (org-contacts-strip-link (car phones-list))) "\n"))
(setq result (concat result "TEL:" (org-contacts-strip-link (org-link-unescape (car phones-list))) "\n"))
(setq phones-list (cdr phones-list)))
result))
(when bday

2
contrib/lisp/org-link-edit.el
View File

@ -101,7 +101,7 @@ The list includes
((looking-at org-plain-link-re)
(list (match-beginning 0)
(match-end 0)
(org-link-unescape (match-string-no-properties 0))
(match-string-no-properties 0)
nil))
(t
(error "What am I looking at?"))))))

7
contrib/lisp/org-notmuch.el
View File

@ -105,8 +105,7 @@ Can link to more than one message, if so all matching messages are shown."
(defun org-notmuch-search-store-link ()
"Store a link to a notmuch search or message."
(when (eq major-mode 'notmuch-search-mode)
(let ((link (concat "notmuch-search:"
(org-link-escape notmuch-search-query-string)))
(let ((link (concat "notmuch-search:" notmuch-search-query-string))
(desc (concat "Notmuch search: " notmuch-search-query-string)))
(org-store-link-props :type "notmuch-search"
:link link
@ -121,14 +120,14 @@ Can link to more than one message, if so all matching messages are shown."
(defun org-notmuch-search-follow-link (search)
"Follow a notmuch link by displaying SEARCH in notmuch-search mode."
(require 'notmuch)
(notmuch-search (org-link-unescape search)))
(notmuch-search search))
(defun org-notmuch-tree-follow-link (search)
"Follow a notmuch link by displaying SEARCH in notmuch-tree mode."
(require 'notmuch)
(notmuch-tree (org-link-unescape search)))
(notmuch-tree search))
(provide 'org-notmuch)

648
doc/org-manual.org
View File

File diff suppressed because it is too large Load Diff

4
lisp/ob-abc.el
View File

@ -47,7 +47,7 @@
(value (cdr pair)))
(setq body
(replace-regexp-in-string
(concat "\$" (regexp-quote name))
(concat "\\$" (regexp-quote name))
(if (stringp value) value (format "%S" value))
body))))
vars)
@ -59,7 +59,7 @@
(message "executing Abc source code block")
(let* ((cmdline (cdr (assq :cmdline params)))
(out-file (let ((file (cdr (assq :file params))))
(if file (replace-regexp-in-string "\.pdf$" ".ps" file)
(if file (replace-regexp-in-string "\\.pdf$" ".ps" file)
(error "abc code block requires :file header argument"))))
(in-file (org-babel-temp-file "abc-"))
(render (concat "abcm2ps" " " cmdline

16
lisp/ob-core.el
View File

@ -175,9 +175,14 @@ This string must include a \"%s\" which will be replaced by the results."
:safe #'booleanp)
(defun org-babel-noweb-wrap (&optional regexp)
(concat org-babel-noweb-wrap-start
(or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
org-babel-noweb-wrap-end))
"Return regexp matching a Noweb reference.
Match any reference, or only those matching REGEXP, if non-nil.
When matching, reference is stored in match group 1."
(concat (regexp-quote org-babel-noweb-wrap-start)
(or regexp "\\([^ \t\n]\\(?:.*?[^ \t\n]\\)?\\)")
(regexp-quote org-babel-noweb-wrap-end)))
(defvar org-babel-src-name-regexp
"^[ \t]*#\\+name:[ \t]*"
@ -2967,7 +2972,7 @@ If the table is trivial, then return it as a scalar."
(defun org-babel-string-read (cell)
"Strip nested \"s from around strings."
(org-babel-read (or (and (stringp cell)
(string-match "\\\"\\(.+\\)\\\"" cell)
(string-match "\"\\(.+\\)\"" cell)
(match-string 1 cell))
cell) t))
@ -3148,7 +3153,8 @@ after the babel API for OLD-type source blocks is fully defined.
Callers of this function will probably want to add an entry to
`org-src-lang-modes' as well."
(dolist (fn '("execute" "expand-body" "prep-session"
"variable-assignments" "load-session"))
"variable-assignments" "load-session"
"edit-prep"))
(let ((sym (intern-soft (concat "org-babel-" fn ":" old))))
(when (and sym (fboundp sym))
(defalias (intern (concat "org-babel-" fn ":" new)) sym))))

2
lisp/ob-forth.el
View File

@ -53,7 +53,7 @@ This function is called by `org-babel-execute-src-block'"
(defun org-babel-forth-session-execute (body params)
(require 'forth-mode)
(let ((proc (forth-proc))
(rx " \\(\n:\\|compiled\n\\\|ok\n\\)")
(rx " \\(\n:\\|compiled\n\\|ok\n\\)")
(result-start))
(with-current-buffer (process-buffer (forth-proc))
(mapcar (lambda (line)

83
lisp/org-agenda.el
View File

@ -2907,13 +2907,12 @@ Pressing `<' twice means to restrict to the current subtree or region
(let* ((m (org-agenda-get-any-marker))
(note (and m (org-entry-get m "THEFLAGGINGNOTE"))))
(when note
(message (concat
"FLAGGING-NOTE ([?] for more info): "
(org-add-props
(replace-regexp-in-string
"\\\\n" "//"
(copy-sequence note))
nil 'face 'org-warning)))))))
(message "FLAGGING-NOTE ([?] for more info): %s"
(org-add-props
(replace-regexp-in-string
"\\\\n" "//"
(copy-sequence note))
nil 'face 'org-warning))))))
t t))
((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
@ -3026,19 +3025,18 @@ s Search for keywords M Like m, but only TODO entries
(symbol-name type)
"Lambda expression"))
(t "???"))))
(if org-agenda-menu-show-matcher
(setq line
(concat line ": "
(cond
((stringp match)
(setq match (copy-sequence match))
(org-add-props match nil 'face 'org-warning))
((listp type)
(format "set of %d commands" (length type))))))
(when (org-string-nw-p match)
(add-text-properties
0 (length line) (list 'help-echo
(concat "Matcher: " match)) line)))
(cond
((not (org-string-nw-p match)) nil)
(org-agenda-menu-show-matcher
(setq line
(concat line ": "
(cond
((stringp match)
(propertize match 'face 'org-warning))
((listp type)
(format "set of %d commands" (length type)))))))
(t
(org-add-props line nil 'help-echo (concat "Matcher: " match))))
(push line lines)))
(setq lines (nreverse lines))
(when prefixes
@ -3767,7 +3765,8 @@ FILTER-ALIST is an alist of filters we need to apply when
(setq-local org-agenda-name name)))
(setq buffer-read-only nil))))
(defvar org-agenda-overriding-columns-format) ; From org-colview.el
(defvar org-overriding-columns-format)
(defvar org-local-columns-format)
(defun org-agenda-finalize ()
"Finishing touch for the agenda buffer, called just before displaying it."
(unless org-agenda-multi
@ -3782,9 +3781,9 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-agenda-align-tags))
(unless org-agenda-with-colors
(remove-text-properties (point-min) (point-max) '(face nil)))
(when (bound-and-true-p org-agenda-overriding-columns-format)
(setq-local org-agenda-overriding-columns-format
org-agenda-overriding-columns-format))
(when (bound-and-true-p org-overriding-columns-format)
(setq-local org-local-columns-format
org-overriding-columns-format))
(when org-agenda-view-columns-initially
(org-agenda-columns))
(when org-agenda-fontify-priorities
@ -4672,18 +4671,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(when (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
(let* ((today (org-today))
(date (calendar-gregorian-from-absolute today))
(kwds org-todo-keywords-for-agenda)
(completion-ignore-case t)
(org-select-this-todo-keyword
(if (stringp arg) arg
(and arg (integerp arg) (> arg 0)
(nth (1- arg) kwds))))
rtn rtnall files file pos)
(when (equal arg '(4))
(setq org-select-this-todo-keyword
(completing-read "Keyword (or KWD1|K2D2|...): "
(mapcar #'list kwds) nil nil)))
(and (equal 0 arg) (setq org-select-this-todo-keyword nil))
kwds org-select-this-todo-keyword rtn rtnall files file pos)
(catch 'exit
(when org-agenda-sticky
(setq org-agenda-buffer-name
@ -4692,6 +4681,16 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
org-select-this-todo-keyword)
(format "*Org Agenda(%s)*" (or org-keys "t")))))
(org-agenda-prepare "TODO")
(setq kwds org-todo-keywords-for-agenda
org-select-this-todo-keyword (if (stringp arg) arg
(and (integerp arg)
(> arg 0)
(nth (1- arg) kwds))))
(when (equal arg '(4))
(setq org-select-this-todo-keyword
(completing-read "Keyword (or KWD1|K2D2|...): "
(mapcar #'list kwds) nil nil)))
(and (equal 0 arg) (setq org-select-this-todo-keyword nil))
(org-compile-prefix-format 'todo)
(org-set-sorting-strategy 'todo)
(setq org-agenda-redo-command
@ -5879,12 +5878,12 @@ See also the user option `org-agenda-clock-consistency-checks'."
((> dt (* 60 maxtime))
;; a very long clocking chunk
(setq issue (format "Clocking interval is very long: %s"
(org-duration-from-minutes (floor (/ dt 60.))))
(org-duration-from-minutes (floor dt 60)))
face (or (plist-get pl :long-face) face)))
((< dt (* 60 mintime))
;; a very short clocking chunk
(setq issue (format "Clocking interval is very short: %s"
(org-duration-from-minutes (floor (/ dt 60.))))
(org-duration-from-minutes (floor dt 60)))
face (or (plist-get pl :short-face) face)))
((and (> tlend 0) (< ts tlend))
;; Two clock entries are overlapping
@ -6990,7 +6989,8 @@ The optional argument TYPE tells the agenda type."
"\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb)
(setq tb (substring tb (match-end 0))))
(setq tb (downcase tb)))
(cond ((not ta) +1)
(cond ((not (or ta tb)) nil)
((not ta) +1)
((not tb) -1)
((string-lessp ta tb) -1)
((string-lessp tb ta) +1))))
@ -6999,7 +6999,8 @@ The optional argument TYPE tells the agenda type."
"Compare the string values of the first tags of A and B."
(let ((ta (car (last (get-text-property 1 'tags a))))
(tb (car (last (get-text-property 1 'tags b)))))
(cond ((not ta) +1)
(cond ((not (or ta tb)) nil)
((not ta) +1)
((not tb) -1)
((string-lessp ta tb) -1)
((string-lessp tb ta) +1))))
@ -9022,7 +9023,7 @@ current line."
(if (memq 'org-tag prop)
prop
(cons 'org-tag prop))))))
(setq l (- (match-end 1) (match-beginning 1))
(setq l (string-width (match-string 1))
c (if (< org-agenda-tags-column 0)
(- (abs org-agenda-tags-column) l)
org-agenda-tags-column))
@ -9478,7 +9479,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to
(goto-char (point-min))
(cl-case type
(anniversary
(or (re-search-forward "^*[ \t]+Anniversaries" nil t)
(or (re-search-forward "^\\*[ \t]+Anniversaries" nil t)
(progn
(or (org-at-heading-p t)
(progn

93
lisp/org-archive.el
View File

@ -29,6 +29,7 @@
;;; Code:
(require 'org)
(require 'cl-lib)
(declare-function org-element-type "org-element" (element))
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
@ -126,22 +127,6 @@ Hook functions are called with point on the subtree in the
original file. At this stage, the subtree has been added to the
archive location, but not yet deleted from the original file.")
(defun org-get-local-archive-location ()
"Get the archive location applicable at point."
(let ((re "^[ \t]*#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
prop)
(save-excursion
(save-restriction
(widen)
(setq prop (org-entry-get nil "ARCHIVE" 'inherit))
(cond
((and prop (string-match "\\S-" prop))
prop)
((or (re-search-backward re nil t)
(re-search-forward re nil t))
(match-string 1))
(t org-archive-location))))))
;;;###autoload
(defun org-add-archive-files (files)
"Splice the archive files into the list of files.
@ -159,45 +144,36 @@ archive file is."
files))))
(defun org-all-archive-files ()
"Get a list of all archive files used in the current buffer."
(let (files)
"List of all archive files used in the current buffer."
(let* ((case-fold-search t)
(files `(,(car (org-archive--compute-location org-archive-location)))))
(org-with-point-at 1
(let ((regexp "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)")
(case-fold-search t))
(while (re-search-forward regexp nil t)
(when (save-match-data
(if (equal ":" (match-string 1)) (org-at-property-p)
(eq 'keyword (org-element-type (org-element-at-point)))))
(let ((file (org-extract-archive-file
(match-string-no-properties 2))))
(when (and (org-string-nw-p file) (file-exists-p file))
(push file files)))))))
(setq files (nreverse files))
(let ((file (org-extract-archive-file)))
(when (and (org-string-nw-p file) (file-exists-p file))
(push file files)))
files))
(while (re-search-forward "^[ \t]*:ARCHIVE:" nil t)
(when (org-at-property-p)
(pcase (org-archive--compute-location (match-string 3))
(`(,file . ,_)
(when (org-string-nw-p file)
(cl-pushnew file files :test #'file-equal-p))))))
(cl-remove-if-not #'file-exists-p (nreverse files)))))
(defun org-extract-archive-file (&optional location)
"Extract and expand the file name from archive LOCATION.
if LOCATION is not given, the value of `org-archive-location' is used."
(setq location (or location org-archive-location))
(if (string-match "\\(.*\\)::\\(.*\\)" location)
(if (= (match-beginning 1) (match-end 1))
(buffer-file-name (buffer-base-buffer))
(expand-file-name
(format (match-string 1 location)
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))))
(defun org-extract-archive-heading (&optional location)
"Extract the heading from archive LOCATION.
if LOCATION is not given, the value of `org-archive-location' is used."
(setq location (or location org-archive-location))
(if (string-match "\\(.*\\)::\\(.*\\)" location)
(format (match-string 2 location)
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))
(defun org-archive--compute-location (location)
"Extract and expand the location from archive LOCATION.
Return a pair (FILE . HEADING) where FILE is the file name and
HEADING the heading of the archive location, as strings. Raise
an error if LOCATION is not a valid archive location."
(unless (string-match "::" location)
(error "Invalid archive location: %S" location))
(let ((current-file (buffer-file-name (buffer-base-buffer)))
(file-fmt (substring location 0 (match-beginning 0)))
(heading-fmt (substring location (match-end 0))))
(cons
;; File part.
(if (org-string-nw-p file-fmt)
(expand-file-name
(format file-fmt (file-name-nondirectory current-file)))
current-file)
;; Heading part.
(format heading-fmt (file-name-nondirectory current-file)))))
;;;###autoload
(defun org-archive-subtree (&optional find-done)
@ -229,7 +205,7 @@ direct children of this heading."
((equal find-done '(4)) (org-archive-all-done))
((equal find-done '(16)) (org-archive-all-old))
(t
;; Save all relevant TODO keyword-relatex variables
;; Save all relevant TODO keyword-related variables.
(let* ((tr-org-todo-keywords-1 org-todo-keywords-1)
(tr-org-todo-kwd-alist org-todo-kwd-alist)
(tr-org-done-keywords org-done-keywords)
@ -242,10 +218,11 @@ direct children of this heading."
(file (abbreviate-file-name
(or (buffer-file-name (buffer-base-buffer))
(error "No file associated to buffer"))))
(location (org-get-local-archive-location))
(afile (or (org-extract-archive-file location)
(error "Invalid `org-archive-location'")))
(heading (org-extract-archive-heading location))
(location (org-archive--compute-location
(or (org-entry-get nil "ARCHIVE" 'inherit)
org-archive-location)))
(afile (car location))
(heading (cdr location))
(infile-p (equal file (abbreviate-file-name (or afile ""))))
(newfile-p (and (org-string-nw-p afile)
(not (file-exists-p afile))))

1
lisp/org-attach.el
View File

@ -588,6 +588,7 @@ This function is called by `org-archive-hook'. The option
;; (lambda ()
;; (define-key dired-mode-map (kbd "C-c C-x a") #'org-attach-dired-to-subtree))))
;;;###autoload
(defun org-attach-dired-to-subtree (files)
"Attach FILES marked or current file in dired to subtree in other window.
Takes the method given in `org-attach-method' for the attach action.

3
lisp/org-capture.el
View File

@ -1003,8 +1003,7 @@ Store them in the capture property list."
(equal current-prefix-arg 1))
;; Prompt for date.
(let ((prompt-time (org-read-date
nil t nil "Date for tree entry:"
(current-time))))
nil t nil "Date for tree entry:")))
(org-capture-put
:default-time
(cond ((and (or (not (boundp 'org-time-was-given))

53
lisp/org-clock.el
View File

@ -38,6 +38,7 @@
(declare-function org-table-goto-line "org-table" (n))
(defvar org-frame-title-format-backup frame-title-format)
(defvar org-state)
(defvar org-time-stamp-formats)
@ -332,11 +333,12 @@ For more information, see `org-clocktable-write-default'."
:version "24.1"
:type 'alist)
(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file)
(defcustom org-clock-clocktable-default-properties '(:maxlevel 2)
"Default properties for new clocktables.
These will be inserted into the BEGIN line, to make it easy for users to
play with them."
:group 'org-clocktable
:package-version '(Org . "9.2")
:type 'plist)
(defcustom org-clock-idle-time nil
@ -1168,8 +1170,7 @@ so long."
org-clock-marker (marker-buffer org-clock-marker))
(let* ((org-clock-user-idle-seconds (org-user-idle-seconds))
(org-clock-user-idle-start
(time-subtract (current-time)
(seconds-to-time org-clock-user-idle-seconds)))
(time-since (seconds-to-time org-clock-user-idle-seconds)))
(org-clock-resolving-clocks-due-to-idleness t))
(if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))
(org-clock-resolve
@ -1178,9 +1179,8 @@ so long."
(lambda (_)
(format "Clocked in & idle for %.1f mins"
(/ (float-time
(time-subtract (current-time)
org-clock-user-idle-start))
60.0)))
(time-since org-clock-user-idle-start))
60)))
org-clock-user-idle-start)))))
(defvar org-clock-current-task nil "Task currently clocked in.")
@ -1599,7 +1599,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
;; Possibly remove zero time clocks. However, do not add
;; a note associated to the CLOCK line in this case.
(cond ((and org-clock-out-remove-zero-time-clocks
(= (+ h m) 0))
(= 0 h m))
(setq remove t)
(delete-region (line-beginning-position)
(line-beginning-position 2)))
@ -1633,9 +1633,10 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
"\\>"))))
(org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update)
(message (concat "Clock stopped at %s after "
(org-duration-from-minutes (+ (* 60 h) m)) "%s")
te (if remove " => LINE REMOVED" ""))
(message (if remove
"Clock stopped at %s after %s => LINE REMOVED"
"Clock stopped at %s after %s")
te (org-duration-from-minutes (+ (* 60 h) m)))
(run-hooks 'org-clock-out-hook)
(unless (org-clocking-p)
(setq org-clock-current-task nil)))))))
@ -1934,13 +1935,14 @@ Use `\\[org-clock-remove-overlays]' to remove the subtree times."
nil 'local))))
(let* ((h (/ org-clock-file-total-minutes 60))
(m (- org-clock-file-total-minutes (* 60 h))))
(message (concat (format "Total file time%s: "
(cond (todayp " for today")
(customp " (custom)")
(t "")))
(org-duration-from-minutes
org-clock-file-total-minutes)
" (%d hours and %d minutes)")
(message (cond
(todayp
"Total file time for today: %s (%d hours and %d minutes)")
(customp
"Total file time (custom): %s (%d hours and %d minutes)")
(t
"Total file time: %s (%d hours and %d minutes)"))
(org-duration-from-minutes org-clock-file-total-minutes)
h m))))
(defvar-local org-clock-overlays nil)
@ -1982,7 +1984,7 @@ If NOREMOVE is nil, remove this function from the
(remove-hook 'before-change-functions
'org-clock-remove-overlays 'local))))
(defvar org-state) ;; dynamically scoped into this function
;;;###autoload
(defun org-clock-out-if-current ()
"Clock out if the current entry contains the running clock.
This is used to stop the clock after a TODO entry is marked DONE,
@ -1999,16 +2001,13 @@ and is only done if the variable `org-clock-out-when-done' is not nil."
(or (buffer-base-buffer (current-buffer))
(current-buffer)))
(< (point) org-clock-marker)
(> (save-excursion (outline-next-heading) (point))
(> (org-with-wide-buffer (org-entry-end-position))
org-clock-marker))
;; Clock out, but don't accept a logging message for this.
(let ((org-log-note-clock-out nil)
(org-clock-out-switch-to-state nil))
(org-clock-out))))
(add-hook 'org-after-todo-state-change-hook
'org-clock-out-if-current)
;;;###autoload
(defun org-clock-get-clocktable (&rest props)
"Get a formatted clocktable with parameters according to PROPS.
@ -2383,9 +2382,15 @@ the currently selected interval size."
(`file-with-archives
(and buffer-file-name
(org-add-archive-files (list buffer-file-name))))
((or `nil `file `subtree `tree
(and (pred symbolp)
(guard (string-match "\\`tree\\([0-9]+\\)\\'"
(symbol-name scope)))))
(or (buffer-file-name (buffer-base-buffer))
(current-buffer)))
((pred functionp) (funcall scope))
((pred consp) scope)
(_ (or (buffer-file-name) (current-buffer)))))
(_ (user-error "Unknown scope: %S" scope))))
(block (plist-get params :block))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
@ -2598,7 +2603,7 @@ from the dynamic block definition."
(when multifile
;; Summarize the time collected from this file.
(insert-before-markers
(format (concat "| %s %s | %s%s"
(format (concat "| %s %s | %s%s%s"
(format org-clock-file-time-cell-format
(org-clock--translate "File time" lang))
" | *%s*|\n")

38
lisp/org-colview.el
View File

@ -482,13 +482,15 @@ for the duration of the command.")
(defun org-columns-hscroll-title ()
"Set the `header-line-format' so that it scrolls along with the table."
(sit-for .0001) ; need to force a redisplay to update window-hscroll
(when (not (= (window-hscroll) org-columns-previous-hscroll))
(setq header-line-format
(concat (substring org-columns-full-header-line-format 0 1)
(substring org-columns-full-header-line-format
(1+ (window-hscroll))))
org-columns-previous-hscroll (window-hscroll))
(force-mode-line-update)))
(let ((hscroll (window-hscroll)))
(when (/= org-columns-previous-hscroll hscroll)
(setq header-line-format
(concat (substring org-columns-full-header-line-format 0 1)
(substring org-columns-full-header-line-format
(min (length org-columns-full-header-line-format)
(1+ hscroll))))
org-columns-previous-hscroll hscroll)
(force-mode-line-update))))
(defvar org-colview-initial-truncate-line-value nil
"Remember the value of `truncate-lines' across colview.")
@ -565,9 +567,15 @@ for the duration of the command.")
(org-columns-next-allowed-value)
(org-columns-edit-value "TAGS")))
(defvar org-agenda-overriding-columns-format nil
(defvar org-overriding-columns-format nil
"When set, overrides any other format definition for the agenda.
Don't set this, this is meant for dynamic scoping.")
Don't set this, this is meant for dynamic scoping. Set
`org-local-columns-format' instead.")
(defvar-local org-local-columns-format nil
"When set, overrides any other format definition for the agenda.
This can be set as a buffer local value to avoid interfering with
dynamic scoping for `org-overriding-columns-format'.")
(defun org-columns-edit-value (&optional key)
"Edit the value of the property at point in column view.
@ -628,7 +636,7 @@ Where possible, use the standard interface for changing this line."
(org-columns--call action)
;; The following let preserves the current format, and makes
;; sure that in only a single file things need to be updated.
(let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
(let* ((org-overriding-columns-format org-columns-current-fmt)
(buffer (marker-buffer pom))
(org-agenda-contributing-files
(list (with-current-buffer buffer
@ -722,7 +730,7 @@ an integer, select that value."
(org-columns--call action)
;; The following let preserves the current format, and makes
;; sure that in only a single file things need to be updated.
(let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
(let* ((org-overriding-columns-format org-columns-current-fmt)
(buffer (marker-buffer pom))
(org-agenda-contributing-files
(list (with-current-buffer buffer
@ -1224,10 +1232,7 @@ column specification."
"Compute all columns that have operators defined."
(with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
;; Pass `current-time' result to `float-time' (instead of calling
;; without arguments) so that only `current-time' has to be
;; overridden in tests.
(let ((org-columns--time (float-time (current-time)))
(let ((org-columns--time (float-time))
seen)
(dolist (spec org-columns-current-fmt-compiled)
(let ((property (car spec)))
@ -1566,7 +1571,8 @@ PARAMS is a property list of parameters:
(let* ((org-columns--time (float-time))
(fmt
(cond
((bound-and-true-p org-agenda-overriding-columns-format))
((bound-and-true-p org-overriding-columns-format))
((bound-and-true-p org-local-columns-format))
((let ((m (org-get-at-bol 'org-hd-marker)))
(and m
(or (org-entry-get m "COLUMNS" t)

3
lisp/org-compat.el
View File

@ -434,6 +434,9 @@ use of this function is for the stuck project list."
(define-obsolete-variable-alias 'org-texinfo-def-table-markup
'org-texinfo-table-default-markup "Org 9.1")
(define-obsolete-variable-alias 'org-agenda-overriding-columns-format
'org-overriding-columns-format "Org 9.2.2")
;; The function was made obsolete by commit 65399674d5 of 2013-02-22.
;; This make-obsolete call was added 2016-09-01.
(make-obsolete 'org-capture-import-remember-templates

9
lisp/org-datetree.el
View File

@ -138,15 +138,16 @@ will be built under the headline at point."
"^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
year month day))))
(defun org-datetree--find-create (regex year &optional month day insert)
"Find the datetree matched by REGEX for YEAR, MONTH, or DAY.
REGEX is passed to `format' with YEAR, MONTH, and DAY as
(defun org-datetree--find-create
(regex-template year &optional month day insert)
"Find the datetree matched by REGEX-TEMPLATE for YEAR, MONTH, or DAY.
REGEX-TEMPLATE is passed to `format' with YEAR, MONTH, and DAY as
arguments. Match group 1 is compared against the specified date
component. If INSERT is non-nil and there is no match then it is
inserted into the buffer."
(when (or month day)
(org-narrow-to-subtree))
(let ((re (format regex year month day))
(let ((re (format regex-template year month day))
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))

8
lisp/org-docview.el
View File

@ -56,11 +56,11 @@
(defun org-docview-export (link description format)
"Export a docview link from Org files."
(let* ((path (if (string-match "\\(.+\\)::.+" link) (match-string 1 link)
link))
(desc (or description link)))
(let ((path (if (string-match "\\(.+\\)::.+" link) (match-string 1 link)
link))
(desc (or description link)))
(when (stringp path)
(setq path (org-link-escape (expand-file-name path)))
(setq path (expand-file-name path))
(cond
((eq format 'html) (format "<a href=\"%s\">%s</a>" path desc))
((eq format 'latex) (format "\\href{%s}{%s}" path desc))

9
lisp/org-duration.el
View File

@ -316,11 +316,10 @@ When optional argument CANONICAL is non-nil, ignore
Raise an error if expected format is unknown."
(pcase (or fmt org-duration-format)
(`h:mm
(let ((minutes (floor minutes)))
(format "%d:%02d" (/ minutes 60) (mod minutes 60))))
(format "%d:%02d" (/ minutes 60) (mod minutes 60)))
(`h:mm:ss
(let* ((whole-minutes (floor minutes))
(seconds (floor (* 60 (- minutes whole-minutes)))))
(seconds (mod (* 60 minutes) 60)))
(format "%s:%02d"
(org-duration-from-minutes whole-minutes 'h:mm)
seconds)))
@ -401,9 +400,7 @@ Raise an error if expected format is unknown."
(pcase-let* ((`(,unit . ,required?) units)
(modifier (org-duration--modifier unit canonical)))
(cond ((<= modifier minutes)
(let ((value (if (integerp modifier)
(/ (floor minutes) modifier)
(floor (/ minutes modifier)))))
(let ((value (floor minutes modifier)))
(cl-decf minutes (* value modifier))
(format " %d%s" value unit)))
(required? (concat " 0" unit))

13
lisp/org-element.el
View File

@ -2150,7 +2150,7 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
;; this corner case.
(let ((begin (or (car affiliated) (point)))
(post-affiliated (point))
(key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
(key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):")
(upcase (match-string-no-properties 1))))
(value (org-trim (buffer-substring-no-properties
(match-end 0) (point-at-eol))))
@ -3102,8 +3102,8 @@ Assume point is at the beginning of the link."
(setq contents-begin (match-beginning 3))
(setq contents-end (match-end 3))
(setq link-end (match-end 0))
;; RAW-LINK is the original link. Expand any
;; abbreviation in it.
;; RAW-LINK is the original link. Decode any encoding.
;; Expand any abbreviation in it.
;;
;; Also treat any newline character and associated
;; indentation as a single space character. This is not
@ -3114,9 +3114,10 @@ Assume point is at the beginning of the link."
;; [[shell:ls *.org]], which defeats Org's focus on
;; simplicity.
(setq raw-link (org-link-expand-abbrev
(replace-regexp-in-string
"[ \t]*\n[ \t]*" " "
(match-string-no-properties 1))))
(org-link-unescape
(replace-regexp-in-string
"[ \t]*\n[ \t]*" " "
(match-string-no-properties 1)))))
;; Determine TYPE of link and set PATH accordingly. According
;; to RFC 3986, remove whitespaces from URI in external links.
;; In internal ones, treat indentation as a single space.

6
lisp/org-id.el
View File

@ -161,9 +161,9 @@ to have no space characters in them."
(defcustom org-id-include-domain nil
"Non-nil means add the domain name to new IDs.
This ensures global uniqueness of IDs, and is also suggested by
RFC 2445 in combination with RFC 822. This is only relevant if
`org-id-method' is `org'. When uuidgen is used, the domain will never
be added.
the relevant RFCs. This is relevant only if `org-id-method' is
`org'. When uuidgen is used, the domain will never be added.
The default is to not use this because we have no really good way to get
the true domain, and Org entries will normally not be shared with enough
people to make this necessary."

13
lisp/org-lint.el
View File

@ -558,8 +558,8 @@ Use :header-args: instead"
(defun org-lint-link-to-local-file (ast)
(org-element-map ast 'link
(lambda (l)
(when (equal (org-element-property :type l) "file")
(let ((file (org-link-unescape (org-element-property :path l))))
(when (equal "file" (org-element-property :type l))
(let ((file (org-element-property :path l)))
(and (not (file-remote-p file))
(not (file-exists-p file))
(list (org-element-property :begin l)
@ -574,12 +574,13 @@ Use :header-args: instead"
(lambda (k)
(when (equal (org-element-property :key k) "SETUPFILE")
(let ((file (org-unbracket-string
"\"" "\""
(org-element-property :value k))))
(and (not (file-remote-p file))
"\"" "\""
(org-element-property :value k))))
(and (not (org-file-url-p file))
(not (file-remote-p file))
(not (file-exists-p file))
(list (org-element-property :begin k)
(format "Non-existent setup file \"%s\"" file))))))))
(format "Non-existent setup file %S" file))))))))
(defun org-lint-wrong-include-link-parameter (ast)
(org-element-map ast 'keyword

37
lisp/org-list.el
View File

@ -221,7 +221,7 @@ into
(defcustom org-plain-list-ordered-item-terminator t
"The character that makes a line with leading number an ordered list item.
Valid values are ?. and ?\). To get both terminators, use t.
Valid values are ?. and ?\\). To get both terminators, use t.
This variable needs to be set before org.el is loaded. If you
need to make a change while Emacs is running, use the customize
@ -1569,22 +1569,21 @@ bullets between START and END."
(let* (acc
(set-assoc (lambda (cell) (push cell acc) cell))
(change-bullet-maybe
(function
(lambda (item)
(let ((new-bul-p
(cdr (assoc
;; Normalize ordered bullets.
(let ((bul (org-trim
(org-list-get-bullet item struct))))
(cond ((string-match "[A-Z]\\." bul) "A.")
((string-match "[A-Z])" bul) "A)")
((string-match "[a-z]\\." bul) "a.")
((string-match "[a-z])" bul) "a)")
((string-match "[0-9]\\." bul) "1.")
((string-match "[0-9])" bul) "1)")
(t bul)))
org-list-demote-modify-bullet))))
(when new-bul-p (org-list-set-bullet item struct new-bul-p))))))
(lambda (item)
(let ((new-bul
(cdr (assoc
;; Normalize ordered bullets.
(let ((bul (org-list-get-bullet item struct))
(case-fold-search nil))
(cond ((string-match "[A-Z]\\." bul) "A.")
((string-match "[A-Z])" bul) "A)")
((string-match "[a-z]\\." bul) "a.")
((string-match "[a-z])" bul) "a)")
((string-match "[0-9]\\." bul) "1.")
((string-match "[0-9])" bul) "1)")
(t (org-trim bul))))
org-list-demote-modify-bullet))))
(when new-bul (org-list-set-bullet item struct new-bul)))))
(ind
(lambda (cell)
(let* ((item (car cell))
@ -2658,7 +2657,7 @@ Return t if successful."
(error "Cannot outdent beyond margin")
;; Change bullet if necessary.
(when (and (= (+ top-ind offset) 0)
(string-match "*"
(string-match "\\*"
(org-list-get-bullet beg struct)))
(org-list-set-bullet beg struct
(org-list-bullet-string "-")))
@ -3185,7 +3184,7 @@ Point is left at list's end."
(if (not (ignore-errors (goto-char (org-in-item-p))))
(error "Not in a list")
(let ((list (save-excursion (org-list-to-lisp t))))
(insert (org-list-to-subtree list)))))
(insert (org-list-to-subtree list) "\n"))))
(defun org-list-to-generic (list params)
"Convert a LIST parsed through `org-list-to-lisp' to a custom format.

16
lisp/org-macs.el
View File

@ -193,8 +193,16 @@ because otherwise all these markers will point to nowhere."
(when local-variables
(org-with-wide-buffer
(goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert local-variables))))))
;; If last section is folded, make sure to also hide file
;; local variables after inserting them back.
(let ((overlay
(cl-find-if (lambda (o)
(eq 'outline (overlay-get o 'invisible)))
(overlays-at (1- (point))))))
(unless (bolp) (insert "\n"))
(insert local-variables)
(when overlay
(move-overlay overlay (overlay-start overlay) (point-max)))))))))
(defmacro org-no-popups (&rest body)
"Suppress popup windows and evaluate BODY."
@ -1074,8 +1082,8 @@ nil, just return 0."
((stringp s)
(condition-case nil
(float-time (apply #'encode-time (org-parse-time-string s)))
(error 0.)))
(t 0.)))
(error 0)))
(t 0)))
(defun org-time= (a b)
(let ((a (org-2ft a))

2
lisp/org-mhe.el
View File

@ -142,7 +142,7 @@ So if you use sequences, it will now work."
"Return the name of the message folder in an index folder buffer."
(save-excursion
(mh-index-previous-folder)
(if (re-search-forward "^\\(+.*\\)$" nil t)
(if (re-search-forward "^\\(\\+.*\\)$" nil t)
(message "%s" (match-string 1)))))
(defun org-mhe-get-message-folder ()

4
lisp/org-mobile.el
View File

@ -859,11 +859,11 @@ If BEG and END are given, only do this in that region."
(cl-incf cnt-error)
(throw 'next t))
(move-marker bos-marker (point))
(if (re-search-forward "^** Old value[ \t]*$" eos t)
(if (re-search-forward "^\\** Old value[ \t]*$" eos t)
(setq old (buffer-substring
(1+ (match-end 0))
(progn (outline-next-heading) (point)))))
(if (re-search-forward "^** New value[ \t]*$" eos t)
(if (re-search-forward "^\\** New value[ \t]*$" eos t)
(setq new (buffer-substring
(1+ (match-end 0))
(progn (outline-next-heading)

2
lisp/org-mouse.el
View File

@ -633,7 +633,7 @@ This means, between the beginning of line and the point."
,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
'org-mode-restart))))
((or (eolp)
(and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
(and (looking-at "\\( \\|\t\\)\\(\\+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
(looking-back " \\|\t" (- (point) 2)
(line-beginning-position))))
(org-mouse-popup-global-menu))

2
lisp/org-pcomplete.el
View File

@ -93,7 +93,7 @@ The return value is a string naming the thing at point."
(cons "file-option" nil))
;; Link abbreviation.
((save-excursion
(skip-chars-backward "A-Za-z0-9-_")
(skip-chars-backward "-A-Za-z0-9_")
(and (eq ?\[ (char-before))
(eq ?\[ (char-before (1- (point))))))
(cons "link" nil))

2
lisp/org-plot.el
View File

@ -336,7 +336,7 @@ line directly before or after the table."
(insert "\n")
(insert-file-contents (plist-get params :script))
(goto-char (point-min))
(while (re-search-forward "$datafile" nil t)
(while (re-search-forward "\\$datafile" nil t)
(replace-match data-file nil nil)))
(insert (org-plot/gnuplot-script data-file num-cols params)))
;; Graph table.

23
lisp/org-protocol.el
View File

@ -298,11 +298,9 @@ SEPARATOR is specified or SEPARATOR is nil, assume \"/+\". The
results of that splitting are returned as a list."
(let* ((sep (or separator "/+\\|\\?"))
(split-parts (split-string data sep)))
(if unhexify
(if (fboundp unhexify)
(mapcar unhexify split-parts)
(mapcar 'org-link-unescape split-parts))
split-parts)))
(cond ((not unhexify) split-parts)
((fboundp unhexify) (mapcar unhexify split-parts))
(t (mapcar #'org-link-unescape split-parts)))))
(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
"Transform PARAM-LIST into a flat list for greedy handlers.
@ -332,7 +330,7 @@ returned list."
(len 0)
dir
ret)
(when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger)
(when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-Z0-9][-_a-zA-Z0-9]*:/+\\)\\(.*\\)" trigger)
(setq dir (match-string 1 trigger))
(setq len (length dir))
(setcar l (concat dir (match-string 3 trigger))))
@ -382,11 +380,8 @@ If INFO is already a property list, return it unchanged."
result)
(while data
(setq result
(append
result
(list
(pop data)
(org-link-unescape (pop data))))))
(append result
(list (pop data) (org-link-unescape (pop data))))))
result)
(let ((data (org-protocol-split-data info t org-protocol-data-separator)))
(if default-order
@ -445,9 +440,9 @@ form URL/TITLE can also be used."
(when (boundp 'org-stored-links)
(push (list uri title) org-stored-links))
(kill-new uri)
(message "`%s' to insert new org-link, `%s' to insert `%s'"
(substitute-command-keys "`\\[org-insert-link]'")
(substitute-command-keys "`\\[yank]'")
(message "`%s' to insert new Org link, `%s' to insert %S"
(substitute-command-keys "\\[org-insert-link]")
(substitute-command-keys "\\[yank]")
uri))
nil)

202
lisp/org-table.el
View File

@ -505,7 +505,7 @@ variable is initialized with `org-table-analyze'.")
"Match a reference that needs translation, for reference display.")
(defconst org-table-separator-space
(propertize " " 'display '(space :width 1))
(propertize " " 'display '(space :relative-width 1))
"Space used around fields when aligning the table.
This space serves as a segment separator for the purposes of the
bidirectional reordering.")
@ -1156,7 +1156,7 @@ to a number. In the case of a timestamp, increment by days."
(- (org-time-string-to-absolute txt)
(org-time-string-to-absolute txt-up)))
((string-match org-ts-regexp3 txt) 1)
((string-match "\\([-+]\\)?\\(?:[0-9]+\\)?\\(?:\.[0-9]+\\)?" txt-up)
((string-match "\\([-+]\\)?[0-9]*\\(?:\\.[0-9]+\\)?" txt-up)
(- (string-to-number txt)
(string-to-number (match-string 0 txt-up))))
(t 1)))
@ -2198,8 +2198,8 @@ If NLAST is a number, only the NLAST fields will actually be summed."
(sres (if (= org-timecnt 0)
(number-to-string res)
(setq diff (* 3600 res)
h (floor (/ diff 3600)) diff (mod diff 3600)
m (floor (/ diff 60)) diff (mod diff 60)
h (floor diff 3600) diff (mod diff 3600)
m (floor diff 60) diff (mod diff 60)
s diff)
(format "%.0f:%02.0f:%02.0f" h m s))))
(kill-new sres)
@ -2327,7 +2327,7 @@ LOCATION instead."
"\n"))))
(defsubst org-table-formula-make-cmp-string (a)
(when (string-match "\\`$[<>]" a)
(when (string-match "\\`\\$[<>]" a)
(let ((arrow (string-to-char (substring a 1))))
;; Fake a high number to make sure this is sorted at the end.
(setq a (org-table-formula-handle-first/last-rc a))
@ -2375,7 +2375,7 @@ LOCATION is a buffer position, consider the formulas there."
(cond
((not (match-end 2)) m)
;; Is it a column reference?
((string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m)
((string-match-p "\\`\\$\\([0-9]+\\|[<>]+\\)\\'" m) m)
;; Since named columns are not possible in
;; LHS, assume this is a named field.
(t (match-string 2 string)))))
@ -3236,7 +3236,7 @@ known that the table will be realigned a little later anyway."
(cond
((string-match "\\`@-?I+" old-lhs)
(user-error "Can't assign to hline relative reference"))
((string-match "\\`$[<>]" old-lhs)
((string-match "\\`\\$[<>]" old-lhs)
(let ((new (org-table-formula-handle-first/last-rc
old-lhs)))
(when (assoc new eqlist)
@ -3659,7 +3659,8 @@ Parameters get priority."
(setq startline (org-current-line))
(dolist (entry eql)
(let* ((type (cond
((string-match "\\`$\\([0-9]+\\|[<>]+\\)\\'" (car entry))
((string-match "\\`\\$\\([0-9]+\\|[<>]+\\)\\'"
(car entry))
'column)
((equal (string-to-char (car entry)) ?@) 'field)
(t 'named)))
@ -3879,6 +3880,11 @@ buffer positions. FIELD is the real contents of the field, as
a string, or nil. It is meant to be displayed upon moving the
mouse onto the overlay.
When optional argument PRE is non-nil, assume the overlay is
located at the beginning of the field, and prepend
`org-table-separator-space' to it. Otherwise, concatenate
`org-table-shrunk-column-indicator' at its end.
Return the overlay."
(let ((show-before-edit
(lambda (o &rest _)
@ -3887,7 +3893,7 @@ Return the overlay."
(mapc #'delete-overlay
(cdr (overlay-get o 'org-table-column-overlays)))))
(o (make-overlay start end)))
(overlay-put o 'insert-behind-hooks (and (not pre) (list show-before-edit)))
(overlay-put o 'insert-behind-hooks (list show-before-edit))
(overlay-put o 'insert-in-front-hooks (list show-before-edit))
(overlay-put o 'modification-hooks (list show-before-edit))
(overlay-put o 'org-overlay-type 'table-column-hide)
@ -3895,17 +3901,20 @@ Return the overlay."
;; Make sure overlays stays on top of table coordinates overlays.
;; See `org-table-overlay-coordinates'.
(overlay-put o 'priority 1)
(org-overlay-display o display 'org-table t)
(let ((d (if pre (concat org-table-separator-space display)
(concat display org-table-shrunk-column-indicator))))
(org-overlay-display o d 'org-table t))
o))
(defun org-table--shrink-field (width start end contents)
(defun org-table--shrink-field (width align start end contents)
"Shrink a table field to a specified width.
WIDTH is an integer representing the number of characters to
display, in addition to `org-table-shrunk-column-indicator'. START
and END are, respectively, the beginning and ending positions of
the field. CONTENTS is its trimmed contents, as a string, or
`hline' for table rules.
display, in addition to `org-table-shrunk-column-indicator'.
ALIGN is the alignment of the current column, as either \"l\",
\"c\" or \"r\". START and END are, respectively, the beginning
and ending positions of the field. CONTENTS is its trimmed
contents, as a string, or `hline' for table rules.
Real field is hidden under one or two overlays. They have the
following properties:
@ -3928,59 +3937,106 @@ the column again.
Return a list of overlays hiding the field, or nil if field is
already hidden."
(cond
((org-table--shrunk-field) nil) ;already shrunk: bail out
((or (= 0 width) ;shrink to one character
(>= 1 (org-string-width (buffer-substring start end))))
((= start end) nil) ;no field to narrow
((org-table--shrunk-field) nil) ;already shrunk
((= 0 width) ;shrink to one character
(list (org-table--make-shrinking-overlay
start end org-table-shrunk-column-indicator
(if (eq 'hline contents) "" contents))))
((eq contents 'hline) ;no contents to hide
start end "" (if (eq 'hline contents) "" contents))))
((eq contents 'hline)
(list (org-table--make-shrinking-overlay
start end
(concat (make-string (max 0 (1+ width)) ?-)
org-table-shrunk-column-indicator)
"")))
start end (make-string (1+ width) ?-) "")))
((equal contents "") ;no contents to hide
(list
(let ((w (org-string-width (buffer-substring start end)))
;; We really want WIDTH + 2 whitespace, to include blanks
;; around fields.
(full (+ 2 width)))
(if (<= w full)
(org-table--make-shrinking-overlay
(1- end) end (make-string (- full w) ?\s) "")
(org-table--make-shrinking-overlay (- end (- w full) 1) end "" "")))))
(t
;; If the field is not empty, consider using two overlays: one for
;; the blanks at the beginning of the field, and another one at
;; the end of the field. The former ensures a shrunk field is
;; always displayed with a single white space character in front
;; of it -- e.g., so that even right-aligned fields appear to the
;; left -- and the latter cuts the field at WIDTH visible
;; characters.
(let* ((pre-overlay
(and (not (equal contents ""))
(org-with-point-at start (looking-at "\\( [ \t]+\\)\\S-"))
(org-table--make-shrinking-overlay
start (match-end 1) org-table-separator-space nil 'pre)))
(post-overlay
(let* ((start (if pre-overlay (overlay-end pre-overlay)
(1+ start)))
(w (org-string-width (buffer-substring start (1- end)))))
(if (>= width w)
;; Field is too short. Extend its size by adding
;; white space characters to the right overlay.
(org-table--make-shrinking-overlay
(1- end) end (concat (make-string (- width w) ?\s)
org-table-shrunk-column-indicator)
contents)
;; Find cut location so that WIDTH characters are visible.
(org-table--make-shrinking-overlay
(let* ((begin start)
(lower begin)
(upper (1- end)))
(catch :exit
(while (> (- upper lower) 1)
(let ((mean (+ (ash lower -1)
(ash upper -1)
(logand lower upper 1))))
(pcase (org-string-width (buffer-substring begin mean))
((pred (= width)) (throw :exit mean))
((pred (< width)) (setq upper mean))
(_ (setq lower mean)))))
upper))
end org-table-shrunk-column-indicator contents)))))
(delq nil (list pre-overlay post-overlay))))))
;; If the field is not empty, display exactly WIDTH characters.
;; It can mean to partly hide the field, or extend it with virtual
;; blanks. To that effect, we use one or two overlays. The
;; first, optional, one may add or hide white spaces before the
;; contents of the field. The other, mandatory, one cuts the
;; field or displays white spaces at the end of the field. It
;; also always displays `org-table-shrunk-column-indicator'.
(let* ((lead (org-with-point-at start (skip-chars-forward " ")))
(trail (org-with-point-at end (abs (skip-chars-backward " "))))
(contents-width (org-string-width
(buffer-substring (+ start lead) (- end trail)))))
(cond
;; Contents are too large to fit in WIDTH character. Limit, if
;; possible, blanks at the beginning of the field to a single
;; white space, and cut the field at an appropriate location.
((<= width contents-width)
(let ((pre
(and (> lead 0)
(org-table--make-shrinking-overlay
start (+ start lead) "" contents t)))
(post
(org-table--make-shrinking-overlay
;; Find cut location so that WIDTH characters are
;; visible using dichotomy.
(let* ((begin (+ start lead))
(lower begin)
(upper (1- end))
;; Compensate the absence of leading space,
;; thus preserving alignment.
(width (if (= lead 0) (1+ width) width)))
(catch :exit
(while (> (- upper lower) 1)
(let ((mean (+ (ash lower -1)
(ash upper -1)
(logand lower upper 1))))
(pcase (org-string-width (buffer-substring begin mean))
((pred (= width)) (throw :exit mean))
((pred (< width)) (setq upper mean))
(_ (setq lower mean)))))
upper))
end "" contents)))
(if pre (list pre post) (list post))))
;; Contents fit it WIDTH characters. First compute number of
;; white spaces needed on each side of contents, then expand or
;; compact blanks on each side of the field in order to
;; preserve width and obey to alignment constraints.
(t
(let* ((required (- width contents-width))
(before
(pcase align
;; Compensate the absence of leading space, thus
;; preserving alignment.
((guard (= lead 0)) -1)
("l" 0)
("r" required)
("c" (/ required 2))))
(after (- required before))
(pre
(pcase (1- lead)
((or (guard (= lead 0)) (pred (= before))) nil)
((pred (< before))
(org-table--make-shrinking-overlay
start (+ start (- lead before)) "" contents t))
(_
(org-table--make-shrinking-overlay
start (1+ start)
(make-string (- before (1- lead)) ?\s)
contents t))))
(post
(pcase (1- trail)
((pred (= after))
(org-table--make-shrinking-overlay (1- end) end "" contents))
((pred (< after))
(org-table--make-shrinking-overlay
(+ after (- end trail)) end "" contents))
(_
(org-table--make-shrinking-overlay
(1- end) end
(make-string (- after (1- trail)) ?\s)
contents)))))
(if pre (list pre post) (list post)))))))))
(defun org-table--read-column-selection (select max)
"Read column selection select as a list of numbers.
@ -4021,7 +4077,8 @@ table."
(org-font-lock-ensure beg end)
(dolist (c columns)
(goto-char beg)
(let ((width nil)
(let ((align nil)
(width nil)
(fields nil))
(while (< (point) end)
(catch :continue
@ -4043,16 +4100,19 @@ table."
(contents (if hline? 'hline
(org-trim (buffer-substring start end)))))
(push (list start end contents) fields)
(when (and (null width)
(not hline?)
(string-match "\\`<[lrc]?\\([0-9]+\\)>\\'" contents))
(setq width (string-to-number (match-string 1 contents)))))))
(when (and (not hline?)
(string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)>\\'"
contents))
(unless align (setq align (match-string 1 contents)))
(unless width
(setq width (string-to-number (match-string 2 contents))))))))
(forward-line))
;; Link overlays for current field to the other overlays in the
;; same column.
(let ((chain (list 'siblings)))
(dolist (field fields)
(dolist (new (apply #'org-table--shrink-field (or width 0) field))
(dolist (new (apply #'org-table--shrink-field
(or width 0) (or align "l") field))
(push new (cdr chain))
(overlay-put new 'org-table-column-overlays chain))))))))

27
lisp/org-timer.el
View File

@ -141,10 +141,7 @@ the region 0:00:00."
(setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s)))))
(setq org-timer-start-time
(seconds-to-time
;; Pass `current-time' result to `float-time' (instead
;; of calling without arguments) so that only
;; `current-time' has to be overridden in tests.
(- (float-time (current-time)) delta))))
(- (float-time) delta))))
(setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on)
(message "Timer start time set to %s, current value is %s"
@ -174,7 +171,7 @@ With prefix arg STOP, stop it entirely."
(setq org-timer-start-time
(time-add (current-time) (seconds-to-time new-secs))))
(setq org-timer-start-time
(seconds-to-time (- (float-time (current-time))
(seconds-to-time (- (float-time)
(- pause-secs start-secs)))))
(setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on)
@ -229,20 +226,12 @@ it in the buffer."
(insert (org-timer-value-string)))))
(defun org-timer-value-string ()
"Set the timer string."
"Return current timer string."
(format org-timer-format
(org-timer-secs-to-hms
(abs (floor (org-timer-seconds))))))
(defun org-timer-seconds ()
;; Pass `current-time' result to `float-time' (instead of calling
;; without arguments) so that only `current-time' has to be
;; overridden in tests.
(if org-timer-countdown-timer
(- (float-time org-timer-start-time)
(float-time (or org-timer-pause-time (current-time))))
(- (float-time (or org-timer-pause-time (current-time)))
(float-time org-timer-start-time))))
(let ((time (- (float-time org-timer-pause-time)
(float-time org-timer-start-time))))
(abs (floor (if org-timer-countdown-timer (- time) time)))))))
;;;###autoload
(defun org-timer-change-times-in-region (beg end delta)
@ -465,8 +454,8 @@ using three `C-u' prefix arguments."
(org-timer--run-countdown-timer
secs org-timer-countdown-timer-title))
(run-hooks 'org-timer-set-hook)
;; Pass `current-time' result to `add-time' (instead nil) so
;; that only `current-time' has to be overridden in tests.
;; Pass `current-time' result to `time-add' (instead of nil)
;; for for Emacs 24 compatibility.
(setq org-timer-start-time
(time-add (current-time) (seconds-to-time secs)))
(setq org-timer-pause-time nil)

343
lisp/org.el
View File

@ -7,7 +7,7 @@
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; Version: 9.2.1
;; Version: 9.2.3
;;
;; This file is part of GNU Emacs.
;;
@ -131,6 +131,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-clock-in "org-clock" (&optional select start-time))
(declare-function org-clock-in-last "org-clock" (&optional arg))
(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
(declare-function org-clock-out-if-current "org-clock" ())
(declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove))
(declare-function org-clock-report "org-clock" (&optional arg))
(declare-function org-clock-sum "org-clock" (&optional tstart tend headline-filter propname))
@ -252,10 +253,10 @@ file to byte-code before it is loaded."
(interactive "fFile to load: \nP")
(let* ((age (lambda (file)
(float-time
(time-subtract (current-time)
(file-attribute-modification-time
(or (file-attributes (file-truename file))
(file-attributes file)))))))
(time-since
(file-attribute-modification-time
(or (file-attributes (file-truename file))
(file-attributes file)))))))
(base-name (file-name-sans-extension file))
(exported-file (concat base-name ".el")))
;; tangle if the Org file is newer than the elisp file
@ -2446,8 +2447,8 @@ This option can also be set with on a per-file-basis with
You can have local logging settings for a subtree by setting the LOGGING
property to one or more of these keywords.
When bulk-refiling from the agenda, the value `note' is forbidden and
will temporarily be changed to `time'."
When bulk-refiling, e.g., from the agenda, the value `note' is
forbidden and will temporarily be changed to `time'."
:group 'org-refile
:group 'org-progress
:version "24.1"
@ -6187,8 +6188,11 @@ by a #."
Also refresh fontification if needed."
(interactive)
(let ((old-regexp org-target-link-regexp)
(before-re "\\(?:^\\|[^[:alnum:]]\\)\\(")
(after-re "\\)\\(?:$\\|[^[:alnum:]]\\)")
;; Some languages, e.g., Chinese, do not use spaces to
;; separate words. Also allow to surround radio targets with
;; line-breakable characters.
(before-re "\\(?:^\\|[^[:alnum:]]\\|\\c|\\)\\(")
(after-re "\\)\\(?:$\\|[^[:alnum:]]\\|\\c|\\)")
(targets
(org-with-wide-buffer
(goto-char (point-min))
@ -6935,6 +6939,7 @@ show that drawer instead."
By default, the function expands headings, blocks and drawers.
When optional argument TYPE is a list of symbols among `blocks',
`drawers' and `headings', to only expand one specific type."
(interactive)
(dolist (type (or types '(blocks drawers headings)))
(org-flag-region (point-min) (point-max) nil
(pcase type
@ -7695,7 +7700,6 @@ unconditionally."
(unless (and blank? (org-previous-line-empty-p))
(org-N-empty-lines-before-current (if blank? 1 0)))
(insert stars " ")
(when (eobp) (save-excursion (insert "\n")))
;; When INVISIBLE-OK is non-nil, ensure newly created headline
;; is visible.
(unless invisible-ok
@ -7722,13 +7726,11 @@ unconditionally."
(end-of-line)
(when blank? (insert "\n"))
(insert "\n" stars " ")
(when (org-string-nw-p split) (insert split))
(when (eobp) (save-excursion (insert "\n")))))
(when (org-string-nw-p split) (insert split))))
(t
(end-of-line)
(when blank? (insert "\n"))
(insert "\n" stars " ")
(when (eobp) (save-excursion (insert "\n"))))))
(insert "\n" stars " "))))
;; On regular text, turn line into a headline or split, if
;; appropriate.
((bolp)
@ -10056,7 +10058,7 @@ This is still an experimental function, your mileage may vary."
((and (equal type "lisp") (string-match "^/" path))
;; Planner has a slash, we do not.
(setq type "elisp" path (substring path 1)))
((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path)
((string-match "^//\\(.*\\)/\\(<.*>\\)$" path)
;; A typical message link. Planner has the id after the final slash,
;; we separate it with a hash mark
(setq path (concat (match-string 1 path) "#"
@ -10287,7 +10289,7 @@ a link."
((eq type 'timestamp) (org-follow-timestamp-link))
((eq type 'link)
(let ((type (org-element-property :type context))
(path (org-link-unescape (org-element-property :path context))))
(path (org-element-property :path context)))
;; Switch back to REFERENCE-BUFFER needed when called in
;; a temporary buffer through `org-open-link-from-string'.
(with-current-buffer (or reference-buffer (current-buffer))
@ -10320,8 +10322,7 @@ a link."
(cond ((not option) nil)
((string-match-p "\\`[0-9]+\\'" option)
(list (string-to-number option)))
(t (list nil
(org-link-unescape option)))))))))
(t (list nil option))))))))
((functionp (org-link-get-parameter type :follow))
(funcall (org-link-get-parameter type :follow) path))
((member type '("coderef" "custom-id" "fuzzy" "radio"))
@ -11343,7 +11344,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(setq last-command nil)
(when regionp
(goto-char region-start)
(or (bolp) (goto-char (point-at-bol)))
(beginning-of-line)
(setq region-start (point))
(unless (or (org-kill-is-subtree-p
(buffer-substring region-start region-end))
@ -11431,10 +11432,18 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(or (outline-next-heading) (goto-char (point-max)))))
(unless (bolp) (newline))
(org-paste-subtree level nil nil t)
(when org-log-refile
(org-add-log-setup 'refile nil nil org-log-refile)
(unless (eq org-log-refile 'note)
(save-excursion (org-add-log-note))))
;; Record information, according to `org-log-refile'.
;; Do not prompt for a note when refiling multiple
;; headlines, however. Simply add a time stamp.
(cond
((not org-log-refile))
(regionp
(org-map-region
(lambda () (org-add-log-setup 'refile nil nil 'time))
(point)
(+ (point) (- region-end region-start))))
(t
(org-add-log-setup 'refile nil nil org-log-refile)))
(and org-auto-align-tags
(let ((org-loop-over-headlines-in-active-region nil))
(org-align-tags)))
@ -11464,7 +11473,8 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(when (featurep 'org-inlinetask)
(org-inlinetask-remove-END-maybe))
(setq org-markers-to-move nil)
(message (concat actionmsg " to \"%s\" in file %s: done") (car it) file)))))))
(message "%s to \"%s\" in file %s: done" actionmsg
(car it) file)))))))
(defun org-refile-goto-last-stored ()
"Go to the location where the last refile was stored."
@ -12184,7 +12194,7 @@ When called through ELisp, arg is also interpreted in the following way:
(run-hook-with-args-until-success
'org-todo-get-default-hook org-state org-last-state)
org-state))
(next (if org-state (concat " " org-state " ") " "))
(next (if (org-string-nw-p org-state) (concat " " org-state " ") " "))
(change-plist (list :type 'todo-state-change :from this :to org-state
:position startpos))
dolog now-done-p)
@ -12258,6 +12268,8 @@ When called through ELisp, arg is also interpreted in the following way:
(when org-auto-align-tags (org-align-tags))
(when org-provide-todo-statistics
(org-update-parent-todo-statistics))
(when (bound-and-true-p org-clock-out-when-done)
(org-clock-out-if-current))
(run-hooks 'org-after-todo-state-change-hook)
(when (and arg (not (member org-state org-done-keywords)))
(setq head (org-get-todo-sequence-head org-state)))
@ -12683,7 +12695,9 @@ Returns the new TODO keyword, or nil if no state change should occur."
(when (and (= cnt 0) (not ingroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(when (= (setq cnt (1+ cnt)) ncol)
(when (and (= (setq cnt (1+ cnt)) ncol)
;; Avoid lines with just a closing delimiter.
(not (equal (car tbl) '(:endgroup))))
(insert "\n")
(when ingroup (insert " "))
(setq cnt 0)))))
@ -14614,13 +14628,14 @@ Returns the new tags string, or nil to not change the current settings."
((member tg inherited) i-face))))
(when (equal (caar tbl) :grouptags)
(org-add-props tg nil 'face 'org-tag-group))
(when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
(when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(push (cons tg c) ntable)
(when (= (cl-incf cnt) ncol)
(insert "\n")
(when (or ingroup intaggroup) (insert " "))
(unless (memq (caar tbl) '(:endgroup :endgrouptag))
(insert "\n")
(when (or ingroup intaggroup) (insert " ")))
(setq cnt 0)))))
(setq ntable (nreverse ntable))
(insert "\n")
@ -14729,7 +14744,7 @@ Assume point is at the beginning of the headline."
When argument POS is non-nil, retrieve tags for headline at POS.
According to `org-use-tags-inheritance', tags may be inherited
According to `org-use-tag-inheritance', tags may be inherited
from parent headlines, and from the whole document, through
`org-file-tags'. In this case, the returned list of tags
contains tags in this order: file tags, tags inherited from
@ -16035,8 +16050,8 @@ non-nil."
((org-at-timestamp-p 'lax) (match-string 0))))
;; Default time is either the timestamp at point or today.
;; When entering a range, only the range start is considered.
(default-time (if (not ts) (current-time)
(apply #'encode-time (org-parse-time-string ts))))
(default-time (and ts
(apply #'encode-time (org-parse-time-string ts))))
(default-input (and ts (org-get-compact-tod ts)))
(repeater (and ts
(string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts)
@ -16044,13 +16059,13 @@ non-nil."
org-time-was-given
org-end-time-was-given
(time
(and (if (equal arg '(16)) (current-time)
;; Preserve `this-command' and `last-command'.
(let ((this-command this-command)
(last-command last-command))
(org-read-date
arg 'totime nil nil default-time default-input
inactive))))))
(if (equal arg '(16)) (current-time)
;; Preserve `this-command' and `last-command'.
(let ((this-command this-command)
(last-command last-command))
(org-read-date
arg 'totime nil nil default-time default-input
inactive)))))
(cond
((and ts
(memq last-command '(org-time-stamp org-time-stamp-inactive))
@ -16409,12 +16424,9 @@ user."
(defun org-read-date-analyze (ans def defdecode)
"Analyze the combined answer of the date prompt."
;; FIXME: cleanup and comment
;; Pass `current-time' result to `decode-time' (instead of calling
;; without arguments) so that only `current-time' has to be
;; overridden in tests.
(let ((org-def def)
(org-defdecode defdecode)
(nowdecode (decode-time (current-time)))
(nowdecode (decode-time))
delta deltan deltaw deltadef year month day
hour minute second wday pm h2 m2 tl wday1
iso-year iso-weekday iso-week iso-date futurep kill-year)
@ -16423,7 +16435,7 @@ user."
(when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
(setq ans "+0"))
(when (setq delta (org-read-date-get-relative ans (current-time) org-def))
(when (setq delta (org-read-date-get-relative ans nil org-def))
(setq ans (replace-match "" t t ans)
deltan (car delta)
deltaw (nth 1 delta)
@ -16591,10 +16603,7 @@ user."
(deltan
(setq futurep nil)
(unless deltadef
;; Pass `current-time' result to `decode-time' (instead of
;; calling without arguments) so that only `current-time' has
;; to be overridden in tests.
(let ((now (decode-time (current-time))))
(let ((now (decode-time)))
(setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
(cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
((equal deltaw "w") (setq day (+ day (* 7 deltan))))
@ -16774,7 +16783,7 @@ Don't touch the rest."
If SECONDS is non-nil, return the difference in seconds."
(let ((fdiff (if seconds #'float-time #'time-to-days)))
(- (funcall fdiff (org-time-string-to-time timestamp-string))
(funcall fdiff (current-time)))))
(funcall fdiff nil))))
(defun org-deadline-close-p (timestamp-string &optional ndays)
"Is the time in TIMESTAMP-STRING close to the current date?"
@ -16956,10 +16965,8 @@ days in order to avoid rounding problems."
(match-end (match-end 0))
(time1 (org-time-string-to-time ts1))
(time2 (org-time-string-to-time ts2))
(t1 (float-time time1))
(t2 (float-time time2))
(diff (abs (- t2 t1)))
(negative (< (- t2 t1) 0))
(diff (abs (float-time (time-subtract time2 time1))))
(negative (time-less-p time2 time1))
;; (ys (floor (* 365 24 60 60)))
(ds (* 24 60 60))
(hs (* 60 60))
@ -16970,14 +16977,14 @@ days in order to avoid rounding problems."
(fh "%02d:%02d")
y d h m align)
(if havetime
(setq ; y (floor (/ diff ys)) diff (mod diff ys)
(setq ; y (floor diff ys) diff (mod diff ys)
y 0
d (floor (/ diff ds)) diff (mod diff ds)
h (floor (/ diff hs)) diff (mod diff hs)
m (floor (/ diff 60)))
(setq ; y (floor (/ diff ys)) diff (mod diff ys)
d (floor diff ds) diff (mod diff ds)
h (floor diff hs) diff (mod diff hs)
m (floor diff 60))
(setq ; y (floor diff ys) diff (mod diff ys)
y 0
d (floor (+ (/ diff ds) 0.5))
d (round diff ds)
h 0 m 0))
(if (not to-buffer)
(message "%s" (org-make-tdiff-string y d h m))
@ -18756,7 +18763,8 @@ conventions:
from `image-file-name-regexp' and it has no contents.
2. Its description consists in a single link of the previous
type.
type. In this case, that link must be a well-formed plain
or angle link, i.e., it must have an explicit \"file\" type.
When optional argument INCLUDE-LINKED is non-nil, also links with
a text description part will be inlined. This can be nice for
@ -18772,89 +18780,112 @@ boundaries."
(unless refresh
(org-remove-inline-images)
(when (fboundp 'clear-image-cache) (clear-image-cache)))
(org-with-wide-buffer
(goto-char (or beg (point-min)))
(let* ((case-fold-search t)
(file-extension-re (image-file-name-regexp))
(link-abbrevs (mapcar #'car
(append org-link-abbrev-alist-local
org-link-abbrev-alist)))
;; Check absolute, relative file names and explicit
;; "file:" links. Also check link abbreviations since
;; some might expand to "file" links.
(file-types-re (format "[][]\\[\\(?:file\\|[./~]%s\\)"
(if (not link-abbrevs) ""
(format "\\|\\(?:%s:\\)"
(regexp-opt link-abbrevs))))))
(while (re-search-forward file-types-re end t)
(let ((link (save-match-data (org-element-context))))
;; Check if we're at an inline image, i.e., an image file
;; link without a description (unless INCLUDE-LINKED is
;; non-nil).
(when (and (equal "file" (org-element-property :type link))
(or include-linked
(null (org-element-contents link)))
(string-match-p file-extension-re
(org-element-property :path link)))
(let ((file (expand-file-name
(org-link-unescape
(org-element-property :path link)))))
(when (file-exists-p file)
(let ((width
;; Apply `org-image-actual-width' specifications.
(cond
((not (image-type-available-p 'imagemagick)) nil)
((eq org-image-actual-width t) nil)
((listp org-image-actual-width)
(or
;; First try to find a width among
;; attributes associated to the paragraph
;; containing link.
(let ((paragraph
(let ((e link))
(while (and (setq e (org-element-property
:parent e))
(not (eq (org-element-type e)
'paragraph))))
e)))
(when paragraph
(save-excursion
(goto-char (org-element-property :begin paragraph))
(when
(re-search-forward
"^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
(org-element-property
:post-affiliated paragraph)
t)
(string-to-number (match-string 1))))))
;; Otherwise, fall-back to provided number.
(car org-image-actual-width)))
((numberp org-image-actual-width)
org-image-actual-width)))
(old (get-char-property-and-overlay
(org-element-property :begin link)
'org-image-overlay)))
(if (and (car-safe old) refresh)
(image-refresh (overlay-get (cdr old) 'display))
(let ((image (create-image file
(and width 'imagemagick)
nil
:width width)))
(when image
(let ((ov (make-overlay
(org-element-property :begin link)
(progn
(goto-char
(org-element-property :end link))
(skip-chars-backward " \t")
(point)))))
(overlay-put ov 'display image)
(overlay-put ov 'face 'default)
(overlay-put ov 'org-image-overlay t)
(overlay-put
ov 'modification-hooks
(list 'org-display-inline-remove-overlay))
(push ov org-inline-image-overlays)))))))))))))))
(org-with-point-at (or beg 1)
(let* ((case-fold-search t)
(file-extension-re (image-file-name-regexp))
(link-abbrevs (mapcar #'car
(append org-link-abbrev-alist-local
org-link-abbrev-alist)))
;; Check absolute, relative file names and explicit
;; "file:" links. Also check link abbreviations since
;; some might expand to "file" links.
(file-types-re
(format "\\[\\[\\(?:file%s:\\|[./~]\\)\\|\\]\\[\\(<?file:\\)"
(if (not link-abbrevs) ""
(concat "\\|" (regexp-opt link-abbrevs))))))
(while (re-search-forward file-types-re end t)
(let* ((link (org-element-lineage
(save-match-data (org-element-context))
'(link) t))
(inner-start (match-beginning 1))
(path
(cond
;; No link at point; no inline image.
((not link) nil)
;; File link without a description. Also handle
;; INCLUDE-LINKED here since it should have
;; precedence over the next case. I.e., if link
;; contains filenames in both the path and the
;; description, prioritize the path only when
;; INCLUDE-LINKED is non-nil.
((or (not (org-element-property :contents-begin link))
include-linked)
(and (equal "file" (org-element-property :type link))
(org-element-property :path link)))
;; Link with a description. Check if description
;; is a filename. Even if Org doesn't have syntax
;; for those -- clickable image -- constructs, fake
;; them, as in `org-export-insert-image-links'.
((not inner-start) nil)
(t
(org-with-point-at inner-start
(and (looking-at
(if (char-equal ?< (char-after inner-start))
org-angle-link-re
org-plain-link-re))
;; File name must fill the whole
;; description.
(= (org-element-property :contents-end link)
(match-end 0))
(match-string 2)))))))
(when (and path (string-match-p file-extension-re path))
(let ((file (expand-file-name path)))
(when (file-exists-p file)
(let ((width
;; Apply `org-image-actual-width' specifications.
(cond
((not (image-type-available-p 'imagemagick)) nil)
((eq org-image-actual-width t) nil)
((listp org-image-actual-width)
(or
;; First try to find a width among
;; attributes associated to the paragraph
;; containing link.
(let ((paragraph
(let ((e link))
(while (and (setq e (org-element-property
:parent e))
(not (eq (org-element-type e)
'paragraph))))
e)))
(when paragraph
(save-excursion
(goto-char (org-element-property :begin paragraph))
(when
(re-search-forward
"^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
(org-element-property
:post-affiliated paragraph)
t)
(string-to-number (match-string 1))))))
;; Otherwise, fall-back to provided number.
(car org-image-actual-width)))
((numberp org-image-actual-width)
org-image-actual-width)))
(old (get-char-property-and-overlay
(org-element-property :begin link)
'org-image-overlay)))
(if (and (car-safe old) refresh)
(image-refresh (overlay-get (cdr old) 'display))
(let ((image (create-image file
(and width 'imagemagick)
nil
:width width)))
(when image
(let ((ov (make-overlay
(org-element-property :begin link)
(progn
(goto-char
(org-element-property :end link))
(skip-chars-backward " \t")
(point)))))
(overlay-put ov 'display image)
(overlay-put ov 'face 'default)
(overlay-put ov 'org-image-overlay t)
(overlay-put
ov 'modification-hooks
(list 'org-display-inline-remove-overlay))
(push ov org-inline-image-overlays)))))))))))))))
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
"Remove inline-display overlay if a corresponding region is modified."
@ -20041,7 +20072,7 @@ this numeric value."
(unless inc (setq inc 1))
(let ((pos (point))
(beg (skip-chars-backward "-+^/*0-9eE."))
(end (skip-chars-forward "-+^/*0-9eE^.")) nap)
(end (skip-chars-forward "-+^/*0-9eE.")) nap)
(setq nap (buffer-substring-no-properties
(+ pos beg) (+ pos beg end)))
(delete-region (+ pos beg) (+ pos beg end))
@ -20149,17 +20180,15 @@ Otherwise, return a user error."
(unless (member (org-element-property :key element)
'("INCLUDE" "SETUPFILE"))
(user-error "No special environment to edit here"))
(org-open-link-from-string
(format "[[%s]]"
(expand-file-name
(let ((value (org-strip-quotes
(org-element-property :value element))))
(cond
((not (org-string-nw-p value))
(user-error "No file to edit"))
((org-file-url-p value)
(user-error "Files located with a URL cannot be edited"))
(t value)))))))
(let ((value (org-element-property :value element)))
(unless (org-string-nw-p value) (user-error "No file to edit"))
(let ((file (and (string-match "\\`\"\\(.*?\\)\"\\|\\S-+" value)
(or (match-string 1 value)
(match-string 0 value)))))
(when (org-file-url-p file)
(user-error "Files located with a URL cannot be edited"))
(org-open-link-from-string
(format "[[%s]]" (expand-file-name file))))))
(`table
(if (eq (org-element-property :type element) 'table.el)
(org-edit-table.el)
@ -21964,9 +21993,9 @@ assumed to be significant there."
(defun org-fill-line-break-nobreak-p ()
"Non-nil when a new line at point would create an Org line break."
(save-excursion
(skip-chars-backward "[ \t]")
(skip-chars-backward " \t")
(skip-chars-backward "\\\\")
(looking-at "\\\\\\\\\\($\\|[^\\\\]\\)")))
(looking-at "\\\\\\\\\\($\\|[^\\]\\)")))
(defun org-fill-paragraph-with-timestamp-nobreak-p ()
"Non-nil when a new line at point would split a timestamp."

8
lisp/ox-ascii.el
View File

@ -1472,8 +1472,8 @@ contextual information."
(replace-regexp-in-string
"-" "•"
(replace-regexp-in-string
"+" "⁃"
(replace-regexp-in-string "*" "‣" bul))))))))
"\\+" "⁃"
(replace-regexp-in-string "\\*" "‣" bul))))))))
(indentation (if (eq list-type 'descriptive) org-ascii-quote-margin
(string-width bullet))))
(concat
@ -1600,7 +1600,9 @@ INFO is a plist holding contextual information."
;; Don't know what to do. Signal it.
(_ "???"))))
(t
(let ((raw-link (org-element-property :raw-link link)))
(let ((raw-link (concat (org-element-property :type link)
":"
(org-element-property :path link))))
(if (not (org-string-nw-p desc)) (format "<%s>" raw-link)
(concat (format "[%s]" desc)
(and (not (plist-get info :ascii-links-to-notes))

22
lisp/ox-html.el
View File

@ -3018,7 +3018,7 @@ INFO is a plist holding contextual information. See
(path
(cond
((member type '("http" "https" "ftp" "mailto" "news"))
(url-encode-url (org-link-unescape (concat type ":" raw-path))))
(url-encode-url (concat type ":" raw-path)))
((string= type "file")
;; During publishing, turn absolute file names belonging
;; to base directory into relative file names. Otherwise,
@ -3172,18 +3172,18 @@ INFO is a plist holding contextual information. See
(format (org-export-get-coderef-format path desc)
(org-export-resolve-coderef path info)))))
;; External link with a description part.
((and path desc) (format "<a href=\"%s\"%s>%s</a>"
(org-html-encode-plain-text path)
attributes
desc))
((and path desc)
(format "<a href=\"%s\"%s>%s</a>"
(org-html-encode-plain-text path)
attributes
desc))
;; External link without a description part.
(path (let ((path (org-html-encode-plain-text path)))
(format "<a href=\"%s\"%s>%s</a>"
path
attributes
(org-link-unescape path))))
(path
(let ((path (org-html-encode-plain-text path)))
(format "<a href=\"%s\"%s>%s</a>" path attributes path)))
;; No path, only description. Try to do something useful.
(t (format "<i>%s</i>" desc)))))
(t
(format "<i>%s</i>" desc)))))
;;;; Node Property

2
lisp/ox-icalendar.el
View File

@ -317,7 +317,7 @@ A headline is blocked when either
done first or is a child of a blocked grandparent entry."
(or
;; Check if any child is not done.
(org-element-map headline 'headline
(org-element-map (org-element-contents headline) 'headline
(lambda (hl) (eq (org-element-property :todo-type hl) 'todo))
info 'first-match)
;; Check :ORDERED: node property.

8
lisp/ox-latex.el
View File

@ -1610,7 +1610,7 @@ INFO is a plist used as a communication channel."
(defun org-latex-clean-invalid-line-breaks (data _backend _info)
(replace-regexp-in-string
"\\(\\end{[A-Za-z0-9*]+}\\|^\\)[ \t]*\\\\\\\\[ \t]*$" "\\1"
"\\(\\\\end{[A-Za-z0-9*]+}\\|^\\)[ \t]*\\\\\\\\[ \t]*$" "\\1"
data))
@ -2500,8 +2500,10 @@ INFO is a plist holding contextual information. See
(path (org-latex--protect-text
(cond ((member type '("http" "https" "ftp" "mailto" "doi"))
(concat type ":" raw-path))
((string= type "file") (org-export-file-uri raw-path))
(t raw-path)))))
((string= type "file")
(org-export-file-uri raw-path))
(t
raw-path)))))
(cond
;; Link type is handled by a special function.
((org-export-custom-protocol-maybe link desc 'latex))

24
lisp/ox-publish.el
View File

@ -793,13 +793,11 @@ Default for SITEMAP-FILENAME is `sitemap.org'."
(not (string-lessp B A))))))
((or `anti-chronologically `chronologically)
(let* ((adate (org-publish-find-date a project))
(bdate (org-publish-find-date b project))
(A (+ (ash (car adate) 16) (cadr adate)))
(B (+ (ash (car bdate) 16) (cadr bdate))))
(bdate (org-publish-find-date b project)))
(setq retval
(if (eq sort-files 'chronologically)
(<= A B)
(>= A B)))))
(not (if (eq sort-files 'chronologically)
(time-less-p bdate adate)
(time-less-p adate bdate))))))
(`nil nil)
(_ (user-error "Invalid sort value %s" sort-files)))
;; Directory-wise wins:
@ -1173,7 +1171,7 @@ references with `org-export-get-reference'."
(with-current-buffer (find-file-noselect file)
(org-with-point-at 1
(let ((org-link-search-must-match-exact-headline t))
(org-link-search (org-link-unescape search) nil t))
(org-link-search search nil t))
(and (org-at-heading-p)
(org-string-nw-p (org-entry-get (point) "CUSTOM_ID"))))))))
((not org-publish-cache)
@ -1186,8 +1184,7 @@ references with `org-export-get-reference'."
(let* ((filename (file-truename file))
(crossrefs
(org-publish-cache-get-file-property filename :crossrefs nil t))
(cells
(org-export-string-to-search-cell (org-link-unescape search))))
(cells (org-export-string-to-search-cell search)))
(or
;; Look for reference associated to search cells triggered by
;; LINK. It can match when targeted file has been published
@ -1314,8 +1311,9 @@ the file including them will be republished as well."
(unless visiting (kill-buffer buf)))))
(or (null pstamp)
(let ((ctime (org-publish-cache-ctime-of-src filename)))
(or (< pstamp ctime)
(cl-some (lambda (ct) (< ctime ct)) included-files-ctime))))))
(or (time-less-p pstamp ctime)
(cl-some (lambda (ct) (time-less-p ctime ct))
included-files-ctime))))))
(defun org-publish-cache-set-file-property
(filename property value &optional project-name)
@ -1365,8 +1363,8 @@ does not exist."
(let ((attr (file-attributes
(expand-file-name (or (file-symlink-p file) file)
(file-name-directory file)))))
(if (not attr) (error "No such file: \"%s\"" file)
(floor (float-time (file-attribute-modification-time attr))))))
(if attr (file-attribute-modification-time attr)
(error "No such file: %S" file))))
(provide 'ox-publish)

12
lisp/ox-texinfo.el
View File

@ -706,7 +706,7 @@ contextual information."
"Transcode a CENTER-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist used
as a communication channel."
contents)
(replace-regexp-in-string "\\(^\\).*?\\S-" "@center " contents nil nil 1))
;;;; Clock
@ -1253,13 +1253,21 @@ contextual information."
(if (string-prefix-p "@" i) i (concat "@" i))))
(table-type (plist-get attr :table-type))
(type (org-element-property :type plain-list))
(initial-counter
(and (eq type 'ordered)
;; Texinfo only supports initial counters, i.e., it
;; cannot change the numbering mid-list.
(let ((first-item (car (org-element-contents plain-list))))
(org-element-property :counter first-item))))
(list-type (cond
((eq type 'ordered) "enumerate")
((eq type 'unordered) "itemize")
((member table-type '("ftable" "vtable")) table-type)
(t "table"))))
(format "@%s\n%s@end %s"
(if (eq type 'descriptive) (concat list-type " " indic) list-type)
(cond ((eq type 'descriptive) (concat list-type " " indic))
(initial-counter (format "%s %d" list-type initial-counter))
(t list-type))
contents
list-type)))

83
lisp/ox.el
View File

@ -3216,7 +3216,7 @@ locally for the subtree through node properties."
(org-entry-put
node "EXPORT_OPTIONS" (mapconcat 'identity items " "))
(while items
(insert "#+OPTIONS:")
(insert "#+options:")
(let ((width 10))
(while (and items
(< (+ width (length (car items)) 1) fill-column))
@ -3242,7 +3242,7 @@ locally for the subtree through node properties."
(if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val)
(insert
(format "#+%s:%s\n"
(car key)
(downcase (car key))
(if (org-string-nw-p val) (format " %s" val) ""))))))))
(defun org-export-expand-include-keyword (&optional included dir footnotes)
@ -3300,7 +3300,7 @@ storing and resolving footnotes. It is created automatically."
(setq value (replace-match "" nil nil value)))))
(lines
(and (string-match
":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\""
":lines +\"\\([0-9]*-[0-9]*\\)\""
value)
(prog1 (match-string 1 value)
(setq value (replace-match "" nil nil value)))))
@ -3448,6 +3448,32 @@ Return a string of lines to be included in the format expected by
(while (< (point) end) (cl-incf counter) (forward-line))
counter))))))))
(defun org-export--update-included-link (file-dir includer-dir)
"Update relative file name of link at point, if possible.
FILE-DIR is the directory of the file being included.
INCLUDER-DIR is the directory of the file where the inclusion is
going to happen.
Move point after the link."
(let* ((link (org-element-link-parser))
(path (org-element-property :path link)))
(if (or (not (string= "file" (org-element-property :type link)))
(file-remote-p path)
(file-name-absolute-p path))
(goto-char (org-element-property :end link))
(let ((new-path (file-relative-name (expand-file-name path file-dir)
includer-dir))
(new-link (org-element-copy link))
(contents (and (org-element-property :contents-begin link)
(buffer-substring
(org-element-property :contents-begin link)
(org-element-property :contents-end link)))))
(org-element-put-property new-link :path new-path)
(delete-region (org-element-property :begin link)
(org-element-property :end link))
(insert (org-element-link-interpreter new-link contents))))))
(defun org-export--prepare-file-contents
(file &optional lines ind minlevel id footnotes includer)
"Prepare contents of FILE for inclusion and return it as a string.
@ -3500,27 +3526,32 @@ is to happen."
(goto-char (point-min))
(unless (eq major-mode 'org-mode)
(let ((org-inhibit-startup t)) (org-mode))) ;set regexps
(while (re-search-forward org-any-link-re nil t)
(let ((link (save-excursion (backward-char) (org-element-context))))
(when (and (eq 'link (org-element-type link))
(string= "file" (org-element-property :type link)))
(let ((old-path (org-element-property :path link)))
(unless (or (file-remote-p old-path)
(file-name-absolute-p old-path))
(let ((new-path (file-relative-name
(expand-file-name old-path file-dir)
includer-dir)))
(insert
(let ((new (org-element-copy link)))
(org-element-put-property new :path new-path)
(when (org-element-property :contents-begin link)
(org-element-adopt-elements new
(buffer-substring
(org-element-property :contents-begin link)
(org-element-property :contents-end link))))
(delete-region (org-element-property :begin link)
(org-element-property :end link))
(org-element-interpret-data new))))))))))))
(let ((regexp (concat org-plain-link-re "\\|" org-angle-link-re)))
(while (re-search-forward org-any-link-re nil t)
(let ((link (save-excursion
(forward-char -1)
(save-match-data (org-element-context)))))
(when (eq 'link (org-element-type link))
;; Look for file links within link's description.
;; Org doesn't support such construct, but
;; `org-export-insert-image-links' may activate
;; them.
(let ((contents-begin
(org-element-property :contents-begin link))
(begin (org-element-property :begin link)))
(when contents-begin
(save-excursion
(goto-char (org-element-property :contents-end link))
(while (re-search-backward regexp contents-begin t)
(save-match-data
(org-export--update-included-link
file-dir includer-dir))
(goto-char (match-beginning 0)))))
;; Update current link, if necessary.
(when (string= "file" (org-element-property :type link))
(goto-char begin)
(org-export--update-included-link
file-dir includer-dir))))))))))
;; Remove blank lines at beginning and end of contents. The logic
;; behind that removal is that blank lines around include keyword
;; override blank lines in included file.
@ -4164,7 +4195,7 @@ The function ignores links with an implicit type (e.g.,
(let ((protocol (org-link-get-parameter type :export)))
(and (functionp protocol)
(funcall protocol
(org-link-unescape (org-element-property :path link))
(org-element-property :path link)
desc
backend))))))
@ -4348,7 +4379,7 @@ Return value can be an object or an element:
Assume LINK type is \"fuzzy\". White spaces are not
significant."
(let* ((search-cells (org-export-string-to-search-cell
(org-link-unescape (org-element-property :path link))))
(org-element-property :path link)))
(link-cache (or (plist-get info :resolve-fuzzy-link-cache)
(let ((table (make-hash-table :test #'eq)))
(plist-put info :resolve-fuzzy-link-cache table)

15
testing/lisp/test-org-colview.el
View File

@ -510,10 +510,7 @@
(should
(equal
"0min"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time
(org-parse-time-string "<2014-03-04 Tue>")))))
(org-test-at-time "<2014-03-04 Tue>"
(org-test-with-temp-text
"* H
** S1
@ -529,10 +526,7 @@
(should
(equal
"2d"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time
(org-parse-time-string "<2014-03-04 Tue>")))))
(org-test-at-time "<2014-03-04 Tue>"
(org-test-with-temp-text
"* H
** S1
@ -548,10 +542,7 @@
(should
(equal
"1d 12h"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time
(org-parse-time-string "<2014-03-04 Tue>")))))
(org-test-at-time "<2014-03-04 Tue>"
(org-test-with-temp-text
"* H
** S1

3
testing/lisp/test-org-lint.el
View File

@ -240,6 +240,9 @@ This is not a node property
"Test `org-lint-non-existent-setupfile-parameter' checker."
(should
(org-test-with-temp-text "#+setupfile: Idonotexist.org"
(org-lint '(non-existent-setupfile-parameter))))
(should-not
(org-test-with-temp-text "#+setupfile: https://I.do/not.exist.org"
(org-lint '(non-existent-setupfile-parameter)))))
(ert-deftest test-org-lint/wrong-include-link-parameter ()

12
testing/lisp/test-org-list.el
View File

@ -270,6 +270,18 @@
(org-list-demote-modify-bullet '(("1." . "+"))))
(org-indent-item))
(buffer-string))))
(should
(equal "
a. Item 1
- Item 2"
(org-test-with-temp-text "
a. Item 1
b. Item 2<point>"
(let ((org-plain-list-ordered-item-terminator t)
(org-list-allow-alphabetical t)
(org-list-demote-modify-bullet '(("A." . "a.") ("a." . "-"))))
(org-indent-item))
(buffer-string))))
;; When a region is selected, indent every item within.
(should
(equal "

10
testing/lisp/test-org-protocol.el
View File

@ -35,6 +35,16 @@
(let ((data (org-protocol-parse-parameters "url=abc&title=def" t)))
(should (string= (plist-get data :url) "abc"))
(should (string= (plist-get data :title) "def")))
;; Parse new-style complex links
(let* ((url (concat "template=p&"
"url=https%3A%2F%2Forgmode.org%2Forg.html%23capture-protocol&"
"title=The%20Org%20Manual&"
"body=9.4.2%20capture%20protocol"))
(data (org-protocol-parse-parameters url)))
(should (string= (plist-get data :template) "p"))
(should (string= (plist-get data :url) "https://orgmode.org/org.html#capture-protocol"))
(should (string= (plist-get data :title) "The Org Manual"))
(should (string= (plist-get data :body) "9.4.2 capture protocol")))
;; Parse old-style links
(let ((data (org-protocol-parse-parameters "abc/def" nil '(:url :title))))
(should (string= (plist-get data :url) "abc"))

3
testing/lisp/test-org-timer.el
View File

@ -40,8 +40,7 @@ Also, mute output from `message'."
(defmacro test-org-timer/with-current-time (time &rest body)
"Run BODY, setting `current-time' output to TIME."
(declare (indent 1))
`(cl-letf (((symbol-function 'current-time) (lambda () ,time)))
,@body))
`(org-test-at-time ,time ,@body))
;;; Time conversion and formatting

91
testing/lisp/test-org.el
View File

@ -198,18 +198,14 @@
(should
(equal
"2015-03-04"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time (org-parse-time-string "2014-03-04")))))
(org-test-at-time "2014-03-04"
(org-read-date
t nil "+1y" nil
(apply #'encode-time (org-parse-time-string "2012-03-29"))))))
(should
(equal
"2013-03-29"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time (org-parse-time-string "2014-03-04")))))
(org-test-at-time "2014-03-04"
(org-read-date
t nil "++1y" nil
(apply #'encode-time (org-parse-time-string "2012-03-29"))))))
@ -219,25 +215,19 @@
(should
(equal
"2014-04-01"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time (org-parse-time-string "2014-03-04")))))
(org-test-at-time "2014-03-04"
(let ((org-read-date-prefer-future t))
(org-read-date t nil "1")))))
(should
(equal
"2013-03-04"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time (org-parse-time-string "2012-03-29")))))
(org-test-at-time "2012-03-29"
(let ((org-read-date-prefer-future t))
(org-read-date t nil "3-4")))))
(should
(equal
"2012-03-04"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time (org-parse-time-string "2012-03-29")))))
(org-test-at-time "2012-03-29"
(let ((org-read-date-prefer-future nil))
(org-read-date t nil "3-4")))))
;; When set to `org-read-date-prefer-future' is set to `time', read
@ -247,17 +237,13 @@
(should
(equal
"2012-03-30"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time (org-parse-time-string "2012-03-29 16:40")))))
(org-test-at-time "2012-03-29 16:40"
(let ((org-read-date-prefer-future 'time))
(org-read-date t nil "00:40" nil)))))
(should-not
(equal
"2012-03-30"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time (org-parse-time-string "2012-03-29 16:40")))))
(org-test-at-time "2012-03-29 16:40"
(let ((org-read-date-prefer-future 'time))
(org-read-date t nil "29 00:40" nil)))))
;; Caveat: `org-read-date-prefer-future' always refers to current
@ -265,9 +251,7 @@
(should
(equal
"2014-04-01"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time (org-parse-time-string "2014-03-04")))))
(org-test-at-time "2014-03-04"
(let ((org-read-date-prefer-future t))
(org-read-date
t nil "1" nil
@ -275,9 +259,7 @@
(should
(equal
"2014-03-25"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time (org-parse-time-string "2014-03-04")))))
(org-test-at-time "2014-03-04"
(let ((org-read-date-prefer-future t))
(org-read-date
t nil "25" nil
@ -376,11 +358,7 @@
(ert-deftest test-org/deadline-close-p ()
"Test `org-deadline-close-p' specifications."
;; Pretend that the current time is 2016-06-03 Fri 01:43
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time
(org-parse-time-string "2016-06-03 Fri 01:43")))))
(org-test-at-time "2016-06-03 Fri 01:43"
;; Timestamps are close if they are within `ndays' of lead time.
(org-test-with-temp-text "* Heading"
(should (org-deadline-close-p "2016-06-03 Fri" 0))
@ -1289,13 +1267,13 @@
(buffer-string))))
;; In the middle of a headline, split it if allowed.
(should
(equal "* H\n* 1\n"
(equal "* H\n* 1"
(org-test-with-temp-text "* H<point>1"
(let ((org-M-RET-may-split-line '((headline . t))))
(org-insert-heading))
(buffer-string))))
(should
(equal "* H1\n* \n"
(equal "* H1\n* "
(org-test-with-temp-text "* H<point>1"
(let ((org-M-RET-may-split-line '((headline . nil))))
(org-insert-heading))
@ -1303,19 +1281,19 @@
;; However, splitting cannot happen on TODO keywords, priorities or
;; tags.
(should
(equal "* TODO H1\n* \n"
(equal "* TODO H1\n* "
(org-test-with-temp-text "* TO<point>DO H1"
(let ((org-M-RET-may-split-line '((headline . t))))
(org-insert-heading))
(buffer-string))))
(should
(equal "* [#A] H1\n* \n"
(equal "* [#A] H1\n* "
(org-test-with-temp-text "* [#<point>A] H1"
(let ((org-M-RET-may-split-line '((headline . t))))
(org-insert-heading))
(buffer-string))))
(should
(equal "* H1 :tag:\n* \n"
(equal "* H1 :tag:\n* "
(org-test-with-temp-text "* H1 :ta<point>g:"
(let ((org-M-RET-may-split-line '((headline . t))))
(org-insert-heading))
@ -1342,14 +1320,14 @@
;; point.
(should
(equal
"* H1\n** H2\n* \n"
"* H1\n** H2\n* "
(org-test-with-temp-text "* H1\n** H2"
(let ((org-insert-heading-respect-content nil))
(org-insert-heading '(4)))
(buffer-string))))
(should
(equal
"* H1\n** H2\n* \n"
"* H1\n** H2\n* "
(org-test-with-temp-text "* H<point>1\n** H2"
(let ((org-insert-heading-respect-content nil))
(org-insert-heading '(4)))
@ -1357,7 +1335,7 @@
;; When called with two universal arguments, insert a new headline
;; at the end of the grandparent subtree.
(should
(equal "* H1\n** H3\n- item\n** H2\n** \n"
(equal "* H1\n** H3\n- item\n** H2\n** "
(org-test-with-temp-text "* H1\n** H3\n- item<point>\n** H2"
(let ((org-insert-heading-respect-content nil))
(org-insert-heading '(16)))
@ -1365,7 +1343,7 @@
;; When optional TOP-LEVEL argument is non-nil, always insert
;; a level 1 heading.
(should
(equal "* H1\n** H2\n* \n"
(equal "* H1\n** H2\n* "
(org-test-with-temp-text "* H1\n** H2<point>"
(org-insert-heading nil nil t)
(buffer-string))))
@ -1376,32 +1354,32 @@
(buffer-string))))
;; Obey `org-blank-before-new-entry'.
(should
(equal "* H1\n\n* \n"
(equal "* H1\n\n* "
(org-test-with-temp-text "* H1<point>"
(let ((org-blank-before-new-entry '((heading . t))))
(org-insert-heading))
(buffer-string))))
(should
(equal "* H1\n* \n"
(equal "* H1\n* "
(org-test-with-temp-text "* H1<point>"
(let ((org-blank-before-new-entry '((heading . nil))))
(org-insert-heading))
(buffer-string))))
(should
(equal "* H1\n* H2\n* \n"
(equal "* H1\n* H2\n* "
(org-test-with-temp-text "* H1\n* H2<point>"
(let ((org-blank-before-new-entry '((heading . auto))))
(org-insert-heading))
(buffer-string))))
(should
(equal "* H1\n\n* H2\n\n* \n"
(equal "* H1\n\n* H2\n\n* "
(org-test-with-temp-text "* H1\n\n* H2<point>"
(let ((org-blank-before-new-entry '((heading . auto))))
(org-insert-heading))
(buffer-string))))
;; Corner case: correctly insert a headline after an empty one.
(should
(equal "* \n* \n"
(equal "* \n* "
(org-test-with-temp-text "* <point>"
(org-insert-heading)
(buffer-string))))
@ -1427,7 +1405,7 @@
;; Properly handle empty lines when forcing a headline below current
;; one.
(should
(equal "* H1\n\n* H\n\n* \n"
(equal "* H1\n\n* H\n\n* "
(org-test-with-temp-text "* H1\n\n* H<point>"
(let ((org-blank-before-new-entry '((heading . t))))
(org-insert-heading '(4))
@ -1443,14 +1421,14 @@
;; Add headline at the end of the first subtree
(should
(equal
"* TODO \n"
"* TODO "
(org-test-with-temp-text "* H1\nH1Body<point>\n** H2\nH2Body"
(org-insert-todo-heading-respect-content)
(buffer-substring-no-properties (line-beginning-position) (point-max)))))
;; In a list, do not create a new item.
(should
(equal
"* TODO \n"
"* TODO "
(org-test-with-temp-text "* H\n- an item\n- another one"
(search-forward "an ")
(org-insert-todo-heading-respect-content)
@ -4847,10 +4825,7 @@ Paragraph<point>"
;; Accept delta time, e.g., "+2d".
(should
(equal "* H\nDEADLINE: <2015-03-04>\n"
(cl-letf (((symbol-function 'current-time)
(lambda (&rest args)
(apply #'encode-time
(org-parse-time-string "2014-03-04")))))
(org-test-at-time "2014-03-04"
(org-test-with-temp-text "* H"
(let ((org-adapt-indentation nil)
(org-last-inserted-timestamp nil))
@ -4964,10 +4939,7 @@ Paragraph<point>"
;; Accept delta time, e.g., "+2d".
(should
(equal "* H\nSCHEDULED: <2015-03-04>\n"
(cl-letf (((symbol-function 'current-time)
(lambda (&rest args)
(apply #'encode-time
(org-parse-time-string "2014-03-04")))))
(org-test-at-time "2014-03-04"
(org-test-with-temp-text "* H"
(let ((org-adapt-indentation nil)
(org-last-inserted-timestamp nil))
@ -6859,10 +6831,7 @@ CLOCK: [2012-03-29 Thu 10:00]--[2012-03-29 Thu 16:40] => 6:40"
(string-match
"Te<2014-03-04 .*? 00:41>xt"
(org-test-with-temp-text "Te<point>xt"
(cl-letf (((symbol-function 'current-time)
(lambda ()
(apply #'encode-time
(org-parse-time-string "2014-03-04 00:41")))))
(org-test-at-time "2014-03-04 00:41"
(org-time-stamp '(16))
(buffer-string)))))
;; When optional argument is non-nil, insert an inactive timestamp.

90
testing/lisp/test-ox.el
View File

@ -1363,7 +1363,7 @@ Footnotes[fn:2], foot[fn:test] and [fn:inline:inline footnote]
(org-export-expand-include-keyword)
(eq 3 (org-current-level)))))
(ert-deftest test-org/expand-include/links ()
(ert-deftest test-org-export/expand-include/links ()
"Test links modifications when including files."
;; Preserve relative plain links.
(should
@ -3037,7 +3037,93 @@ Para2"
(org-element-map
(org-export-insert-image-links tree info '(("file" . "xxx")))
'link
(lambda (l) (org-element-property :type l)))))))
(lambda (l) (org-element-property :type l))))))
;; If an image link was included from another file, make sure to
;; shift any relative path accordingly.
(should
(string-prefix-p
"file:org-includee-"
(let* ((subdir (make-temp-file "org-includee-" t))
(includee (expand-file-name "includee.org" subdir))
(includer (make-temp-file "org-includer-")))
(write-region "file:foo.png" nil includee)
(write-region (format "#+INCLUDE: %S"
(file-relative-name includee
temporary-file-directory))
nil includer)
(let ((buffer (find-file-noselect includer t)))
(unwind-protect
(with-current-buffer buffer
(org-export-as
(org-export-create-backend
:transcoders
'((section . (lambda (_s c _i) c))
(paragraph . (lambda (_p c _i) c))
(link . (lambda (l c _i) (org-element-link-interpreter l c))))
:filters
'((:filter-parse-tree
(lambda (d _b i) (org-export-insert-image-links d i)))))))
(when (buffer-live-p buffer)
(with-current-buffer buffer (set-buffer-modified-p nil))
(kill-buffer buffer))
(when (file-exists-p subdir) (delete-directory subdir t))
(when (file-exists-p includer) (delete-file includer)))))))
(should
(string-match-p
"file:org-includee-.+?foo\\.png"
(let* ((subdir (make-temp-file "org-includee-" t))
(includee (expand-file-name "includee.org" subdir))
(includer (make-temp-file "org-includer-")))
(write-region "[[https://orgmode.org][file:foo.png]]" nil includee)
(write-region (format "#+INCLUDE: %S"
(file-relative-name includee
temporary-file-directory))
nil includer)
(let ((buffer (find-file-noselect includer t)))
(unwind-protect
(with-current-buffer buffer
(org-export-as
(org-export-create-backend
:transcoders
'((section . (lambda (_s c _i) c))
(paragraph . (lambda (_p c _i) c))
(link . (lambda (l c _i) (org-element-link-interpreter l c))))
:filters
'((:filter-parse-tree
(lambda (d _b i) (org-export-insert-image-links d i)))))))
(when (buffer-live-p buffer)
(with-current-buffer buffer (set-buffer-modified-p nil))
(kill-buffer buffer))
(when (file-exists-p subdir) (delete-directory subdir t))
(when (file-exists-p includer) (delete-file includer)))))))
(should
(string-match-p
"file:org-includee.+?file:org-includee"
(let* ((subdir (make-temp-file "org-includee-" t))
(includee (expand-file-name "includee.org" subdir))
(includer (make-temp-file "org-includer-")))
(write-region "[[file:bar.png][file:foo.png]]" nil includee)
(write-region (format "#+INCLUDE: %S"
(file-relative-name includee
temporary-file-directory))
nil includer)
(let ((buffer (find-file-noselect includer t)))
(unwind-protect
(with-current-buffer buffer
(org-export-as
(org-export-create-backend
:transcoders
'((section . (lambda (_s c _i) c))
(paragraph . (lambda (_p c _i) c))
(link . (lambda (l c _i) (org-element-link-interpreter l c))))
:filters
'((:filter-parse-tree
(lambda (d _b i) (org-export-insert-image-links d i)))))))
(when (buffer-live-p buffer)
(with-current-buffer buffer (set-buffer-modified-p nil))
(kill-buffer buffer))
(when (file-exists-p subdir) (delete-directory subdir t))
(when (file-exists-p includer) (delete-file includer))))))))
(ert-deftest test-org-export/fuzzy-link ()
"Test fuzzy links specifications."

52
testing/org-test.el
View File

@ -418,6 +418,58 @@ Load all test files first."
(ert "\\(org\\|ob\\)")
(org-test-kill-all-examples))
(defmacro org-test-at-time (time &rest body)
"Run body while pretending that the current time is TIME.
TIME can be a non-nil Lisp time value, or a string specifying a date and time."
(declare (indent 1))
(let ((tm (cl-gensym))
(at (cl-gensym)))
`(let* ((,tm ,time)
(,at (if (stringp ,tm)
(apply #'encode-time (org-parse-time-string ,tm))
,tm)))
(cl-letf
;; Wrap builtins whose behavior can depend on the current time.
(((symbol-function 'current-time)
(lambda () ,at))
((symbol-function 'current-time-string)
(lambda (&optional time &rest args)
(apply ,(symbol-function 'current-time-string)
(or time ,at) args)))
((symbol-function 'current-time-zone)
(lambda (&optional time &rest args)
(apply ,(symbol-function 'current-time-zone)
(or time ,at) args)))
((symbol-function 'decode-time)
(lambda (&optional time) (funcall ,(symbol-function 'decode-time)
(or time ,at))))
((symbol-function 'encode-time)
(lambda (time &rest args)
(apply ,(symbol-function 'encode-time) (or time ,at) args)))
((symbol-function 'float-time)
(lambda (&optional time)
(funcall ,(symbol-function 'float-time) (or time ,at))))
((symbol-function 'format-time-string)
(lambda (format &optional time &rest args)
(apply ,(symbol-function 'format-time-string)
format (or time ,at) args)))
((symbol-function 'set-file-times)
(lambda (file &optional time)
(funcall ,(symbol-function 'set-file-times) file (or time ,at))))
((symbol-function 'time-add)
(lambda (a b) (funcall ,(symbol-function 'time-add)
(or a ,at) (or b ,at))))
((symbol-function 'time-equal-p)
(lambda (a b) (funcall ,(symbol-function 'time-equal-p)
(or a ,at) (or b ,at))))
((symbol-function 'time-less-p)
(lambda (a b) (funcall ,(symbol-function 'time-less-p)
(or a ,at) (or b ,at))))
((symbol-function 'time-subtract)
(lambda (a b) (funcall ,(symbol-function 'time-subtract)
(or a ,at) (or b ,at)))))
,@body))))
(provide 'org-test)
;;; org-test.el ends here