1 ;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2015 Kyle Meyer <kyle@kyleam.com>
5 ;; Author: Kyle Meyer <kyle@kyleam.com>
6 ;; URL: https://github.com/kyleam/org-link-edit
7 ;; Keywords: convenience
9 ;; Package-Requires: ((cl-lib "0.5") (org "8.2"))
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
26 ;; Org Link Edit provides Paredit-inspired slurping and barfing
27 ;; commands for Org link descriptions.
29 ;; There are four commands, all which operate when point is on an Org
32 ;; - org-link-edit-forward-slurp
33 ;; - org-link-edit-backward-slurp
34 ;; - org-link-edit-forward-barf
35 ;; - org-link-edit-backward-barf
37 ;; Org Link Edit doesn't bind these commands to any keys. Finding
38 ;; good keys for these commands is difficult because, while it's
39 ;; convenient to be able to quickly repeat these commands, they won't
40 ;; be used frequently enough to be worthy of a short, repeat-friendly
41 ;; binding. Using Hydra [1] provides a nice solution to this. After
42 ;; an initial key sequence, any of the commands will be repeatable
43 ;; with a single key. (Plus, you get a nice interface that displays
44 ;; the key for each command.) Below is one example of how you could
47 ;; (define-key org-mode-map YOUR-KEY
48 ;; (defhydra hydra-org-link-edit ()
50 ;; ("j" org-link-edit-forward-slurp "forward slurp")
51 ;; ("k" org-link-edit-forward-barf "forward barf")
52 ;; ("u" org-link-edit-backward-slurp "backward slurp")
53 ;; ("i" org-link-edit-backward-barf "backward barf")
54 ;; ("q" nil "cancel")))
56 ;; [1] https://github.com/abo-abo/hydra
61 (require 'org-element
)
64 (defun org-link-edit--get-link-data ()
65 "Return list with information about the link at point.
67 - the position at the start of the link
68 - the position at the end of the link
70 - the link description (nil when on a plain link)"
71 (let ((el (org-element-context)))
72 ;; Don't use `org-element-lineage' because it isn't available
73 ;; until Org version 8.3.
74 (while (and el
(not (memq (car el
) '(link))))
75 (setq el
(org-element-property :parent el
)))
76 (unless (eq (car el
) 'link
)
77 (user-error "Point is not on a link"))
79 (goto-char (org-element-property :begin el
))
81 ;; Use match-{beginning,end} because match-end is consistently
82 ;; positioned after ]], while the :end property is positioned
83 ;; at the next word on the line, if one is present.
84 ((looking-at org-bracket-link-regexp
)
85 (list (match-beginning 0)
87 (org-link-unescape (match-string-no-properties 1))
88 (or (and (match-end 3)
89 (match-string-no-properties 3))
91 ((looking-at org-plain-link-re
)
92 (list (match-beginning 0)
94 (org-link-unescape (match-string-no-properties 0))
97 (error "What am I looking at?"))))))
99 (defun org-link-edit--forward-blob (n &optional no-punctuation
)
100 "Move forward N blobs (backward if N is negative).
102 A block of non-whitespace characters is a blob. If
103 NO-PUNCTUATION is non-nil, trailing punctuation characters are
104 not considered part of the blob when going in the forward
107 If the edge of the buffer is reached before completing the
108 movement, return nil. Otherwise, return t."
109 (let* ((forward-p (> n
0))
111 (skip-func (if forward-p
'skip-syntax-forward
'skip-syntax-backward
))
114 (funcall skip-func
" ")
115 (setq skip-func-retval
(funcall skip-func
"^ "))
116 (setq nblobs
(1- nblobs
)))
117 (when (and forward-p no-punctuation
)
118 (let ((punc-tail-offset (save-excursion (skip-syntax-backward "."))))
119 ;; Don't consider trailing punctuation as part of the blob
120 ;; unless the whole blob consists of punctuation.
121 (unless (= skip-func-retval
(- punc-tail-offset
))
122 (goto-char (+ (point) punc-tail-offset
)))))
123 (/= skip-func-retval
0)))
126 (defun org-link-edit-forward-slurp (&optional n
)
127 "Slurp N trailing blobs into link's description.
129 The \[\[http://orgmode.org/\]\[Org mode\]\] site
134 The \[\[http://orgmode.org/\]\[Org mode site\]\]
136 A blob is a block of non-whitespace characters. When slurping
137 forward, trailing punctuation characters are not considered part
140 After slurping, return the slurped text and move point to the
141 beginning of the link.
143 If N is negative, slurp leading blobs instead of trailing blobs."
149 (org-link-edit-backward-slurp (- n
)))
151 (cl-multiple-value-bind (beg end link desc
) (org-link-edit--get-link-data)
152 (goto-char (save-excursion
154 (or (org-link-edit--forward-blob n
'no-punctuation
)
155 (user-error "Not enough blobs after the link"))
157 (let ((slurped (buffer-substring-no-properties end
(point))))
158 (setq slurped
(replace-regexp-in-string "\n+" " " slurped
))
159 (when (and (= (length desc
) 0)
160 (string-match "^\\s-+\\(.*\\)" slurped
))
161 (setq slurped
(match-string 1 slurped
)))
162 (setq desc
(concat desc slurped
)
163 end
(+ end
(length slurped
)))
164 (delete-region beg
(point))
165 (insert (org-make-link-string link desc
))
170 (defun org-link-edit-backward-slurp (&optional n
)
171 "Slurp N leading blobs into link's description.
173 The \[\[http://orgmode.org/\]\[Org mode\]\] site
178 \[\[http://orgmode.org/\]\[The Org mode\]\] site
180 A blob is a block of non-whitespace characters.
182 After slurping, return the slurped text and move point to the
183 beginning of the link.
185 If N is negative, slurp trailing blobs instead of leading blobs."
191 (org-link-edit-forward-slurp (- n
)))
193 (cl-multiple-value-bind (beg end link desc
) (org-link-edit--get-link-data)
194 (goto-char (save-excursion
196 (or (org-link-edit--forward-blob (- n
))
197 (user-error "Not enough blobs before the link"))
199 (let ((slurped (buffer-substring-no-properties (point) beg
)))
200 (when (and (= (length desc
) 0)
201 (string-match "\\(.*\\)\\s-+$" slurped
))
202 (setq slurped
(match-string 1 slurped
)))
203 (setq slurped
(replace-regexp-in-string "\n+" " " slurped
))
204 (setq desc
(concat slurped desc
)
205 beg
(- beg
(length slurped
)))
206 (delete-region (point) end
)
207 (insert (org-make-link-string link desc
))
211 (defun org-link-edit--split-first-blobs (string n
)
212 "Split STRING into (N first blobs . other) cons cell.
213 'N first blobs' contains all text from the start of STRING up to
214 the start of the N+1 blob. 'other' includes the remaining text
215 of STRING. If the number of blobs in STRING is fewer than N,
217 (when (< n
0) (user-error "N cannot be negative"))
220 (goto-char (point-min))
221 (with-syntax-table org-mode-syntax-table
222 (let ((within-bound (org-link-edit--forward-blob n
)))
223 (skip-syntax-forward " ")
224 (cons (buffer-substring 1 (point))
226 (buffer-substring (point) (point-max))))))))
228 (defun org-link-edit--split-last-blobs (string n
)
229 "Split STRING into (other . N last blobs) cons cell.
230 'N last blobs' contains all text from the end of STRING back to
231 the end of the N+1 last blob. 'other' includes the remaining
232 text of STRING. If the number of blobs in STRING is fewer than
234 (when (< n
0) (user-error "N cannot be negative"))
237 (goto-char (point-max))
238 (with-syntax-table org-mode-syntax-table
239 (let ((within-bound (org-link-edit--forward-blob (- n
))))
240 (skip-syntax-backward " ")
241 (cons (and within-bound
242 (buffer-substring 1 (point)))
243 (buffer-substring (point) (point-max)))))))
246 (defun org-link-edit-forward-barf (&optional n
)
247 "Barf N trailing blobs from link's description.
249 The \[\[http://orgmode.org/\]\[Org mode\]\] site
254 The \[\[http://orgmode.org/\]\[Org\]\] mode site
256 A blob is a block of non-whitespace characters.
258 After barfing, return the barfed text and move point to the
259 beginning of the link.
261 If N is negative, barf leading blobs instead of trailing blobs."
267 (org-link-edit-backward-barf (- n
)))
269 (cl-multiple-value-bind (beg end link desc
) (org-link-edit--get-link-data)
270 (when (= (length desc
) 0)
271 (user-error "Link has no description"))
272 (pcase-let ((`(,new-desc .
,barfed
) (org-link-edit--split-last-blobs
274 (unless new-desc
(user-error "Not enough blobs in description"))
275 (delete-region beg end
)
276 (insert (org-make-link-string link new-desc
))
277 (if (string= new-desc
"")
278 ;; Two brackets are dropped when an empty description is
279 ;; passed to `org-make-link-string'.
280 (progn (goto-char (- end
(+ 2 (length desc
))))
281 (setq barfed
(concat " " barfed
)))
282 (goto-char (- end
(- (length desc
) (length new-desc
)))))
288 (defun org-link-edit-backward-barf (&optional n
)
289 "Barf N leading blobs from link's description.
291 The \[\[http://orgmode.org/\]\[Org mode\]\] site
296 The Org \[\[http://orgmode.org/\]\[mode\]\] site
298 A blob is a block of non-whitespace characters.
300 After barfing, return the barfed text and move point to the
301 beginning of the link.
303 If N is negative, barf trailing blobs instead of leading blobs."
309 (org-link-edit-forward-barf (- n
)))
311 (cl-multiple-value-bind (beg end link desc
) (org-link-edit--get-link-data)
312 (when (= (length desc
) 0)
313 (user-error "Link has no description"))
314 (pcase-let ((`(,barfed .
,new-desc
) (org-link-edit--split-first-blobs
316 (unless new-desc
(user-error "Not enough blobs in description"))
317 (delete-region beg end
)
318 (insert (org-make-link-string link new-desc
))
319 (when (string= new-desc
"")
320 (setq barfed
(concat barfed
" ")))
323 (goto-char (+ beg
(length barfed
)))
326 (provide 'org-link-edit
)
327 ;;; org-link-edit.el ends here