diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-05-26 11:56:53 +0200 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-05-26 11:56:53 +0200 |
commit | 2d29269bb1b9af08011e091913798b6598e4b156 (patch) | |
tree | 486b1e4f94316ec8b223bb13a247afc4909572ec | |
parent | 6d4c188e3e318d3d3237d82dbb94dbd6e9cbf417 (diff) | |
download | org-mode-2d29269bb1b9af08011e091913798b6598e4b156.tar.gz |
Fix link fontification
* lisp/org.el (org-activate-links): New function.
(org-set-font-lock-defaults): Use new function.
(org-activate-angle-links):
(org-activate-bracket-links):
(org-activate-plain-links): Remove functions.
* lisp/org-agenda.el (org-agenda-get-some-entry-text):
(org-agenda-finalize): Use new function.
Reported-by: 林镇国 <mistkafka@gmail.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/113485>
-rw-r--r-- | lisp/org-agenda.el | 8 | ||||
-rw-r--r-- | lisp/org.el | 235 |
2 files changed, 75 insertions, 168 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 8737340..a00512a 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -3471,7 +3471,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 +3713,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) diff --git a/lisp/org.el b/lisp/org.el index a7ba402..a7abc0e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5956,62 +5956,77 @@ 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 (pcase type ;extract URL part + (`plain (match-string-no-properties 0)) + (`angle (buffer-substring-no-properties + (1+ start) (1- end))) + (_ (match-string-no-properties 2)))) + (path (save-match-data + (and (string-match ":" link) ;remove type + (substring link (match-end 0))))) + (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: " + (save-match-data + (org-link-unescape + (org-link-expand-abbrev 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 +6181,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 +6204,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 +6470,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)) |