ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

org-link-edit.el: Sync with upstream 

Update to version 1.2.1 (b5493e2).
This commit is contained in:
Kyle Meyer 2020-04-20 22:10:31 -04:00
parent bab2995c71
commit f874b69560
1 changed files with 30 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
contrib/lisp/org-link-edit.el
View File

@ -1,12 +1,12 @@
;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2017 Kyle Meyer <kyle@kyleam.com>
;; Copyright (C) 2015-2020 Kyle Meyer <kyle@kyleam.com>
;; Author: Kyle Meyer <kyle@kyleam.com>
;; URL: https://gitlab.com/kyleam/org-link-edit
;; URL: https://git.kyleam.com/org-link-edit/about
;; Keywords: convenience
;; Version: 1.1.1
;; Package-Requires: ((cl-lib "0.5") (org "8.2.10"))
;; Version: 1.2.1
;; Package-Requires: ((cl-lib "0.5") (org "9.3"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@ -19,7 +19,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@ -67,12 +67,7 @@
(require 'cl-lib)
(defun org-link-edit--on-link-p (&optional element)
(let ((el (or element (org-element-context))))
;; Don't use `org-element-lineage' because it isn't available
;; until Org version 8.3.
(while (and el (not (memq (car el) '(link))))
(setq el (org-element-property :parent el)))
(eq (car el) 'link)))
(org-element-lineage (or element (org-element-context)) '(link) t))
(defun org-link-edit--link-data ()
"Return list with information about the link at point.
@ -90,13 +85,13 @@ The list includes
;; Use match-{beginning,end} because match-end is consistently
;; positioned after ]], while the :end property is positioned
;; at the next word on the line, if one is present.
((looking-at org-bracket-link-regexp)
((looking-at org-link-bracket-re)
(list (match-beginning 0)
(match-end 0)
(save-match-data
(org-link-unescape (match-string-no-properties 1)))
(or (match-string-no-properties 2) "")))
((looking-at org-plain-link-re)
((looking-at org-link-plain-re)
(list (match-beginning 0)
(match-end 0)
(match-string-no-properties 0)
@ -170,7 +165,7 @@ If N is negative, slurp leading blobs instead of trailing blobs."
(setq desc (concat desc slurped)
end (+ end (length slurped)))
(delete-region beg (point))
(insert (org-make-link-string link desc))
(insert (org-link-make-string link desc))
(goto-char beg)
slurped)))))
@ -212,7 +207,7 @@ If N is negative, slurp trailing blobs instead of leading blobs."
(setq desc (concat slurped desc)
beg (- beg (length slurped)))
(delete-region (point) end)
(insert (org-make-link-string link desc))
(insert (org-link-make-string link desc))
(goto-char beg)
slurped)))))
@ -282,7 +277,7 @@ If N is negative, barf leading blobs instead of trailing blobs."
(unless new-desc (user-error "Not enough blobs in description"))
(goto-char beg)
(delete-region beg end)
(insert (org-make-link-string link new-desc))
(insert (org-link-make-string link new-desc))
(when (string= new-desc "")
(setq barfed (concat " " barfed)))
(insert barfed)
@ -321,7 +316,7 @@ If N is negative, barf trailing blobs instead of leading blobs."
(unless new-desc (user-error "Not enough blobs in description"))
(goto-char beg)
(delete-region beg end)
(insert (org-make-link-string link new-desc))
(insert (org-link-make-string link new-desc))
(when (string= new-desc "")
(setq barfed (concat barfed " ")))
(goto-char beg)
@ -331,12 +326,12 @@ If N is negative, barf trailing blobs instead of leading blobs."
(defun org-link-edit--next-link-data (&optional previous)
(save-excursion
(if (funcall (if previous #'re-search-backward #'re-search-forward)
org-any-link-re nil t)
org-link-any-re nil t)
(org-link-edit--link-data)
(user-error "No %s link found" (if previous "previous" "next")))))
;;;###autoload
(defun org-link-edit-transport-next-link (&optional previous beg end)
(defun org-link-edit-transport-next-link (&optional previous beg end overwrite)
"Move the next link to point.
If the region is active, use the selected text as the link's
@ -346,11 +341,16 @@ With prefix argument PREVIOUS, move the previous link instead of
the next link.
Non-interactively, use the text between BEG and END as the
description, moving the next (or previous) link relative BEG and
END."
(interactive (cons current-prefix-arg
(and (use-region-p)
(list (region-beginning) (region-end)))))
description, moving the next (or previous) link relative to BEG
and END. By default, refuse to overwrite an existing
description. If OVERWRITE is `ask', prompt for confirmation
before overwriting; for any other non-nil value, overwrite
without asking."
(interactive `(,current-prefix-arg
,@(if (use-region-p)
(list (region-beginning) (region-end))
(list nil nil))
ask))
(let ((pt (point))
(desc-bounds (cond
((and beg end)
@ -374,10 +374,14 @@ END."
(goto-char (or (car desc-bounds) pt))
(cl-multiple-value-bind (link-beg link-end link orig-desc)
(org-link-edit--next-link-data previous)
(unless (or (not desc-bounds) (= (length orig-desc) 0))
(unless (or (not desc-bounds)
(= (length orig-desc) 0)
(if (eq overwrite 'ask)
(y-or-n-p "Overwrite existing description?")
overwrite))
(user-error "Link already has a description"))
(delete-region link-beg link-end)
(insert (org-make-link-string
(insert (org-link-make-string
link
(if desc-bounds
(delete-and-extract-region (car desc-bounds)