Merge branch 'maint'

This commit is contained in:
Kyle Meyer 2017-04-09 20:52:41 -04:00
commit 1336347065
4 changed files with 93 additions and 31 deletions

View File

@ -1,12 +1,12 @@
;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Kyle Meyer <kyle@kyleam.com>
;; Copyright (C) 2015-2017 Kyle Meyer <kyle@kyleam.com>
;; Author: Kyle Meyer <kyle@kyleam.com>
;; URL: https://github.com/kyleam/org-link-edit
;; URL: https://gitlab.com/kyleam/org-link-edit
;; Keywords: convenience
;; Version: 1.0.1
;; Package-Requires: ((cl-lib "0.5") (org "8.2"))
;; Version: 1.1.0
;; Package-Requires: ((cl-lib "0.5") (org "8.2.10"))
;; 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
@ -26,8 +26,8 @@
;; Org Link Edit provides Paredit-inspired slurping and barfing
;; commands for Org link descriptions.
;;
;; There are four commands, all which operate when point is on an Org
;; link.
;; There are four slurp and barf commands, all which operate when
;; point is on an Org link.
;;
;; - org-link-edit-forward-slurp
;; - org-link-edit-backward-slurp
@ -53,6 +53,11 @@
;; ("i" org-link-edit-backward-barf "backward barf")
;; ("q" nil "cancel")))
;;
;; In addition to the slurp and barf commands, the command
;; `org-link-edit-transport-next-link' searches for the next (or
;; previous) link and moves it to point, using the word at point or
;; the selected region as the link's description.
;;
;; [1] https://github.com/abo-abo/hydra
;;; Code:
@ -61,7 +66,15 @@
(require 'org-element)
(require 'cl-lib)
(defun org-link-edit--get-link-data ()
(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)))
(defun org-link-edit--link-data ()
"Return list with information about the link at point.
The list includes
- the position at the start of the link
@ -69,11 +82,7 @@ The list includes
- the link text
- the link description (nil when on a plain link)"
(let ((el (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)))
(unless (eq (car el) 'link)
(unless (org-link-edit--on-link-p el)
(user-error "Point is not on a link"))
(save-excursion
(goto-char (org-element-property :begin el))
@ -84,7 +93,8 @@ The list includes
((looking-at org-bracket-link-regexp)
(list (match-beginning 0)
(match-end 0)
(org-link-unescape (match-string-no-properties 1))
(save-match-data
(org-link-unescape (match-string-no-properties 1)))
(or (and (match-end 3)
(match-string-no-properties 3))
"")))
@ -148,7 +158,7 @@ If N is negative, slurp leading blobs instead of trailing blobs."
((< n 0)
(org-link-edit-backward-slurp (- n)))
(t
(cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data)
(cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data)
(goto-char (save-excursion
(goto-char end)
(or (org-link-edit--forward-blob n 'no-punctuation)
@ -190,7 +200,7 @@ If N is negative, slurp trailing blobs instead of leading blobs."
((< n 0)
(org-link-edit-forward-slurp (- n)))
(t
(cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data)
(cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data)
(goto-char (save-excursion
(goto-char beg)
(or (org-link-edit--forward-blob (- n))
@ -266,20 +276,17 @@ If N is negative, barf leading blobs instead of trailing blobs."
((< n 0)
(org-link-edit-backward-barf (- n)))
(t
(cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data)
(cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data)
(when (= (length desc) 0)
(user-error "Link has no description"))
(pcase-let ((`(,new-desc . ,barfed) (org-link-edit--split-last-blobs
desc n)))
(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))
(if (string= new-desc "")
;; Two brackets are dropped when an empty description is
;; passed to `org-make-link-string'.
(progn (goto-char (- end (+ 2 (length desc))))
(setq barfed (concat " " barfed)))
(goto-char (- end (- (length desc) (length new-desc)))))
(when (string= new-desc "")
(setq barfed (concat " " barfed)))
(insert barfed)
(goto-char beg)
barfed)))))
@ -308,20 +315,75 @@ If N is negative, barf trailing blobs instead of leading blobs."
((< n 0)
(org-link-edit-forward-barf (- n)))
(t
(cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data)
(cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data)
(when (= (length desc) 0)
(user-error "Link has no description"))
(pcase-let ((`(,barfed . ,new-desc) (org-link-edit--split-first-blobs
desc n)))
(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))
(when (string= new-desc "")
(setq barfed (concat barfed " ")))
(goto-char beg)
(insert barfed)
(goto-char (+ beg (length barfed)))
barfed)))))
(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-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)
"Move the next link to point.
If the region is active, use the selected text as the link's
description. Otherwise, use the word at point.
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)))))
(let ((pt (point))
(desc-bounds (cond
((and beg end)
(cons (progn (goto-char beg)
(point-marker))
(progn (goto-char end)
(point-marker))))
((not (looking-at-p "\\s-"))
(progn (skip-syntax-backward "w")
(let ((beg (point-marker)))
(skip-syntax-forward "w")
(cons beg (point-marker))))))))
(when (or (and desc-bounds
(or (progn (goto-char (car desc-bounds))
(org-link-edit--on-link-p))
(progn (goto-char (cdr desc-bounds))
(org-link-edit--on-link-p))))
(progn (goto-char pt)
(org-link-edit--on-link-p)))
(user-error "Cannot transport next link with point on a link"))
(goto-char (car desc-bounds))
(cl-multiple-value-bind (link-beg link-end link desc)
(org-link-edit--next-link-data previous)
(unless (or (not desc-bounds) (= (length desc) 0))
(user-error "Link already has a description"))
(delete-region link-beg link-end)
(insert (org-make-link-string
link
(and desc-bounds
(delete-and-extract-region (car desc-bounds)
(cdr desc-bounds))))))))
(provide 'org-link-edit)
;;; org-link-edit.el ends here

View File

@ -3200,7 +3200,7 @@ Point is left at list's end."
(defun org-list-insert-radio-list ()
"Insert a radio list template appropriate for this major mode."
(interactive)
(let* ((e (assq major-mode org-list-radio-list-templates))
(let* ((e (cl-assoc-if #'derived-mode-p org-list-radio-list-templates))
(txt (nth 1 e))
name pos)
(unless e (error "No radio list setup defined for %s" major-mode))

View File

@ -4485,7 +4485,7 @@ to execute outside of tables."
"--"
("Radio tables"
["Insert table template" orgtbl-insert-radio-table
(assq major-mode orgtbl-radio-table-templates)]
(cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)]
["Comment/uncomment table" orgtbl-toggle-comment t])
"--"
["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
@ -4734,7 +4734,7 @@ First element has index 0, or I0 if given."
(defun orgtbl-insert-radio-table ()
"Insert a radio table template appropriate for this major mode."
(interactive)
(let* ((e (assq major-mode orgtbl-radio-table-templates))
(let* ((e (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates))
(txt (nth 1 e))
name pos)
(unless e (user-error "No radio table setup defined for %s" major-mode))

View File

@ -10341,10 +10341,10 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
;; Check if we can/should use a relative path. If yes, simplify the link
(let ((case-fold-search nil))
(when (string-match "\\`\\(file:\\|docview\\):" link)
(let ((type (match-string-no-properties 0 link))
(path (substring-no-properties link (match-end 0)))
(origpath path))
(when (string-match "\\`\\(file\\|docview\\):" link)
(let* ((type (match-string-no-properties 0 link))
(path (substring-no-properties link (match-end 0)))
(origpath path))
(cond
((or (eq org-link-file-path-type 'absolute)
(equal complete-file '(16)))