org.el: Fontify links to current buffer when inserting a link.
* org.el (org-link-to-org-use-id): use `org-capture' instead of `org-remember' in the docstring. (org-link-fontify-links-to-this-file): New function to fontify links to the current buffer in `org-stored-links'. (org-store-link): Small code simplification. (org-link-prettify): Enclose literal links into <...> instead of [[...]]. (org-insert-link): Use `org-link-fontify-links-to-this-file'. Also allow completion over links' descriptions, as well as links destinations. When the user uses the description for completion, don't prompt again for a description. Thanks to Yagnesh Raghava Yakkala who suggested this.
This commit is contained in:
parent
7fdd49dd33
commit
1e34c5d34f
76
lisp/org.el
76
lisp/org.el
|
@ -1454,10 +1454,10 @@ create-if-interactive
|
||||||
job for remember, only use the ID if it already exists. The
|
job for remember, only use the ID if it already exists. The
|
||||||
purpose of this setting is to avoid proliferation of unwanted
|
purpose of this setting is to avoid proliferation of unwanted
|
||||||
IDs, just because you happen to be in an Org file when you
|
IDs, just because you happen to be in an Org file when you
|
||||||
call `org-remember' that automatically and preemptively
|
call `org-capture' that automatically and preemptively creates a
|
||||||
creates a link. If you do want to get an ID link in a remember
|
link. If you do want to get an ID link in a remember template to
|
||||||
template to an entry not having an ID, create it first by
|
an entry not having an ID, create it first by explicitly creating
|
||||||
explicitly creating a link to it, using `C-c C-l' first.
|
a link to it, using `C-c C-l' first.
|
||||||
|
|
||||||
create-if-interactive-and-no-custom-id
|
create-if-interactive-and-no-custom-id
|
||||||
Like create-if-interactive, but do not create an ID if there is
|
Like create-if-interactive, but do not create an ID if there is
|
||||||
|
@ -8876,19 +8876,16 @@ For file links, arg negates `org-context-in-file-links'."
|
||||||
link (org-make-link cpltxt)))
|
link (org-make-link cpltxt)))
|
||||||
((and (featurep 'org-id)
|
((and (featurep 'org-id)
|
||||||
(or (eq org-link-to-org-use-id t)
|
(or (eq org-link-to-org-use-id t)
|
||||||
(and (eq org-link-to-org-use-id 'create-if-interactive)
|
(and (org-called-interactively-p 'any)
|
||||||
(org-called-interactively-p 'any))
|
(or (eq org-link-to-org-use-id 'create-if-interactive)
|
||||||
(and (eq org-link-to-org-use-id
|
(and (eq org-link-to-org-use-id
|
||||||
'create-if-interactive-and-no-custom-id)
|
'create-if-interactive-and-no-custom-id)
|
||||||
(org-called-interactively-p 'any)
|
(not custom-id))))
|
||||||
(not custom-id))
|
(and org-link-to-org-use-id (org-entry-get nil "ID"))))
|
||||||
(and org-link-to-org-use-id
|
|
||||||
(org-entry-get nil "ID"))))
|
|
||||||
;; We can make a link using the ID.
|
;; We can make a link using the ID.
|
||||||
(setq link (condition-case nil
|
(setq link (condition-case nil
|
||||||
(prog1 (org-id-store-link)
|
(prog1 (org-id-store-link)
|
||||||
(setq desc (plist-get org-store-link-plist
|
(setq desc (plist-get org-store-link-plist :description)))
|
||||||
:description)))
|
|
||||||
(error
|
(error
|
||||||
;; probably before first headline, link to file only
|
;; probably before first headline, link to file only
|
||||||
(concat "file:"
|
(concat "file:"
|
||||||
|
@ -9190,7 +9187,7 @@ The car of LINK must be a raw link the cdr of LINK must be either
|
||||||
a link description or nil."
|
a link description or nil."
|
||||||
(let ((desc (or (cadr link) "<no description>")))
|
(let ((desc (or (cadr link) "<no description>")))
|
||||||
(concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
|
(concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
|
||||||
"[[" (car link) "]]")))
|
"<" (car link) ">")))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun org-insert-link-global ()
|
(defun org-insert-link-global ()
|
||||||
|
@ -9209,6 +9206,29 @@ This command can be called in any mode to insert a link in Org-mode syntax."
|
||||||
(org-insert-link nil (car l) (cadr l))
|
(org-insert-link nil (car l) (cadr l))
|
||||||
(insert "\n"))))
|
(insert "\n"))))
|
||||||
|
|
||||||
|
(defun org-link-fontify-links-to-this-file ()
|
||||||
|
"Fontify links to the current file in `org-stored-links'."
|
||||||
|
(let ((f (buffer-file-name)) a b)
|
||||||
|
(setq a (mapcar (lambda(l)
|
||||||
|
(let ((ll (car l)))
|
||||||
|
(when (and (string-match "^file:\\(.+\\)::" ll)
|
||||||
|
(equal f (expand-file-name (match-string 1 ll))))
|
||||||
|
ll)))
|
||||||
|
org-stored-links))
|
||||||
|
(when (featurep 'org-id)
|
||||||
|
(setq b (mapcar (lambda(l)
|
||||||
|
(let ((ll (car l)))
|
||||||
|
(when (and (string-match "^id:\\(.+\\)$" ll)
|
||||||
|
(equal f (expand-file-name
|
||||||
|
(or (org-id-find-id-file
|
||||||
|
(match-string 1 ll)) ""))))
|
||||||
|
ll)))
|
||||||
|
org-stored-links)))
|
||||||
|
(mapcar (lambda(l)
|
||||||
|
(put-text-property 0 (length l) 'face 'font-lock-comment-face l))
|
||||||
|
(delq nil (append a b)))))
|
||||||
|
|
||||||
|
(defvar org-link-links-in-this-file nil)
|
||||||
(defun org-insert-link (&optional complete-file link-location default-description)
|
(defun org-insert-link (&optional complete-file link-location default-description)
|
||||||
"Insert a link. At the prompt, enter the link.
|
"Insert a link. At the prompt, enter the link.
|
||||||
|
|
||||||
|
@ -9257,7 +9277,7 @@ be used as the default description."
|
||||||
(desc region)
|
(desc region)
|
||||||
tmphist ; byte-compile incorrectly complains about this
|
tmphist ; byte-compile incorrectly complains about this
|
||||||
(link link-location)
|
(link link-location)
|
||||||
entry file all-prefixes)
|
entry file all-prefixes auto-desc)
|
||||||
(cond
|
(cond
|
||||||
(link-location) ; specified by arg, just use it.
|
(link-location) ; specified by arg, just use it.
|
||||||
((org-in-regexp org-bracket-link-regexp 1)
|
((org-in-regexp org-bracket-link-regexp 1)
|
||||||
|
@ -9278,13 +9298,16 @@ be used as the default description."
|
||||||
(setq link (org-file-complete-link complete-file)))
|
(setq link (org-file-complete-link complete-file)))
|
||||||
(t
|
(t
|
||||||
;; Read link, with completion for stored links.
|
;; Read link, with completion for stored links.
|
||||||
(with-output-to-temp-buffer "*Org Links*"
|
(org-link-fontify-links-to-this-file)
|
||||||
(princ "Insert a link.
|
(org-switch-to-buffer-other-window "*Org Links*")
|
||||||
|
(with-current-buffer "*Org Links*"
|
||||||
|
(erase-buffer)
|
||||||
|
(insert "Insert a link.
|
||||||
Use TAB to complete link prefixes, then RET for type-specific completion support\n")
|
Use TAB to complete link prefixes, then RET for type-specific completion support\n")
|
||||||
(when org-stored-links
|
(when org-stored-links
|
||||||
(princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n")
|
(insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n")
|
||||||
(princ (mapconcat 'org-link-prettify
|
(insert (mapconcat 'org-link-prettify
|
||||||
(reverse org-stored-links) "\n"))))
|
(reverse org-stored-links) "\n"))))
|
||||||
(let ((cw (selected-window)))
|
(let ((cw (selected-window)))
|
||||||
(select-window (get-buffer-window "*Org Links*" 'visible))
|
(select-window (get-buffer-window "*Org Links*" 'visible))
|
||||||
(with-current-buffer "*Org Links*" (setq truncate-lines t))
|
(with-current-buffer "*Org Links*" (setq truncate-lines t))
|
||||||
|
@ -9307,12 +9330,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
|
||||||
(append
|
(append
|
||||||
(mapcar (lambda (x) (list (concat x ":")))
|
(mapcar (lambda (x) (list (concat x ":")))
|
||||||
all-prefixes)
|
all-prefixes)
|
||||||
(mapcar 'car org-stored-links))
|
(mapcar 'car org-stored-links)
|
||||||
|
(mapcar 'cadr org-stored-links))
|
||||||
nil nil nil
|
nil nil nil
|
||||||
'tmphist
|
'tmphist
|
||||||
(car (car org-stored-links)))))
|
(caar org-stored-links))))
|
||||||
(if (not (string-match "\\S-" link))
|
(if (not (string-match "\\S-" link))
|
||||||
(error "No link selected"))
|
(error "No link selected"))
|
||||||
|
(mapc (lambda(l)
|
||||||
|
(when (equal link (cadr l)) (setq link (car l) auto-desc t)))
|
||||||
|
org-stored-links)
|
||||||
(if (or (member link all-prefixes)
|
(if (or (member link all-prefixes)
|
||||||
(and (equal ":" (substring link -1))
|
(and (equal ":" (substring link -1))
|
||||||
(member (substring link 0 -1) all-prefixes)
|
(member (substring link 0 -1) all-prefixes)
|
||||||
|
@ -9377,7 +9404,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
|
||||||
(if org-make-link-description-function
|
(if org-make-link-description-function
|
||||||
(setq desc (funcall org-make-link-description-function link desc))
|
(setq desc (funcall org-make-link-description-function link desc))
|
||||||
(if default-description (setq desc default-description)
|
(if default-description (setq desc default-description)
|
||||||
(setq desc (read-string "Description: " desc))))
|
(setq desc (or (and auto-desc desc)
|
||||||
|
(read-string "Description: " desc)))))
|
||||||
|
|
||||||
(unless (string-match "\\S-" desc) (setq desc nil))
|
(unless (string-match "\\S-" desc) (setq desc nil))
|
||||||
(if remove (apply 'delete-region remove))
|
(if remove (apply 'delete-region remove))
|
||||||
|
|
Loading…
Reference in New Issue