-
-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathorglink.el
executable file
·283 lines (251 loc) · 11 KB
/
orglink.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
;;; orglink.el --- Use Org Mode links in other modes -*- lexical-binding:t -*-
;; Copyright (C) 2004-2022 Free Software Foundation, Inc.
;; Copyright (C) 2013-2024 Jonas Bernoulli
;; Author: Jonas Bernoulli <[email protected]>
;; Homepage: https://github.com/tarsius/orglink
;; Keywords: hypermedia
;; Package-Version: 1.2.4
;; Package-Requires: (
;; (emacs "26.1")
;; (compat "30.0.0.0")
;; (org "9.7.4")
;; (seq "2.24"))
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for some Org Mode link types in
;; other major modes. Links can be opened and edited like in Org
;; Mode.
;; To use enable `global-orglink-mode' and customize
;; `orglink-activate-in-modes'. Or use the buffer local
;; `orglink-mode'. Do the latter now to linkify these examples:
;; [[Code]]
;; [[Code][start of code]]
;; [[define-derived-mode orglink-mode][orglink-mode]]
;; <mailto:[email protected]>
;; man:info
;; <info:man>
;; https://github.com/tarsius/orglink
;;; Code:
(require 'compat)
(require 'seq)
(require 'org)
(require 'org-element)
(require 'org-lint)
(defvar hl-todo-keyword-faces)
(defvar outline-minor-mode)
(defgroup orglink nil
"Use Org Mode links in other modes."
:prefix "orglink-"
:group 'font-lock-extra-types)
(defvaralias 'orglink-activate-links 'orglink-highlight-links)
(defcustom orglink-highlight-links '(bracket angle plain)
"Types of links that should be activated by `orglink-mode'.
This is a list of symbols, each leading to the activation of a
certain link type.
bracket The [[link][description]] and [[link]] links.
angle Links in angular brackets like <info:org>.
plain Plain links in normal text like http://orgmode.org.
Changes to this variable only become effective after restarting
`orglink-mode', which has to be done separately in each buffer."
:group 'orglink
:safe (lambda (v)
(and (listp v)
(seq-every-p #'symbolp v)))
:type '(set :greedy t
(const :tag "Double bracket links" bracket)
(const :tag "Angular bracket links" angle)
(const :tag "Plain text links" plain)))
(defcustom orglink-match-anywhere nil
"Whether to match anywhere or just in comments and doc-strings."
:package-version '(orglink . "1.2.0")
:group 'orglink
:safe #'booleanp
:type 'boolean)
(defcustom orglink-activate-in-modes '(emacs-lisp-mode)
"Major modes in which `orglink-mode' should be activated.
This is used by `global-orglink-mode'. Note that `orglink-mode'
is never activated in the *scratch* buffer, to avoid having to
load `org' at startup (because that would take a long time)."
:group 'orglink
:type '(repeat function))
(defcustom orglink-mode-lighter " OrgLink"
"Mode lighter for Orglink Mode."
:group 'orglink
:type '(choice (const :tag "none" nil)
string))
(defvar-keymap orglink-mouse-map
:doc "Keymap used for `orglink-mode' link buttons.
The keymap stored in this variable is actually used by setting
the buffer local value of variable `org-mouse-map' to it's
value when `orglink-mode' is turned on."
"<follow-link>" 'mouse-face
"<mouse-2>" #'org-open-at-point-global
"<return>" #'org-open-at-point-global
"<tab>" #'org-next-link
"<backtab>" #'org-previous-link)
;;;###autoload
(define-minor-mode orglink-mode
"Toggle display Org-mode links in other major modes.
On the links the following commands are available:
\\{orglink-mouse-map}"
:lighter orglink-mode-lighter
(when (derived-mode-p 'org-mode)
(setq orglink-mode nil)
(error "Orglink Mode doesn't make sense in Org Mode"))
(cond (orglink-mode
(org-load-modules-maybe)
(add-hook 'org-open-link-functions
#'orglink-heading-link-search nil t)
(font-lock-add-keywords nil '((orglink-activate-links)) t)
(setq-local org-link-descriptive org-link-descriptive)
(when org-link-descriptive
(add-to-invisibility-spec '(org-link)))
(setq-local font-lock-unfontify-region-function
#'orglink-unfontify-region)
(setq-local org-mouse-map orglink-mouse-map))
(t
(remove-hook 'org-open-link-functions
#'orglink-heading-link-search t)
(font-lock-remove-keywords nil '((orglink-activate-links)))
(remove-from-invisibility-spec '(org-link))
(kill-local-variable 'org-link-descriptive)
(kill-local-variable 'font-lock-unfontify-region-function)
(kill-local-variable 'org-mouse-map)))
(when font-lock-mode
(save-restriction
(widen)
(font-lock-flush)
(font-lock-ensure))))
;;;###autoload
(define-globalized-minor-mode global-orglink-mode
orglink-mode turn-on-orglink-mode-if-desired)
(defun turn-on-orglink-mode-if-desired ()
(cond ((derived-mode-p 'org-mode)
;; `org-mode' derives from `outline-mode', which derives
;; from `text-mode'. Only warn if `org-mode' itself is
;; a member of `orglink-activate-in-modes'.
(when (memq 'org-mode orglink-activate-in-modes)
(message "Refusing to turn on `orglink-mode' in `org-mode'")))
((apply #'derived-mode-p orglink-activate-in-modes)
(orglink-mode 1))))
(defun orglink-unfontify-region (beg end)
(org-unfontify-region beg end)
;; The above does not remove the following properties.
;; TODO Should it? Should we? Ask on mailing-list.
(remove-text-properties beg end '(help-echo t rear-nonsticky t)))
;; Modified copy of `org-activate-links'.
;; The modified part is clearly marked.
(defun orglink-activate-links (limit)
(catch :exit
(while (re-search-forward org-link-any-re limit t)
(let* ((start (match-beginning 0))
(end (match-end 0))
(visible-start (or (match-beginning 3) (match-beginning 2)))
(visible-end (or (match-end 3) (match-end 2)))
(style (cond ((eq ?< (char-after start)) 'angle)
((eq ?\[ (char-after (1+ start))) 'bracket)
(t 'plain))))
;;; BEGIN Modified part:
(when (and (memq style orglink-highlight-links) ; Different variable.
;; Additional condition:
(or orglink-match-anywhere
(orglink-inside-comment-or-docstring-p))
;; Remove two conditions:
)
;;; END Modified part.
(let* ((link-object (save-excursion
(goto-char start)
(save-match-data (org-element-link-parser))))
(link (org-element-property :raw-link link-object))
(type (org-element-property :type link-object))
(path (org-element-property :path link-object))
(face-property (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)))
(properties ;for link's visible part
(list '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 style))
(progn
(add-face-text-property start end face-property)
(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)))
(add-text-properties start visible-start hidden)
(add-face-text-property start end face-property)
(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 style 'bracket))))
(throw :exit t))))) ;signal success
nil))
(defun orglink-inside-comment-or-docstring-p ()
(and (nth 8 (syntax-ppss))
(not (eq (get-text-property (point) 'face) 'font-lock-string-face))))
(defun orglink-heading-link-search (s)
(let (case-fold-search pos)
(save-excursion
(goto-char (point-min))
(and (or outline-minor-mode
(derived-mode-p 'emacs-lisp-mode))
(re-search-forward
(concat "^" outline-regexp
(if (bound-and-true-p hl-todo-mode)
(regexp-opt (mapcar 'car hl-todo-keyword-faces))
"\\(?:\\sw+\\)")
"?" s)
nil t)
(setq pos (match-beginning 0))
(goto-char pos)))))
;;;###autoload
(defun orglink-lint ()
"Check current buffer for mistakes in links."
(interactive)
(message "Linting links...")
(org-lint--display-reports
(current-buffer)
(cl-remove-if-not (lambda (c)
(assoc-string 'link (org-lint-checker-categories c)))
org-lint--checkers))
(message "Linting links...done"))
;;; _
(provide 'orglink)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; orglink.el ends here