diff options
Diffstat (limited to 'lisp/org/ol.el')
| -rw-r--r-- | lisp/org/ol.el | 222 |
1 files changed, 148 insertions, 74 deletions
diff --git a/lisp/org/ol.el b/lisp/org/ol.el index 108f031cde4..0b4457b0030 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -27,8 +27,12 @@ ;;; Code: +(require 'org-macs) +(org-assert-version) + (require 'org-compat) (require 'org-macs) +(require 'org-fold) (defvar clean-buffer-list-kill-buffer-names) (defvar org-agenda-buffer-name) @@ -38,7 +42,6 @@ (defvar org-inhibit-startup) (defvar org-outline-regexp-bol) (defvar org-src-source-file-name) -(defvar org-time-stamp-formats) (defvar org-ts-regexp) (declare-function calendar-cursor-to-date "calendar" (&optional error event)) @@ -47,7 +50,7 @@ (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-before-first-heading-p "org" ()) (declare-function org-do-occur "org" (regexp &optional cleanup)) -(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-element-cache-refresh "org-element" (pos)) (declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-lineage "org-element" (datum &optional types with-self)) @@ -66,10 +69,10 @@ (declare-function org-mode "org" ()) (declare-function org-occur "org" (regexp &optional keep-previous callback)) (declare-function org-open-file "org" (path &optional in-emacs line search)) -(declare-function org-overview "org" ()) +(declare-function org-cycle-overview "org-cycle" ()) (declare-function org-restart-font-lock "org" ()) (declare-function org-run-like-in-org-mode "org" (cmd)) -(declare-function org-show-context "org" (&optional key)) +(declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function org-src-coderef-format "org-src" (&optional element)) (declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-src-edit-buffer-p "org-src" (&optional buffer)) @@ -140,6 +143,19 @@ link. Function that inserts a link with completion. The function takes one optional prefix argument. +`:insert-description' + + String or function used as a default when prompting users for a + link's description. A string is used as-is, a function is + called with two arguments: the link location (a string such as + \"~/foobar\", \"id:some-org-id\" or \"https://www.foo.com\") + and the description generated by `org-insert-link'. It should + return the description to use (this reflects the behaviour of + `org-link-make-description-function'). If it returns nil, no + default description is used, but no error is thrown (from the + user's perspective, this is equivalent to a default description + of \"\"). + `:display' Value for `invisible' text property on the hidden parts of the @@ -199,7 +215,9 @@ You can interactively set the value of this variable by calling This function must take two parameters: the first one is the link, the second one is the description generated by `org-insert-link'. The function should return the description to -use." +use. If it returns nil, no default description is used, but no +error is thrown (from the user’s perspective, this is equivalent +to a default description of \"\")." :group 'org-link :type '(choice (const nil) (function)) :safe #'null) @@ -604,6 +622,22 @@ exact and fuzzy text search.") (defvar org-link--search-failed nil "Non-nil when last link search failed.") + +(defvar-local org-link--link-folding-spec '(org-link + (:global t) + (:ellipsis . nil) + (:isearch-open . t) + (:fragile . org-link--reveal-maybe)) + "Folding spec used to hide invisible parts of links.") + +(defvar-local org-link--description-folding-spec '(org-link-description + (:global t) + (:ellipsis . nil) + (:visible . t) + (:isearch-open . nil) + (:fragile . org-link--reveal-maybe)) + "Folding spec used to reveal link description.") + ;;; Internal Functions @@ -700,7 +734,7 @@ followed by another \"%[A-F0-9]{2}\" group." (make-indirect-buffer (current-buffer) indirect-buffer-name 'clone)))) - (with-current-buffer indirect-buffer (org-overview)) + (with-current-buffer indirect-buffer (org-cycle-overview)) indirect-buffer)))) (defun org-link--search-radio-target (target) @@ -718,7 +752,7 @@ White spaces are not significant." (let ((object (org-element-context))) (when (eq (org-element-type object) 'radio-target) (goto-char (org-element-property :begin object)) - (org-show-context 'link-search) + (org-fold-show-context 'link-search) (throw :radio-match nil)))) (goto-char origin) (user-error "No match for radio target: %s" target)))) @@ -761,6 +795,13 @@ syntax around the string." (t nil)))) string)) +(defun org-link--reveal-maybe (region _) + "Reveal folded link in REGION when needed. +This function is intended to be used as :fragile property of a folding +spec." + (org-with-point-at (car region) + (not (org-in-regexp org-link-any-re)))) + ;;; Public API @@ -975,7 +1016,9 @@ LINK is escaped with backslashes for inclusion in buffer." (replace-regexp-in-string "]\\'" (concat "\\&" zero-width-space) (org-trim description)))))) - (if (not (org-string-nw-p link)) description + (if (not (org-string-nw-p link)) + (or description + (error "Empty link")) (format "[[%s]%s]" (org-link-escape link) (if description (format "[%s]" description) ""))))) @@ -1257,7 +1300,7 @@ of matched result, which is either `dedicated' or `fuzzy'." (error "No match for fuzzy expression: %s" normalized))) ;; Disclose surroundings of match, if appropriate. (when (and (derived-mode-p 'org-mode) (not stealth)) - (org-show-context 'link-search)) + (org-fold-show-context 'link-search)) type)) (defun org-link-heading-search-string (&optional string) @@ -1322,7 +1365,7 @@ PATH is the sexp to evaluate, as a string." (string-match-p org-link-elisp-skip-confirm-regexp path)) (not org-link-elisp-confirm-function) (funcall org-link-elisp-confirm-function - (format "Execute %S as Elisp? " + (format "Execute %s as Elisp? " (org-add-props path nil 'face 'org-warning)))) (message "%s => %s" path (if (eq ?\( (string-to-char path)) @@ -1377,7 +1420,7 @@ PATH is the command to execute, as a string." (string-match-p org-link-shell-skip-confirm-regexp path)) (not org-link-shell-confirm-function) (funcall org-link-shell-confirm-function - (format "Execute %S in shell? " + (format "Execute %s in shell? " (org-add-props path nil 'face 'org-warning)))) (let ((buf (generate-new-buffer "*Org Shell Output*"))) (message "Executing %s" path) @@ -1430,7 +1473,7 @@ is non-nil, move backward." (`nil nil) (link (goto-char (org-element-property :begin link)) - (when (org-invisible-p) (org-show-context)) + (when (org-invisible-p) (org-fold-show-context 'link-search)) (throw :found t))))) (goto-char pos) (setq org-link--search-failed t) @@ -1443,14 +1486,18 @@ If the link is in hidden text, expose it." (interactive) (org-next-link t)) +(defun org-link-descriptive-ensure () + "Toggle the literal or descriptive display of links in current buffer if needed." + (if org-link-descriptive + (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil) + (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t))) + ;;;###autoload (defun org-toggle-link-display () - "Toggle the literal or descriptive display of links." + "Toggle the literal or descriptive display of links in current buffer." (interactive) - (if org-link-descriptive (remove-from-invisibility-spec '(org-link)) - (add-to-invisibility-spec '(org-link))) - (org-restart-font-lock) - (setq org-link-descriptive (not org-link-descriptive))) + (setq org-link-descriptive (not org-link-descriptive)) + (org-link-descriptive-ensure)) ;;;###autoload (defun org-store-link (arg &optional interactive?) @@ -1519,10 +1566,8 @@ non-nil." t)))) (setq link (plist-get org-store-link-plist :link)) ;; If store function actually set `:description' property, use - ;; it, even if it is nil. Otherwise, fallback to link value. - (setq desc (if (plist-member org-store-link-plist :description) - (plist-get org-store-link-plist :description) - link))) + ;; it, even if it is nil. Otherwise, fallback to nil (ask user). + (setq desc (plist-get org-store-link-plist :description))) ;; Store a link from a remote editing buffer. ((org-src-edit-buffer-p) @@ -1563,7 +1608,7 @@ non-nil." (t (setq link nil))))) ;; We are in the agenda, link to referenced location - ((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name)) + ((eq major-mode 'org-agenda-mode) (let ((m (or (get-text-property (point) 'org-hd-marker) (get-text-property (point) 'org-marker)))) (when m @@ -1574,10 +1619,8 @@ non-nil." (let ((cd (calendar-cursor-to-date))) (setq link (format-time-string - (car org-time-stamp-formats) - (apply 'encode-time - (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) - nil nil nil)))) + (org-time-stamp-format) + (org-encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)))) (org-link-store-props :type "calendar" :date cd))) ((eq major-mode 'image-mode) @@ -1592,7 +1635,7 @@ non-nil." (setq file (if file (abbreviate-file-name (expand-file-name (dired-get-filename nil t))) - ;; otherwise, no file so use current directory. + ;; Otherwise, no file so use current directory. default-directory)) (setq cpltxt (concat "file:" file) link cpltxt))) @@ -1605,24 +1648,23 @@ non-nil." ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) (org-with-limited-levels - (cond - ;; Store a link using the target at point. + (setq custom-id (org-entry-get nil "CUSTOM_ID")) + (cond + ;; Store a link using the target at point ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1) - (setq cpltxt + (setq link (concat "file:" (abbreviate-file-name (buffer-file-name (buffer-base-buffer))) "::" (match-string 1)) - link cpltxt)) - ;; Store a link using the CUSTOM_ID property. - ((setq custom-id (org-entry-get nil "CUSTOM_ID")) - (setq cpltxt - (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))) - "::#" custom-id) - link cpltxt)) - ;; Store a link using (and perhaps creating) the ID property. + ;; Target may be shortened when link is inserted. + ;; Avoid [[target][file:~/org/test.org::target]] + ;; links. Maybe the case of identical target and + ;; description should be handled by `org-insert-link'. + cpltxt nil + desc nil + ;; Do not append #CUSTOM_ID link below. + custom-id nil)) ((and (featurep 'org-id) (or (eq org-id-link-to-org-use-id t) (and interactive? @@ -1631,13 +1673,12 @@ non-nil." 'create-if-interactive-and-no-custom-id) (not custom-id)))) (and org-id-link-to-org-use-id (org-entry-get nil "ID")))) + ;; Store a link using the ID at point (setq link (condition-case nil (prog1 (org-id-store-link) - (setq desc (or (plist-get org-store-link-plist - :description) - ""))) + (setq desc (plist-get org-store-link-plist :description))) (error - ;; Probably before first headline, link only to file. + ;; Probably before first headline, link only to file (concat "file:" (abbreviate-file-name (buffer-file-name (buffer-base-buffer)))))))) @@ -1697,8 +1738,7 @@ non-nil." ;; We're done setting link and desc, clean up (when (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt) - desc (or desc cpltxt)) + (setq link (or link cpltxt)) (cond ((not desc)) ((equal desc "NONE") (setq desc nil)) (t (setq desc (org-link-display-format desc)))) @@ -1728,6 +1768,9 @@ The history can be used to select a link previously stored with press `RET' at the prompt), the link defaults to the most recently stored link. As `SPC' triggers completion in the minibuffer, you need to use `M-SPC' or `C-q SPC' to force the insertion of a space character. +Completion candidates include link descriptions. + +If there is a link under cursor then edit it. You will also be prompted for a description, and if one is given, it will be displayed in the buffer instead of the link. @@ -1753,11 +1796,14 @@ prefix negates `org-link-keep-stored-after-insertion'. If the LINK-LOCATION parameter is non-nil, this value will be used as the link location instead of reading one interactively. -If the DESCRIPTION parameter is non-nil, this value will be used as the -default description. Otherwise, if `org-link-make-description-function' -is non-nil, this function will be called with the link target, and the -result will be the default link description. When called non-interactively, -don't allow to edit the default description." +If the DESCRIPTION parameter is non-nil, this value will be used +as the default description. If not, and the chosen link type has +a non-nil `:insert-description' parameter, that is used to +generate a description as described in `org-link-parameters' +docstring. Otherwise, if `org-link-make-description-function' is +non-nil, this function will be called with the link target, and +the result will be the default link description. When called +non-interactively, don't allow to edit the default description." (interactive "P") (let* ((wcf (current-window-configuration)) (origbuf (current-buffer)) @@ -1767,7 +1813,10 @@ don't allow to edit the default description." (desc region) (link link-location) (abbrevs org-link-abbrev-alist-local) - entry all-prefixes auto-desc) + (all-prefixes (append (mapcar #'car abbrevs) + (mapcar #'car org-link-abbrev-alist) + (org-link-types))) + entry) (cond (link-location) ; specified by arg, just use it. ((org-in-regexp org-link-bracket-re 1) @@ -1808,9 +1857,6 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (unless (pos-visible-in-window-p (point-max)) (org-fit-window-to-buffer)) (and (window-live-p cw) (select-window cw)))) - (setq all-prefixes (append (mapcar #'car abbrevs) - (mapcar #'car org-link-abbrev-alist) - (org-link-types))) (unwind-protect ;; Fake a link history, containing the stored links. (let ((org-link--history @@ -1821,15 +1867,19 @@ Use TAB to complete link prefixes, then RET for type-specific completion support "Link: " (append (mapcar (lambda (x) (concat x ":")) all-prefixes) - (mapcar #'car org-stored-links)) + (mapcar #'car org-stored-links) + ;; Allow description completion. Avoid "nil" option + ;; in the case of `completing-read-default' and + ;; an error in `ido-completing-read' when some links + ;; have no description. + (delq nil (mapcar 'cadr org-stored-links))) nil nil nil 'org-link--history (caar org-stored-links))) (unless (org-string-nw-p link) (user-error "No link selected")) (dolist (l org-stored-links) (when (equal link (cadr l)) - (setq link (car l)) - (setq auto-desc t))) + (setq link (car l)))) (when (or (member link all-prefixes) (and (equal ":" (substring link -1)) (member (substring link 0 -1) all-prefixes) @@ -1906,21 +1956,40 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (when (equal desc origpath) (setq desc path))))) - (unless auto-desc - (let ((initial-input - (cond - (description) - ((not org-link-make-description-function) desc) - (t (condition-case nil - (funcall org-link-make-description-function link desc) - (error - (message "Can't get link description from %S" - (symbol-name org-link-make-description-function)) - (sit-for 2) - nil)))))) - (setq desc (if (called-interactively-p 'any) - (read-string "Description: " initial-input) - initial-input)))) + (let* ((type + (cond + ((and all-prefixes + (string-match (rx-to-string `(: string-start (submatch (or ,@all-prefixes)) ":")) link)) + (match-string 1 link)) + ((file-name-absolute-p link) "file") + ((string-match "\\`\\.\\.?/" link) "file"))) + (initial-input + (cond + (description) + (desc) + ((org-link-get-parameter type :insert-description) + (let ((def (org-link-get-parameter type :insert-description))) + (condition-case nil + (cond + ((stringp def) def) + ((functionp def) + (funcall def link desc))) + (error + (message "Can't get link description from org link parameter `:insert-description': %S" + def) + (sit-for 2) + nil)))) + (org-link-make-description-function + (condition-case nil + (funcall org-link-make-description-function link desc) + (error + (message "Can't get link description from %S" + org-link-make-description-function) + (sit-for 2) + nil)))))) + (setq desc (if (called-interactively-p 'any) + (read-string "Description: " initial-input) + initial-input))) (unless (org-string-nw-p desc) (setq desc nil)) (when remove (apply #'delete-region remove)) @@ -1989,6 +2058,10 @@ Also refresh fontification if needed." (cl-pushnew (org-element-property :value obj) rtn :test #'equal)))) rtn)))) + (setq targets + (sort targets + (lambda (a b) + (> (length a) (length b))))) (setq org-target-link-regexp (and targets (concat before-re @@ -2012,7 +2085,8 @@ Also refresh fontification if needed." (list old-regexp org-target-link-regexp) "\\|") after-re))))) - (when (featurep 'org-element) + (when (and (featurep 'org-element) + (not (bound-and-true-p org-mode-loading))) (org-with-point-at 1 (while (re-search-forward regexp nil t) (org-element-cache-refresh (match-beginning 1)))))) |