Merge branch 'maint' into emacs-sync

This commit is contained in:
Kyle Meyer 2017-06-19 21:27:55 -04:00
commit e5224694d3
21 changed files with 605 additions and 498 deletions

View File

@ -73,8 +73,8 @@
(defun org-gitbare-open (str)
(let* ((strlist (org-git-split-string str))
(gitdir (first strlist))
(object (second strlist)))
(gitdir (nth 0 strlist))
(object (nth 1 strlist)))
(org-git-open-file-internal gitdir object)))
@ -96,14 +96,18 @@
(defun org-git-open (str)
(let* ((strlist (org-git-split-string str))
(filepath (first strlist))
(commit (second strlist))
(line (third strlist))
(filepath (nth 0 strlist))
(commit (nth 1 strlist))
(line (nth 2 strlist))
(dirlist (org-git-find-gitdir (file-truename filepath)))
(gitdir (first dirlist))
(relpath (second dirlist)))
(gitdir (nth 0 dirlist))
(relpath (nth 1 dirlist)))
(org-git-open-file-internal gitdir (concat commit ":" relpath))
(when line (goto-line (string-to-int line)))))
(when line
(save-restriction
(widen)
(goto-char (point-min))
(forward-line (1- (string-to-number line)))))))
;; Utility functions (file names etc)
@ -122,15 +126,15 @@
the path. Example: (org-git-find-gitdir
\"~/gitrepos/foo/bar.txt\") returns
'(\"/home/user/gitrepos/.git\" \"foo/bar.txt\"). When not in a git repository, return nil."
(let ((dir (file-name-directory path))
(let ((dir (expand-file-name (file-name-directory path)))
(relpath (file-name-nondirectory path)))
(catch 'toplevel
(while (not (file-exists-p (expand-file-name ".git" dir)))
(let ((dirlist (org-git-split-dirpath dir)))
(when (string= (second dirlist) "") ; at top level
(when (string= (nth 1 dirlist) "") ; at top level
(throw 'toplevel nil))
(setq dir (first dirlist)
relpath (concat (file-name-as-directory (second dirlist)) relpath))))
(setq dir (nth 0 dirlist)
relpath (concat (file-name-as-directory (nth 1 dirlist)) relpath))))
(list (expand-file-name ".git" dir) relpath))))
@ -174,7 +178,7 @@ than two double colons, str2 and/or str3 may be set the empty string."
(defun org-git-create-git-link (file &optional line)
"Create git link part to file at specific time"
(interactive "FFile: ")
(let* ((gitdir (first (org-git-find-gitdir (file-truename file))))
(let* ((gitdir (nth 0 (org-git-find-gitdir (file-truename file))))
(branchname (org-git-get-current-branch gitdir))
(timestring (format-time-string "%Y-%m-%d" (current-time))))
(concat "git:" file "::" (org-git-create-searchstring branchname timestring)

View File

@ -252,7 +252,7 @@ If there is no such wiki target, return nil."
(defvar target-alist)
(defvar last-section-target)
(defvar org-export-target-aliases)
(defun org-wikinodes-set-wiki-targets-during-export ()
(defun org-wikinodes-set-wiki-targets-during-export (_)
(let ((line (buffer-substring (point-at-bol) (point-at-eol)))
(case-fold-search nil)
wtarget a)
@ -268,9 +268,8 @@ If there is no such wiki target, return nil."
(car org-export-target-aliases))))
(push (caar target-alist) (cdr a)))))
(defun org-wikinodes-process-links-for-export ()
(defun org-wikinodes-process-links-for-export (_)
"Process Wiki links in the export preprocess buffer.
Try to find target matches in the wiki scope and replace CamelCase words
with working links."
(let ((re org-wikinodes-camel-regexp)
@ -289,7 +288,7 @@ with working links."
(cond
((org-find-exact-headline-in-buffer link (current-buffer))
;; Found in current buffer
(insert (format "[[#%s][%s]]" link link)))
(insert (format "[[*%s][%s]]" link link)))
((eq org-wikinodes-scope 'file)
;; No match in file, and other files are not allowed
(insert (format "%s" link)))
@ -305,19 +304,18 @@ with working links."
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-wikinodes-clear-cache-when-on-target)
;; Make Wiki haeding create additional link names for headlines
(add-hook 'org-export-define-heading-targets-headline-hook
(add-hook 'org-export-before-parsing-hook
'org-wikinodes-set-wiki-targets-during-export)
;; Turn Wiki links into links the exporter will treat correctly
(add-hook 'org-export-preprocess-after-radio-targets-hook
(add-hook 'org-export-before-parsing-hook
'org-wikinodes-process-links-for-export)
;; Activate CamelCase words as part of Org mode font lock
(defun org-wikinodes-add-to-font-lock-keywords ()
"Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'."
(let ((m (member '(org-activate-plain-links (0 'org-link t))
org-font-lock-extra-keywords)))
(let ((m (member '(org-activate-links) org-font-lock-extra-keywords)))
(if m (push '(org-wikinodes-activate-links) (cdr m))
(message "Failed to add wikinodes to `org-font-lock-extra-keywords'."))))

View File

@ -11368,7 +11368,7 @@ The URL for the up link of exported HTML pages (@code{org-html-link-up}).
@vindex org-html-mathjax-options
Options for MathJax (@code{org-html-mathjax-options}). MathJax is used to
typeset @LaTeX{} math in HTML documents. @xref{Math formatting in HTML
export} for an example.
export}, for an example.
@item HTML_HEAD
@cindex #+HTML_HEAD

View File

@ -2131,13 +2131,12 @@ The following commands are available:
;; while letting `kill-all-local-variables' kill the rest
(let ((save (buffer-local-variables)))
(kill-all-local-variables)
(mapc 'make-local-variable org-agenda-local-vars)
(mapc #'make-local-variable org-agenda-local-vars)
(dolist (elem save)
(let ((var (car elem))
(val (cdr elem)))
(when (and val
(member var org-agenda-local-vars))
(set var val)))))
(pcase elem
(`(,var . ,val) ;ignore unbound variables
(when (and val (memq var org-agenda-local-vars))
(set var val))))))
(setq-local org-agenda-this-buffer-is-sticky t))
(org-agenda-sticky
;; Creating a sticky Agenda buffer for the first time
@ -2164,9 +2163,9 @@ The following commands are available:
(add-hook 'pre-command-hook 'org-unhighlight nil 'local)
;; Make sure properties are removed when copying text
(add-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(substring-no-properties (funcall fun start end delete)))
nil t)
(lambda (fun start end delete)
(substring-no-properties (funcall fun start end delete)))
nil t)
(unless org-agenda-keep-modes
(setq org-agenda-follow-mode org-agenda-start-with-follow-mode
org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode))
@ -3471,7 +3470,7 @@ removed from the entry content. Currently only `planning' is allowed here."
(insert txt)
(when org-agenda-add-entry-text-descriptive-links
(goto-char (point-min))
(while (org-activate-bracket-links (point-max))
(while (org-activate-links (point-max))
(add-text-properties (match-beginning 0) (match-end 0)
'(face org-link))))
(goto-char (point-min))
@ -3713,11 +3712,7 @@ FILTER-ALIST is an alist of filters we need to apply when
(let ((inhibit-read-only t))
(goto-char (point-min))
(save-excursion
(while (org-activate-bracket-links (point-max))
(add-text-properties (match-beginning 0) (match-end 0)
'(face org-link))))
(save-excursion
(while (org-activate-plain-links (point-max))
(while (org-activate-links (point-max))
(add-text-properties (match-beginning 0) (match-end 0)
'(face org-link))))
(unless (eq org-agenda-remove-tags t)
@ -4823,6 +4818,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(let* ((org-tags-match-list-sublevels
org-tags-match-list-sublevels)
(completion-ignore-case t)
(org--matcher-tags-todo-only todo-only)
rtn rtnall files file pos matcher
buffer)
(when (and (stringp match) (not (string-match "\\S-" match)))
@ -4837,8 +4833,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
;; Prepare agendas (and `org-tag-alist-for-agenda') before
;; expanding tags within `org-make-tags-matcher'
(org-agenda-prepare (concat "TAGS " match))
(setq org--matcher-tags-todo-only todo-only
matcher (org-make-tags-matcher match)
(setq matcher (org-make-tags-matcher match)
match (car matcher)
matcher (cdr matcher))
(org-compile-prefix-format 'tags)

View File

@ -723,16 +723,6 @@ captured item after finalizing."
(kill-region m1 m2))
(setq abort-note 'dirty)))
;; Make sure that the empty lines after are correct
(when (and (> (point-max) end) ; indeed, the buffer was still narrowed
(member (org-capture-get :type 'local)
'(entry item checkitem plain)))
(save-excursion
(goto-char end)
(or (bolp) (newline))
(org-capture-empty-lines-after
(or (org-capture-get :empty-lines-after 'local)
(org-capture-get :empty-lines 'local) 0))))
;; Postprocessing: Update Statistics cookies, do the sorting
(when (derived-mode-p 'org-mode)
(save-excursion
@ -1068,48 +1058,38 @@ may have been stored before."
(defun org-capture-place-entry ()
"Place the template as a new Org entry."
(let* ((txt (org-capture-get :template))
(reversed (org-capture-get :prepend))
(target-entry-p (org-capture-get :target-entry-p))
level beg end)
(and (org-capture-get :exact-position)
(goto-char (org-capture-get :exact-position)))
(let ((reversed? (org-capture-get :prepend))
level)
(when (org-capture-get :exact-position)
(goto-char (org-capture-get :exact-position)))
(cond
((not target-entry-p)
;; Insert as top-level entry, either at beginning or at end of
;; file.
(setq level 1)
(if reversed
(progn (goto-char (point-min))
(or (org-at-heading-p)
(outline-next-heading)))
(goto-char (point-max))
(or (bolp) (insert "\n"))))
(t
;; Insert as a child of the current entry
(and (looking-at "\\*+")
(setq level (- (match-end 0) (match-beginning 0))))
(setq level (org-get-valid-level (or level 1) 1))
(if reversed
(progn
(outline-next-heading)
(or (bolp) (insert "\n")))
(org-end-of-subtree t nil)
(or (bolp) (insert "\n")))))
;; Insert as a child of the current entry.
((org-capture-get :target-entry-p)
(setq level (org-get-valid-level
(if (org-at-heading-p) (org-outline-level) 1)
1))
(if reversed? (outline-next-heading) (org-end-of-subtree t)))
;; Insert as a top-level entry at the beginning of the file.
(reversed?
(goto-char (point-min))
(unless (org-at-heading-p) (outline-next-heading)))
;; Otherwise, insert as a top-level entry at the end of the file.
(t (goto-char (point-max))))
(unless (bolp) (insert "\n"))
(org-capture-empty-lines-before)
(setq beg (point))
(org-capture-verify-tree txt)
(org-paste-subtree level txt 'for-yank)
(org-capture-empty-lines-after 1)
(org-capture-position-for-last-stored beg)
(outline-next-heading)
(setq end (point))
(org-capture-mark-kill-region beg (1- end))
(org-capture-narrow beg (1- end))
(if (or (re-search-backward "%\\?" beg t)
(re-search-forward "%\\?" end t))
(replace-match ""))))
(let ((beg (point))
(template (org-capture-get :template)))
(org-capture-verify-tree template)
(org-paste-subtree level template 'for-yank)
(org-capture-empty-lines-after)
(org-capture-position-for-last-stored beg)
(unless (org-at-heading-p) (outline-next-heading))
(let ((end (point)))
(org-capture-mark-kill-region beg end)
(org-capture-narrow beg end)
(when (or (re-search-backward "%\\?" beg t)
(re-search-forward "%\\?" end t))
(replace-match ""))))))
(defun org-capture-place-item ()
"Place the template as a new plain list item."
@ -1161,7 +1141,7 @@ may have been stored before."
"\n"))
;; Insert item.
(insert txt)
(org-capture-empty-lines-after 1)
(org-capture-empty-lines-after)
(org-capture-position-for-last-stored beg)
(forward-char 1)
(setq end (point))
@ -1282,7 +1262,7 @@ Of course, if exact position has been required, just put it there."
(org-capture-empty-lines-before)
(setq beg (point))
(insert txt)
(org-capture-empty-lines-after 1)
(org-capture-empty-lines-after)
(org-capture-position-for-last-stored beg)
(setq end (point))
(org-capture-mark-kill-region beg (1- end))
@ -1366,7 +1346,7 @@ Point will remain at the first line after the inserted text."
(let* ((template (org-capture-get :template))
(type (org-capture-get :type))
beg end pp)
(or (bolp) (newline))
(unless (bolp) (insert "\n"))
(setq beg (point))
(cond
((and (eq type 'entry) (derived-mode-p 'org-mode))
@ -1388,13 +1368,16 @@ Point will remain at the first line after the inserted text."
(org-capture-empty-lines-after)
(goto-char beg)
(org-list-repair)
(org-end-of-item)
(setq end (point)))
(t (insert template)))
(org-end-of-item))
(t
(insert template)
(org-capture-empty-lines-after)
(skip-chars-forward " \t\n")
(unless (eobp) (beginning-of-line))))
(setq end (point))
(goto-char beg)
(if (re-search-forward "%\\?" end t)
(replace-match ""))))
(when (re-search-forward "%\\?" end t)
(replace-match ""))))
(defun org-capture-set-plist (entry)
"Initialize the property list from the template definition."

View File

@ -322,7 +322,8 @@ For more information, see `org-clocktable-write-default'."
("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at")
("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à")
("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at")
("de" "Datei" "N" "Timestamp" "Tätigkeit" "Dauer" "ALLES" "Gesamtdauer" "Datei Zeit" "Erstellt am"))
("de" "Datei" "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT"
"Gesamtdauer" "Dateizeit" "Erstellt am"))
"Terms used in clocktable, translated to different languages."
:group 'org-clocktable
:version "24.1"
@ -2474,8 +2475,20 @@ from the dynamic block definition."
(level? (and (not compact?) (plist-get params :level)))
(timestamp (plist-get params :timestamp))
(properties (plist-get params :properties))
(time-columns (if compact? 1
(min maxlevel (or (plist-get params :tcolumns) 100))))
(time-columns
(if (or compact? (< maxlevel 2)) 1
;; Deepest headline level is a hard limit for the number
;; of time columns.
(let ((levels
(cl-mapcan
(lambda (table)
(pcase table
(`(,_ ,(and (pred wholenump) (pred (/= 0))) ,entries)
(mapcar #'car entries))))
tables)))
(min maxlevel
(or (plist-get params :tcolumns) 100)
(if (null levels) 1 (apply #'max levels))))))
(indent (or compact? (plist-get params :indent)))
(formula (plist-get params :formula))
(case-fold-search t)
@ -2592,7 +2605,7 @@ from the dynamic block definition."
;; Get the list of node entries and iterate over it
(when (> maxlevel 0)
(pcase-dolist (`(,level ,headline ,ts ,time . ,props) entries)
(pcase-dolist (`(,level ,headline ,ts ,time ,props) entries)
(when narrow-cut-p
(setq headline
(if (and (string-match

View File

@ -223,21 +223,24 @@ See `org-columns-summary-types' for details.")
(defun org-columns--displayed-value (spec value)
"Return displayed value for specification SPEC in current entry.
SPEC is a column format specification as stored in
`org-columns-current-fmt-compiled'. VALUE is the real value to
display, as a string."
(cond
((and (functionp org-columns-modify-value-for-display-function)
(funcall org-columns-modify-value-for-display-function
(nth 1 spec)
value)))
((equal (car spec) "ITEM")
(concat (make-string (1- (org-current-level))
(if org-hide-leading-stars ?\s ?*))
"* "
(org-columns-compact-links value)))
(value)))
(or (and (functionp org-columns-modify-value-for-display-function)
(funcall org-columns-modify-value-for-display-function
(nth 1 spec) ;column name
value))
(pcase spec
(`("ITEM" . ,_)
(concat (make-string (1- (org-current-level))
(if org-hide-leading-stars ?\s ?*))
"* "
(org-columns-compact-links value)))
(`(,_ ,_ ,_ ,_ nil) value)
;; If PRINTF is set, assume we are displaying a number and
;; obey to the format string.
(`(,_ ,_ ,_ ,_ ,printf) (format printf (string-to-number value)))
(_ (error "Invalid column specification format: %S" spec)))))
(defun org-columns--collect-values (&optional compiled-fmt)
"Collect values for columns on the current line.
@ -778,6 +781,7 @@ view for the whole buffer unconditionally.
When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(interactive "P")
(org-columns-remove-overlays)
(when global (goto-char (point-min)))
(move-marker org-columns-begin-marker (point))
(org-columns-goto-top-level)
;; Initialize `org-columns-current-fmt' and
@ -1165,8 +1169,13 @@ properties drawers."
;; When PROPERTY exists in current node, even if empty,
;; but its value doesn't match the one computed, use
;; the latter instead.
(when (and update value (not (equal value summary)))
(org-entry-put (point) property summary)))
;;
;; Ignore leading or trailing white spaces that might
;; have been introduced in summary, since those are not
;; significant in properties value.
(let ((new-value (org-trim summary)))
(when (and update value (not (equal value new-value)))
(org-entry-put (point) property new-value))))
;; Add current to current level accumulator.
(when (or summary value-set)
(push (or summary value) (aref lvals level)))
@ -1223,14 +1232,17 @@ When PRINTF is non-nil, use it to format the result."
(defun org-columns--summary-checkbox-count (check-boxes _)
"Summarize CHECK-BOXES with a check-box cookie."
(format "[%d/%d]"
(cl-count "[X]" check-boxes :test #'equal)
(cl-count-if (lambda (b) (or (equal b "[X]")
(string-match-p "\\[\\([1-9]\\)/\\1\\]" b)))
check-boxes)
(length check-boxes)))
(defun org-columns--summary-checkbox-percent (check-boxes _)
"Summarize CHECK-BOXES with a check-box percent."
(format "[%d%%]"
(round (* 100.0 (cl-count "[X]" check-boxes :test #'equal))
(float (length check-boxes)))))
(round (* 100.0 (cl-count-if (lambda (b) (member b '("[X]" "[100%]")))
check-boxes))
(length check-boxes))))
(defun org-columns--summary-min (values printf)
"Compute the minimum of VALUES.
@ -1288,7 +1300,7 @@ When PRINTF is non-nil, use it to format the result."
(/ (apply #'+ (mapcar #'org-columns--age-to-seconds ages))
(float (length ages)))))
(defun org-columns--summary-estimate (estimates printf)
(defun org-columns--summary-estimate (estimates _)
"Combine a list of estimates, using mean and variance.
The mean and variance of the result will be the sum of the means
and variances (respectively) of the individual estimates."
@ -1303,8 +1315,8 @@ and variances (respectively) of the individual estimates."
(`(,value) (cl-incf mean value))))
(let ((sd (sqrt var)))
(format "%s-%s"
(format (or printf "%.0f") (- mean sd))
(format (or printf "%.0f") (+ mean sd))))))
(format "%.0f" (- mean sd))
(format "%.0f" (+ mean sd))))))

View File

@ -849,7 +849,7 @@ CONTENTS is the contents of the element."
(format "#+BEGIN: %s%s\n%s#+END:"
(org-element-property :block-name dynamic-block)
(let ((args (org-element-property :arguments dynamic-block)))
(and args (concat " " args)))
(if args (concat " " args) ""))
contents))

View File

@ -2837,7 +2837,8 @@ Return t at each successful move."
(t (user-error "Cannot move item"))))
t))))
(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
(defun org-sort-list
(&optional with-case sorting-type getkey-func compare-func interactive?)
"Sort list items.
The cursor may be at any item of the list that should be sorted.
Sublists are not sorted. Checkboxes, if any, are ignored.
@ -2863,13 +2864,15 @@ Capital letters will reverse the sort order.
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
a function to be called with point at the beginning of the
record. It must return either a string or a number that should
serve as the sorting key for that record. It will then use
COMPARE-FUNC to compare entries.
record. It must return a value that is compatible with COMPARE-FUNC,
the function used to compare entries.
Sorting is done against the visible part of the headlines, it
ignores hidden links."
(interactive "P")
ignores hidden links.
A non-nil value for INTERACTIVE? is used to signal that this
function is being called interactively."
(interactive (list current-prefix-arg nil nil nil t))
(let* ((case-func (if with-case 'identity 'downcase))
(struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
@ -2881,23 +2884,31 @@ ignores hidden links."
(message
"Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:")
(read-char-exclusive))))
(dcst (downcase sorting-type))
(getkey-func
(or getkey-func
(and (= (downcase sorting-type) ?f)
(intern (completing-read "Sort using function: "
obarray 'fboundp t nil nil))))))
(and (= dcst ?f)
(or getkey-func
(and interactive?
(org-read-function "Function for extracting keys: "))
(error "Missing key extractor"))))
(sort-func
(cond
((= dcst ?a) #'string<)
((= dcst ?f)
(or compare-func
(and interactive?
(org-read-function
(concat "Function for comparing keys "
"(empty for default `sort-subr' predicate): ")
'allow-empty))))
((= dcst ?t) #'<)
((= dcst ?x) #'string<))))
(message "Sorting items...")
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
(let* ((dcst (downcase sorting-type))
(case-fold-search nil)
(let* ((case-fold-search nil)
(now (current-time))
(sort-func (cond
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
((= dcst ?t) '<)
((= dcst ?x) 'string<)))
(next-record (lambda ()
(skip-chars-forward " \r\t\n")
(or (eobp) (beginning-of-line))))

View File

@ -49,11 +49,7 @@
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-map "org-element"
(data types fun &optional info first-match no-recursion
with-affiliated))
(declare-function org-element-parse-buffer "org-element"
(&optional granularity visible-only))
(declare-function org-element-macro-parser "org-element" ())
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-file-contents "org" (file &optional noerror))
@ -189,55 +185,53 @@ found in the buffer with no definition in TEMPLATES.
Optional argument KEYWORDS, when non-nil is a list of keywords,
as strings, where macro expansion is allowed."
(org-with-wide-buffer
(goto-char (point-min))
(let ((properties-regexp
(format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords)))
record)
(while (re-search-forward "{{{[-A-Za-z0-9_]" nil t)
(let* ((datum (save-match-data (org-element-context)))
(type (org-element-type datum))
(macro
(cond
((eq type 'macro) datum)
;; In parsed keywords and associated node properties,
;; force macro recognition.
((or (and (eq type 'keyword)
(member (org-element-property :key datum) keywords))
(and (eq type 'node-property)
(string-match-p
properties-regexp
(org-element-property :key datum))))
(save-restriction
(narrow-to-region (match-beginning 0) (line-end-position))
(org-element-map (org-element-parse-buffer) 'macro
#'identity nil t))))))
(when macro
(let* ((value (org-macro-expand macro templates))
(begin (org-element-property :begin macro))
(signature (list begin
macro
(org-element-property :args macro))))
;; Avoid circular dependencies by checking if the same
;; macro with the same arguments is expanded at the same
;; position twice.
(cond ((member signature record)
(error "Circular macro expansion: %s"
(org-element-property :key macro)))
(value
(push signature record)
(delete-region
begin
;; Preserve white spaces after the macro.
(progn (goto-char (org-element-property :end macro))
(skip-chars-backward " \t")
(point)))
;; Leave point before replacement in case of
;; recursive expansions.
(save-excursion (insert value)))
(finalize
(error "Undefined Org macro: %s; aborting"
(org-element-property :key macro)))))))))))
(save-excursion
(goto-char (point-min))
(let ((properties-regexp
(format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords)))
record)
(while (re-search-forward "{{{[-A-Za-z0-9_]" nil t)
(let* ((datum (save-match-data (org-element-context)))
(type (org-element-type datum))
(macro
(cond
((eq type 'macro) datum)
;; In parsed keywords and associated node properties,
;; force macro recognition.
((or (and (eq type 'keyword)
(member (org-element-property :key datum) keywords))
(and (eq type 'node-property)
(string-match-p properties-regexp
(org-element-property :key datum))))
(save-excursion
(goto-char (match-beginning 0))
(org-element-macro-parser))))))
(when macro
(let* ((value (org-macro-expand macro templates))
(begin (org-element-property :begin macro))
(signature (list begin
macro
(org-element-property :args macro))))
;; Avoid circular dependencies by checking if the same
;; macro with the same arguments is expanded at the same
;; position twice.
(cond ((member signature record)
(error "Circular macro expansion: %s"
(org-element-property :key macro)))
(value
(push signature record)
(delete-region
begin
;; Preserve white spaces after the macro.
(progn (goto-char (org-element-property :end macro))
(skip-chars-backward " \t")
(point)))
;; Leave point before replacement in case of
;; recursive expansions.
(save-excursion (insert value)))
(finalize
(error "Undefined Org macro: %s; aborting"
(org-element-property :key macro)))))))))))
(defun org-macro-escape-arguments (&rest args)
"Build macro's arguments string from ARGS.

View File

@ -294,6 +294,16 @@ removed."
(substring string (length pre) (- (length post)))
string))
(defun org-read-function (prompt &optional allow-empty?)
"Prompt for a function.
If ALLOW-EMPTY? is non-nil, return nil rather than raising an
error when the user input is empty."
(let ((func (completing-read prompt obarray #'fboundp t)))
(cond ((not (string= func ""))
(intern func))
(allow-empty? nil)
(t (user-error "Empty input is not valid")))))
(provide 'org-macs)
;;; org-macs.el ends here

View File

@ -1647,7 +1647,8 @@ In particular, this does handle wide and invisible characters."
dline -1 dline))))
;;;###autoload
(defun org-table-sort-lines (with-case &optional sorting-type getkey-func compare-func)
(defun org-table-sort-lines
(&optional with-case sorting-type getkey-func compare-func interactive?)
"Sort table lines according to the column at point.
The position of point indicates the column to be used for
@ -1671,12 +1672,13 @@ any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that
sorting should be done in reverse order.
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
a function to be called to extract the key. It must return either
a string or a number that should serve as the sorting key for that
row. It will then use COMPARE-FUNC to compare entries. If GETKEY-FUNC
is specified interactively, the comparison will be either a string or
numeric compare based on the type of the first key in the table."
(interactive "P")
a function to be called to extract the key. It must return a value
that is compatible with COMPARE-FUNC, the function used to compare
entries.
A non-nil value for INTERACTIVE? is used to signal that this
function is being called interactively."
(interactive (list current-prefix-arg nil nil nil t))
(when (org-region-active-p) (goto-char (region-beginning)))
;; Point must be either within a field or before a data line.
(save-excursion
@ -1686,7 +1688,7 @@ numeric compare based on the type of the first key in the table."
;; Set appropriate case sensitivity and column used for sorting.
(let ((column (let ((c (org-table-current-column)))
(cond ((> c 0) c)
((called-interactively-p 'any)
(interactive?
(read-number "Use column N for sorting: "))
(t 1))))
(sorting-type
@ -1734,17 +1736,21 @@ numeric compare based on the type of the first key in the table."
(t 0))))
((?f ?F)
(or getkey-func
(and (called-interactively-p 'any)
(intern
(completing-read "Sort using function: "
obarray #'fboundp t)))
(and interactive?
(org-read-function "Function for extracting keys: "))
(error "Missing key extractor to sort rows")))
(t (user-error "Invalid sorting type `%c'" sorting-type))))
(predicate
(cl-case sorting-type
((?n ?N ?t ?T) #'<)
((?a ?A) #'string<)
((?f ?F) compare-func))))
((?f ?F)
(or compare-func
(and interactive?
(org-read-function
(concat "Fuction for comparing keys "
"(empty for default `sort-subr' predicate): ")
'allow-empty)))))))
(goto-char (point-min))
(sort-subr (memq sorting-type '(?A ?N ?T ?F))
(lambda ()

View File

@ -137,6 +137,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-element-copy "org-element" (datum))
(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-element-link-parser "org-element" ())
(declare-function org-element-nested-p "org-element" (elem-a elem-b))
(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
(declare-function org-element-property "org-element" (property element))
@ -5847,7 +5848,7 @@ This should be called after the variable `org-link-parameters' has changed."
org-plain-link-re
(concat
"\\<" types-re ":"
"\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")
"\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")
;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
org-bracket-link-regexp
"\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
@ -5956,62 +5957,71 @@ prompted for."
(defsubst org-rear-nonsticky-at (pos)
(add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
(defun org-activate-plain-links (limit)
"Add link properties for plain links."
(when (and (re-search-forward org-plain-link-re limit t)
(not (org-in-src-block-p)))
(let* ((face (get-text-property (max (1- (match-beginning 0)) (point-min))
'face))
(link (match-string-no-properties 0))
(type (match-string-no-properties 1))
(path (match-string-no-properties 2))
(link-start (match-beginning 0))
(link-end (match-end 0))
(link-face (org-link-get-parameter type :face))
(help-echo (org-link-get-parameter type :help-echo))
(htmlize-link (org-link-get-parameter type :htmlize-link))
(activate-func (org-link-get-parameter type :activate-func)))
(unless (if (consp face) (memq 'org-tag face) (eq 'org-tag face))
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(add-text-properties (match-beginning 0) (match-end 0)
(list
'mouse-face (or (org-link-get-parameter type :mouse-face)
'highlight)
'face (cond
;; A function that returns a face
((functionp link-face)
(funcall link-face path))
;; a face
((facep link-face)
link-face)
;; An anonymous face
((consp link-face)
link-face)
;; default
(t
'org-link))
'help-echo (cond
((stringp help-echo)
help-echo)
((functionp help-echo)
help-echo)
(t
(concat "LINK: "
(save-match-data
(org-link-unescape link)))))
'htmlize-link (cond
((functionp htmlize-link)
(funcall htmlize-link path))
(t
`(:uri ,link)))
'keymap (or (org-link-get-parameter type :keymap)
org-mouse-map)
'org-link-start (match-beginning 0)))
(org-rear-nonsticky-at (match-end 0))
(when activate-func
(funcall activate-func link-start link-end path nil))
t))))
(defun org-activate-links (limit)
"Add link properties to links.
This includes angle, plain, and bracket links."
(catch :exit
(while (re-search-forward org-any-link-re limit t)
(let* ((start (match-beginning 0))
(end (match-end 0))
(type (cond ((eq ?< (char-after start)) 'angle)
((eq ?\[ (char-after (1+ start))) 'bracket)
(t 'plain))))
(when (and (memq type org-highlight-links)
;; Do not confuse plain links with tags.
(not (and (eq type 'plain)
(let ((face (get-text-property
(max (1- start) (point-min)) 'face)))
(if (consp face) (memq 'org-tag face)
(eq 'org-tag face))))))
(let* ((link-object (save-excursion
(goto-char start)
(save-match-data (org-element-link-parser))))
(link (org-element-property :raw-link link-object))
(path (org-element-property :path link-object))
(properties ;for link's visible part
(list
'face (pcase (org-link-get-parameter type :face)
((and (pred functionp) face) (funcall face path))
((and (pred facep) face) face)
((and (pred consp) face) face) ;anonymous
(_ 'org-link))
'mouse-face (or (org-link-get-parameter type :mouse-face)
'highlight)
'keymap (or (org-link-get-parameter type :keymap)
org-mouse-map)
'help-echo (pcase (org-link-get-parameter type :help-echo)
((and (pred stringp) echo) echo)
((and (pred functionp) echo) echo)
(_ (concat "LINK: " link)))
'htmlize-link (pcase (org-link-get-parameter type
:htmlize-link)
((and (pred functionp) f) (funcall f))
(_ `(:uri ,link)))
'font-lock-multiline t)))
(org-remove-flyspell-overlays-in start end)
(org-rear-nonsticky-at end)
(if (not (eq 'bracket type))
(add-text-properties start end properties)
;; Handle invisible parts in bracket links.
(remove-text-properties start end '(invisible nil))
(let ((hidden
(append `(invisible
,(or (org-link-get-parameter type :display)
'org-link))
properties))
(visible-start (or (match-beginning 4) (match-beginning 2)))
(visible-end (or (match-end 4) (match-end 2))))
(add-text-properties start visible-start hidden)
(add-text-properties visible-start visible-end properties)
(add-text-properties visible-end end hidden)
(org-rear-nonsticky-at visible-start)
(org-rear-nonsticky-at visible-end)))
(let ((f (org-link-get-parameter type :activate-func)))
(when (functionp f)
(funcall f start end path (eq type 'bracket))))
(throw :exit t))))) ;signal success
nil))
(defun org-activate-code (limit)
(when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
@ -6166,18 +6176,6 @@ by a #."
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
t))
(defun org-activate-angle-links (limit)
"Add text properties for angle links."
(when (and (re-search-forward org-angle-link-re limit t)
(not (org-in-src-block-p)))
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(add-text-properties (match-beginning 0) (match-end 0)
(list 'mouse-face 'highlight
'keymap org-mouse-map
'font-lock-multiline t))
(org-rear-nonsticky-at (match-end 0))
t))
(defun org-activate-footnote-links (limit)
"Add text properties for footnotes."
(let ((fn (org-footnote-next-reference-or-definition limit)))
@ -6201,96 +6199,6 @@ by a #."
'font-lock-multiline t
'face 'org-footnote))))))
(defun org-activate-bracket-links (limit)
"Add text properties for bracketed links."
(when (and (re-search-forward org-bracket-link-regexp limit t)
(not (org-in-src-block-p)))
(let* ((hl (save-match-data
(org-link-expand-abbrev (match-string-no-properties 1))))
(type (save-match-data
(and (string-match org-plain-link-re hl)
(match-string-no-properties 1 hl))))
(path (save-match-data
(and (string-match org-plain-link-re hl)
(match-string-no-properties 2 hl))))
(link-start (match-beginning 0))
(link-end (match-end 0))
(bracketp t)
(help-echo (org-link-get-parameter type :help-echo))
(help (cond
((stringp help-echo)
help-echo)
((functionp help-echo)
help-echo)
(t
(concat "LINK: "
(save-match-data
(org-link-unescape hl))))))
(link-face (org-link-get-parameter type :face))
(face (cond
;; A function that returns a face
((functionp link-face)
(funcall link-face path))
;; a face
((facep link-face)
link-face)
;; An anonymous face
((consp link-face)
link-face)
;; default
(t
'org-link)))
(keymap (or (org-link-get-parameter type :keymap)
org-mouse-map))
(mouse-face (or (org-link-get-parameter type :mouse-face)
'highlight))
(htmlize (org-link-get-parameter type :htmlize-link))
(htmlize-link (cond
((functionp htmlize)
(funcall htmlize))
(t
`(:uri ,(format "%s:%s" type path)))))
(activate-func (org-link-get-parameter type :activate-func))
;; invisible part
(ip (list 'invisible (or
(org-link-get-parameter type :display)
'org-link)
'face face
'keymap keymap
'mouse-face mouse-face
'font-lock-multiline t
'help-echo help
'htmlize-link htmlize-link))
;; visible part
(vp (list 'keymap keymap
'face face
'mouse-face mouse-face
'font-lock-multiline t
'help-echo help
'htmlize-link htmlize-link)))
;; We need to remove the invisible property here. Table narrowing
;; may have made some of this invisible.
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(remove-text-properties (match-beginning 0) (match-end 0)
'(invisible nil))
(if (match-end 3)
(progn
(add-text-properties (match-beginning 0) (match-beginning 3) ip)
(org-rear-nonsticky-at (match-beginning 3))
(add-text-properties (match-beginning 3) (match-end 3) vp)
(org-rear-nonsticky-at (match-end 3))
(add-text-properties (match-end 3) (match-end 0) ip)
(org-rear-nonsticky-at (match-end 0)))
(add-text-properties (match-beginning 0) (match-beginning 1) ip)
(org-rear-nonsticky-at (match-beginning 1))
(add-text-properties (match-beginning 1) (match-end 1) vp)
(org-rear-nonsticky-at (match-end 1))
(add-text-properties (match-end 1) (match-end 0) ip)
(org-rear-nonsticky-at (match-end 0)))
(when activate-func
(funcall activate-func link-start link-end path bracketp))
t)))
(defun org-activate-dates (limit)
"Add text properties for dates."
(when (and (re-search-forward org-tsr-regexp-both limit t)
@ -6557,11 +6465,9 @@ needs to be inserted at a specific position in the font-lock sequence.")
(list org-property-re
'(1 'org-special-keyword t)
'(3 'org-property-value t))
;; Links
;; Link related fontification.
'(org-activate-links)
(when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
(when (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
(when (memq 'plain lk) '(org-activate-plain-links (0 'org-link)))
(when (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link)))
(when (memq 'radio lk) '(org-activate-target-links (1 'org-link t)))
(when (memq 'date lk) '(org-activate-dates (0 'org-date t)))
(when (memq 'footnote lk) '(org-activate-footnote-links))
@ -9090,7 +8996,8 @@ hook gets called. When a region or a plain list is sorted, the cursor
will be in the first entry of the sorted region/list.")
(defun org-sort-entries
(&optional with-case sorting-type getkey-func compare-func property)
(&optional with-case sorting-type getkey-func compare-func property
interactive?)
"Sort entries on a certain level of an outline tree.
If there is an active region, the entries in the region are sorted.
Else, if the cursor is before the first entry, sort the top-level items.
@ -9120,8 +9027,9 @@ t By date/time, either the first active time stamp in the entry, or, if
Capital letters will reverse the sort order.
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
called with point at the beginning of the record. It must return either
a string or a number that should serve as the sorting key for that record.
called with point at the beginning of the record. It must return a
value that is compatible with COMPARE-FUNC, the function used to
compare entries.
Comparing entries ignores case by default. However, with an optional argument
WITH-CASE, the sorting considers case as well.
@ -9129,8 +9037,11 @@ WITH-CASE, the sorting considers case as well.
Sorting is done against the visible part of the headlines, it ignores hidden
links.
When sorting is done, call `org-after-sorting-entries-or-items-hook'."
(interactive "P")
When sorting is done, call `org-after-sorting-entries-or-items-hook'.
A non-nil value for INTERACTIVE? is used to signal that this
function is being called interactively."
(interactive (list current-prefix-arg nil nil nil nil t))
(let ((case-func (if with-case 'identity 'downcase))
(cmstr
;; The clock marker is lost when using `sort-subr', let's
@ -9199,21 +9110,22 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
[t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing
A/N/P/R/O/F/T/S/D/C/K means reversed:"
what)
(setq sorting-type (read-char-exclusive))
(setq sorting-type (read-char-exclusive)))
(unless getkey-func
(and (= (downcase sorting-type) ?f)
(setq getkey-func
(completing-read "Sort using function: "
obarray 'fboundp t nil nil))
(setq getkey-func (intern getkey-func))))
(unless getkey-func
(and (= (downcase sorting-type) ?f)
(setq getkey-func
(or (and interactive?
(org-read-function
"Function for extracting keys: "))
(error "Missing key extractor")))))
(and (= (downcase sorting-type) ?r)
(not property)
(setq property
(completing-read "Property: "
(mapcar #'list (org-buffer-property-keys t))
nil t))))
(and (= (downcase sorting-type) ?r)
(not property)
(setq property
(completing-read "Property: "
(mapcar #'list (org-buffer-property-keys t))
nil t)))
(when (member sorting-type '(?k ?K)) (org-clock-sum))
(message "Sorting entries...")
@ -9297,7 +9209,13 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
nil
(cond
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
((= dcst ?f)
(or compare-func
(and interactive?
(org-read-function
(concat "Function for comparing keys "
"(empty for default `sort-subr' predicate): ")
'allow-empty))))
((member dcst '(?p ?t ?s ?d ?c ?k)) '<)))))
(run-hooks 'org-after-sorting-entries-or-items-hook)
;; Reset the clock marker if needed
@ -9696,11 +9614,11 @@ auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)"
"Clone local variables from FROM-BUFFER.
Optional argument REGEXP selects variables to clone."
(dolist (pair (buffer-local-variables from-buffer))
(let ((name (car pair)))
(when (and (symbolp name)
(not (memq name org-unique-local-variables))
(or (null regexp) (string-match regexp (symbol-name name))))
(set (make-local-variable name) (cdr pair))))))
(pcase pair
(`(,name . ,value) ;ignore unbound variables
(when (and (not (memq name org-unique-local-variables))
(or (null regexp) (string-match-p regexp (symbol-name name))))
(set (make-local-variable name) value))))))
;;;###autoload
(defun org-run-like-in-org-mode (cmd)
@ -9813,22 +9731,19 @@ sub-tree if optional argument INHERIT is non-nil."
(defun org-refresh-stats-properties ()
"Refresh stats text properties in the buffer."
(let (stats)
(org-with-silent-modifications
(org-with-wide-buffer
(goto-char (point-min))
(while (re-search-forward
(concat org-outline-regexp-bol ".*"
"\\(?:\\[\\([0-9]+\\)%\\|\\([0-9]+\\)/\\([0-9]+\\)\\]\\)")
nil t)
(setq stats (cond ((equal (match-string 3) "0") 0)
((match-string 2)
(/ (* (string-to-number (match-string 2)) 100)
(string-to-number (match-string 3))))
(t (string-to-number (match-string 1)))))
(org-back-to-heading t)
(put-text-property (point) (progn (org-end-of-subtree t t) (point))
'org-stats stats))))))
(org-with-silent-modifications
(org-with-point-at 1
(let ((regexp (concat org-outline-regexp-bol
".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]")))
(while (re-search-forward regexp nil t)
(let* ((numerator (string-to-number (match-string 1)))
(denominator (and (match-end 2)
(string-to-number (match-string 2))))
(stats (cond ((not denominator) numerator) ;percent
((= denominator 0) 0)
(t (/ (* numerator 100) denominator)))))
(put-text-property (point) (progn (org-end-of-subtree t t) (point))
'org-stats stats)))))))
(defun org-refresh-effort-properties ()
"Refresh effort properties"
@ -9912,9 +9827,10 @@ and then used in capture templates."
This link is added to `org-stored-links' and can later be inserted
into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
For some link types, a `\\[universal-argument]' prefix ARG is interpreted.
For links to Usenet articles, ARG negates `org-gnus-prefer-web-links'.
For file links, ARG negates `org-context-in-file-links'.
For some link types, a `\\[universal-argument]' prefix ARG is interpreted. \
A single
`\\[universal-argument]' negates `org-context-in-file-links' for file links or
`org-gnus-prefer-web-links' for links to Usenet articles.
A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \
skipping storing functions that are not
@ -10076,7 +9992,8 @@ active region."
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
;; Add a context search string
(when (org-xor org-context-in-file-links arg)
(when (org-xor org-context-in-file-links
(equal arg '(4)))
(let* ((element (org-element-at-point))
(name (org-element-property :name element)))
(setq txt (cond
@ -10103,7 +10020,8 @@ active region."
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
;; Add a context string.
(when (org-xor org-context-in-file-links arg)
(when (org-xor org-context-in-file-links
(equal arg '(4)))
(setq txt (if (org-region-active-p)
(buffer-substring (region-beginning) (region-end))
(buffer-substring (point-at-bol) (point-at-eol))))
@ -11813,7 +11731,7 @@ order.")
(org-refile-cache-put tgs (buffer-file-name) descre))
(setq targets (append tgs targets))))))
(message "Getting targets...done")
(nreverse targets)))
(delete-dups (nreverse targets))))
(defun org-protect-slash (s)
(replace-regexp-in-string "/" "\\/" s nil t))
@ -22790,6 +22708,7 @@ it for output."
;;; Indentation
(defvar org-element-greater-elements)
(defun org--get-expected-indentation (element contentsp)
"Expected indentation column for current line, according to ELEMENT.
ELEMENT is an element containing point. CONTENTSP is non-nil
@ -24676,7 +24595,6 @@ Move to the previous element at the same level, when possible."
(user-error "No surrounding element")
(org-with-limited-levels (org-back-to-heading)))))))
(defvar org-element-greater-elements)
(defun org-down-element ()
"Move to inner element."
(interactive)

View File

@ -2624,12 +2624,14 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode an INLINE-SRC-BLOCK element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let ((lang (org-element-property :language inline-src-block))
(code (org-element-property :value inline-src-block))
(label
(let ((lbl (and (org-element-property :name inline-src-block)
(org-export-get-reference inline-src-block info))))
(if (not lbl) "" (format " id=\"%s\"" lbl)))))
(let* ((lang (org-element-property :language inline-src-block))
(code (org-html-fontify-code
(org-element-property :value inline-src-block)
lang))
(label
(let ((lbl (and (org-element-property :name inline-src-block)
(org-export-get-reference inline-src-block info))))
(if (not lbl) "" (format " id=\"%s\"" lbl)))))
(format "<code class=\"src src-%s\"%s>%s</code>" lang label code)))
;;;; Inlinetask

View File

@ -665,8 +665,7 @@ If NO-CACHE is not nil, do not initialize `org-publish-cache'.
This is needed, since this function is used to publish single
files, when entire projects are published (see
`org-publish-projects')."
(let* ((filename (file-truename filename)) ;normalize name
(project
(let* ((project
(or project
(org-publish-get-project-from-filename filename)
(user-error "File %S is not part of any known project"
@ -679,17 +678,15 @@ files, when entire projects are published (see
(f (list f))))
(base-dir
(file-name-as-directory
(file-truename
(or (plist-get project-plist :base-directory)
(user-error "Project %S does not have :base-directory defined"
(car project))))))
(or (org-publish-property :base-directory project)
(user-error "Project %S does not have :base-directory defined"
(car project)))))
(pub-base-dir
(file-name-as-directory
(file-truename
(or (eval (plist-get project-plist :publishing-directory))
(user-error
"Project %S does not have :publishing-directory defined"
(car project))))))
(or (org-publish-property :publishing-directory project)
(user-error
"Project %S does not have :publishing-directory defined"
(car project)))))
(pub-dir
(file-name-directory
(expand-file-name (file-relative-name filename base-dir)

View File

@ -448,21 +448,25 @@ INFO is a plist used as a communication channel. See
;; Else use format string.
(fmt (format fmt text))))
(defun org-texinfo--get-node (blob info)
"Return node or anchor associated to BLOB.
BLOB is an element or object. INFO is a plist used as
(defun org-texinfo--get-node (datum info)
"Return node or anchor associated to DATUM.
DATUM is an element or object. INFO is a plist used as
a communication channel. The function guarantees the node or
anchor name is unique."
(let ((cache (plist-get info :texinfo-node-cache)))
(or (cdr (assq blob cache))
(let ((name
(org-texinfo--sanitize-node
(if (eq (org-element-type blob) 'headline)
(org-export-data (org-export-get-alt-title blob info) info)
(org-export-get-reference blob info)))))
;; Ensure NAME is unique.
(while (rassoc name cache) (setq name (concat name "x")))
(plist-put info :texinfo-node-cache (cons (cons blob name) cache))
(or (cdr (assq datum cache))
(let* ((salt 0)
(basename
(org-texinfo--sanitize-node
(if (eq (org-element-type datum) 'headline)
(org-export-data (org-export-get-alt-title datum info)
info)
(org-export-get-reference datum info))))
(name basename))
;; Ensure NAME is unique and not reserved node name "Top".
(while (or (equal name "Top") (rassoc name cache))
(setq name (concat basename (number-to-string (cl-incf salt)))))
(plist-put info :texinfo-node-cache (cons (cons datum name) cache))
name))))
(defun org-texinfo--sanitize-node (title)
@ -935,9 +939,17 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Link
(defun org-texinfo--@ref (datum description info)
"Return @ref command for element or object DATUM.
DESCRIPTION is the name of the section to print, as a string."
(let ((node-name (org-texinfo--get-node datum info))
(title (org-texinfo--sanitize-node description)))
(if (equal title node-name)
(format "@ref{%s}" node-name)
(format "@ref{%s, , %s}" node-name title))))
(defun org-texinfo-link (link desc info)
"Transcode a LINK object from Org to Texinfo.
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information. See
`org-export-data'."
@ -957,9 +969,7 @@ INFO is a plist holding contextual information. See
((equal type "radio")
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) desc
(format "@ref{%s,,%s}"
(org-texinfo--get-node destination info)
desc))))
(org-texinfo--@ref destination desc info))))
((member type '("custom-id" "id" "fuzzy"))
(let ((destination
(if (equal type "fuzzy")
@ -974,36 +984,21 @@ INFO is a plist holding contextual information. See
(if desc (format "@uref{file://%s,%s}" destination desc)
(format "@uref{file://%s}" destination)))
(`headline
(format "@ref{%s,%s}"
(org-texinfo--get-node destination info)
(cond
(desc)
((org-export-numbered-headline-p destination info)
(mapconcat
#'number-to-string
(org-export-get-headline-number destination info) "."))
(t (org-export-data
(org-element-property :title destination) info)))))
(org-texinfo--@ref
destination
(or desc
(org-export-data
(org-element-property :title destination) info))
info))
(_
(format "@ref{%s,,%s}"
(org-texinfo--get-node destination info)
(cond
(desc)
;; No description is provided: first try to
;; associate destination to a number.
((let ((n (org-export-get-ordinal destination info)))
(cond ((not n) nil)
((integerp n) n)
(t (mapconcat #'number-to-string n ".")))))
;; Then grab title of headline containing
;; DESTINATION.
((let ((h (org-element-lineage destination '(headline) t)))
(and h
(org-export-data
(org-element-property :title destination) info))))
;; Eventually, just return "Top" to refer to the
;; beginning of the info file.
(t "Top")))))))
(org-texinfo--@ref
destination
(or desc
(pcase (org-export-get-ordinal destination info)
((and (pred integerp) n) (number-to-string n))
((and (pred consp) n) (mapconcat #'number-to-string n "."))
(_ "???")))
info))))) ;cannot guess the description
((equal type "info")
(let* ((info-path (split-string path "[:#]"))
(info-manual (car info-path))
@ -1013,9 +1008,9 @@ INFO is a plist holding contextual information. See
((string= type "mailto")
(format "@email{%s}"
(concat (org-texinfo--sanitize-content path)
(and desc (concat "," desc)))))
(and desc (concat ", " desc)))))
;; External link with a description part.
((and path desc) (format "@uref{%s,%s}" path desc))
((and path desc) (format "@uref{%s, %s}" path desc))
;; External link without a description part.
(path (format "@uref{%s}" path))
;; No path, only description. Try to do something useful.
@ -1275,7 +1270,7 @@ holding contextual information."
TEXT is the text of the target. INFO is a plist holding
contextual information."
(format "@anchor{%s}%s"
(org-export-get-reference radio-target info)
(org-texinfo--get-node radio-target info)
text))
;;;; Section
@ -1323,7 +1318,7 @@ contextual information."
(org-texinfo--wrap-float value
info
(org-export-translate "Listing" :utf-8 info)
(org-export-get-reference src-block info)
(org-texinfo--get-node src-block info)
caption
shortcaption))))
@ -1382,7 +1377,7 @@ contextual information."
(org-texinfo--wrap-float table-str
info
(org-export-translate "Table" :utf-8 info)
(org-export-get-reference table info)
(org-texinfo--get-node table info)
caption
shortcaption)))))
@ -1450,7 +1445,7 @@ a communication channel."
"Transcode a TARGET object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
(format "@anchor{%s}" (org-export-get-reference target info)))
(format "@anchor{%s}" (org-texinfo--get-node target info)))
;;;; Timestamp

View File

@ -1,6 +1,6 @@
;;; test-org-capture.el --- Tests for org-capture.el -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Nicolas Goaziou
;; Copyright (C) 2015, 2017 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>

View File

@ -370,12 +370,12 @@ CLOCK: [2012-03-29 Thu 16:40]--[2014-03-04 Thu 00:41] => 16905:01
(ert-deftest test-org-clock/clocktable/maxlevel ()
"Test \":maxlevel\" parameter in Clock table."
(should
(equal "| Headline | Time | | |
|--------------+--------+------+---|
| *Total time* | *6:00* | | |
|--------------+--------+------+---|
| Foo | 6:00 | | |
| \\_ Bar | | 2:00 | |
(equal "| Headline | Time | |
|--------------+--------+------|
| *Total time* | *6:00* | |
|--------------+--------+------|
| Foo | 6:00 | |
| \\_ Bar | | 2:00 |
"
(org-test-with-temp-text
"

View File

@ -104,9 +104,10 @@
(lambda () (get-char-property (point) 'org-columns-value))))))
(should
(equal
'("H1" "H2" "H3" "H4")
(org-test-with-temp-text "Top\n* H1\n** <point>H2\n*** H3\n* H4"
(let ((org-columns-default-format "%ITEM")) (org-columns t))
'("1" "1")
(org-test-with-temp-text
"Top\n* H1\n** <point>H2\n:PROPERTIES:\n:A: 1\n:END:"
(let ((org-columns-default-format "%A{+}")) (org-columns t))
(org-map-entries
(lambda () (get-char-property (point) 'org-columns-value)))))))
@ -212,6 +213,17 @@
:END:"
(let ((org-columns-default-format "%A{$}")) (org-columns))
(get-char-property (point) 'org-columns-value-modified))))
;; Obey to format string even in leaf values.
(should
(equal
"1.0"
(org-test-with-temp-text
"* H
:PROPERTIES:
:A: 1
:END:"
(let ((org-columns-default-format "%A{+;%.1f}")) (org-columns))
(get-char-property (point) 'org-columns-value-modified))))
;; {:} sums times. Plain numbers are hours.
(should
(equal
@ -316,6 +328,88 @@
** S1
:PROPERTIES:
:A: [X]
:END:"
(let ((org-columns-default-format "%A{X%}")) (org-columns))
(get-char-property (point) 'org-columns-value-modified))))
;; {X/} handles recursive summaries.
(should
(equal
"[1/2]"
(org-test-with-temp-text
"* H
** S1
:PROPERTIES:
:A: [ ]
:END:
** S2
*** S21
:PROPERTIES:
:A: [X]
:END:
*** S22
:PROPERTIES:
:A: [X]
:END:"
(let ((org-columns-default-format "%A{X/}")) (org-columns))
(get-char-property (point) 'org-columns-value-modified))))
(should
(equal
"[1/2]"
(org-test-with-temp-text
"* H
** S1
:PROPERTIES:
:A: [X]
:END:
** S2
*** S21
:PROPERTIES:
:A: [ ]
:END:
*** S22
:PROPERTIES:
:A: [ ]
:END:"
(let ((org-columns-default-format "%A{X/}")) (org-columns))
(get-char-property (point) 'org-columns-value-modified))))
;; {X%} handles recursive summaries.
(should
(equal
"[50%]"
(org-test-with-temp-text
"* H
** S1
:PROPERTIES:
:A: [ ]
:END:
** S2
*** S21
:PROPERTIES:
:A: [X]
:END:
*** S22
:PROPERTIES:
:A: [X]
:END:"
(let ((org-columns-default-format "%A{X%}")) (org-columns))
(get-char-property (point) 'org-columns-value-modified))))
(should
(equal
"[50%]"
(org-test-with-temp-text
"* H
** S1
:PROPERTIES:
:A: [X]
:END:
** S2
*** S21
:PROPERTIES:
:A: [ ]
:END:
*** S22
:PROPERTIES:
:A: [ ]
:END:"
(let ((org-columns-default-format "%A{X%}")) (org-columns))
(get-char-property (point) 'org-columns-value-modified))))

View File

@ -108,10 +108,10 @@
"* H1\n:PROPERTIES:\n:A: 1\n:END:\n* H2\n{{{property(A,*???)}}}<point>"
(org-macro-initialize-templates)
(org-macro-replace-all org-macro-templates)))
;; Macro expansion ignores narrowing.
;; Macro expansion preserves narrowing.
(should
(string-match
"expansion"
(string-match-p
"{{{macro}}}"
(org-test-with-temp-text
"#+MACRO: macro expansion\n{{{macro}}}\n<point>Contents"
(narrow-to-region (point) (point-max))

View File

@ -2399,7 +2399,82 @@ http://article.gmane.org/gmane.emacs.orgmode/21459/"
(org-test-with-temp-text-in-file "#+NAME: foo\nParagraph"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::foo][foo]]" file)
(org-store-link nil)))))))
(org-store-link nil))))))
;; Store link to Org buffer, with context.
(should
(let ((org-stored-links nil)
(org-id-link-to-org-use-id nil)
(org-context-in-file-links t))
(org-test-with-temp-text-in-file "* h1"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::*h1][h1]]" file)
(org-store-link nil))))))
;; Store link to Org buffer, without context.
(should
(let ((org-stored-links nil)
(org-id-link-to-org-use-id nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "* h1"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s][file:%s]]" file file)
(org-store-link nil))))))
;; C-u prefix reverses `org-context-in-file-links' in Org buffer.
(should
(let ((org-stored-links nil)
(org-id-link-to-org-use-id nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "* h1"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::*h1][h1]]" file)
(org-store-link '(4)))))))
;; A C-u C-u does *not* reverse `org-context-in-file-links' in Org
;; buffer.
(should
(let ((org-stored-links nil)
(org-id-link-to-org-use-id nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "* h1"
(let ((file (buffer-file-name)))
(equal (format "[[file:%s][file:%s]]" file file)
(org-store-link '(16)))))))
;; Store file link to non-Org buffer, with context.
(should
(let ((org-stored-links nil)
(org-context-in-file-links t))
(org-test-with-temp-text-in-file "one\n<point>two"
(fundamental-mode)
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::one]]" file)
(org-store-link nil))))))
;; Store file link to non-Org buffer, without context.
(should
(let ((org-stored-links nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "one\n<point>two"
(fundamental-mode)
(let ((file (buffer-file-name)))
(equal (format "[[file:%s][file:%s]]" file file)
(org-store-link nil))))))
;; C-u prefix reverses `org-context-in-file-links' in non-Org
;; buffer.
(should
(let ((org-stored-links nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "one\n<point>two"
(fundamental-mode)
(let ((file (buffer-file-name)))
(equal (format "[[file:%s::one]]" file)
(org-store-link '(4)))))))
;; A C-u C-u does *not* reverse `org-context-in-file-links' in
;; non-Org buffer.
(should
(let ((org-stored-links nil)
(org-context-in-file-links nil))
(org-test-with-temp-text-in-file "one\n<point>two"
(fundamental-mode)
(let ((file (buffer-file-name)))
(equal (format "[[file:%s][file:%s]]" file file)
(org-store-link '(16))))))))
;;; Node Properties