summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2017-05-26 11:56:53 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2017-05-26 11:56:53 +0200
commit2d29269bb1b9af08011e091913798b6598e4b156 (patch)
tree486b1e4f94316ec8b223bb13a247afc4909572ec
parent6d4c188e3e318d3d3237d82dbb94dbd6e9cbf417 (diff)
downloadorg-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.el8
-rw-r--r--lisp/org.el235
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))