>From ddc863fc16b8fe4b430e2f86b7ad96a0e90219cc Mon Sep 17 00:00:00 2001 From: John Kitchin Date: Thu, 7 Jul 2016 09:58:29 -0400 Subject: [PATCH 01/20] Create `org-link-parameters' * lisp/org-element.el: Replace `org-link-types' variable with `org-link-types' function. * lisp/org.el: Replace the `org-link-types' variable with `org-link-types' function. Create `org-link-get-parameter' and `org-link-set-parameters' functions. Remove `org-add-link-type'. Add `org-store-link-functions' function and remove `org-store-link-functions' variable. Add `org--open-file-link' for use as a :follow function for file type links. * lisp/org.el: Set :follow functions for file links in `org-link-parameters. Define `org-open-file-link' that opens a file link with an app. * testing/lisp/test-ox.el: Remove usage of the `org-link-types' variable. * lisp/org-compat.el: Move `org-add-link-type' and mark it as obsolete. * lisp/ox.el: Change org-add-link-type comment in ox.el. --- lisp/org-compat.el | 31 +++++++++ lisp/org-element.el | 4 +- lisp/org.el | 167 ++++++++++++++++++++++++++++++++---------------- lisp/ox.el | 2 +- testing/lisp/test-ox.el | 16 ++--- 5 files changed, 155 insertions(+), 65 deletions(-) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 92fdb1c..a856ff7 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -374,6 +374,37 @@ Implements `define-error' for older emacsen." (put name 'error-conditions (copy-sequence (cons name (get 'error 'error-conditions)))))) +(defun org-add-link-type (type &optional follow export) + "Add a new TYPE link. +FOLLOW and EXPORT are two functions. + +FOLLOW should take the link path as the single argument and do whatever +is necessary to follow the link, for example find a file or display +a mail message. + +EXPORT should format the link path for export to one of the export formats. +It should be a function accepting three arguments: + + path the path of the link, the text after the prefix (like \"http:\") + desc the description of the link, if any + format the export format, a symbol like `html' or `latex' or `ascii'. + +The function may use the FORMAT information to return different values +depending on the format. The return value will be put literally into +the exported file. If the return value is nil, this means Org should +do what it normally does with links which do not have EXPORT defined. + +Org mode has a built-in default for exporting links. If you are happy with +this default, there is no need to define an export function for the link +type. For a simple example of an export function, see `org-bbdb.el'. + +If TYPE already exists, update it with the arguments. +See `org-link-parameters' for documentation on the other parameters." + (org-link-add type :follow follow :export export) + (message "Created %s link." type)) + +(make-obsolete 'org-add-link-type "org-link-add." "Org 9.0") + (provide 'org-compat) ;;; org-compat.el ends here diff --git a/lisp/org-element.el b/lisp/org-element.el index 269bc7d..9452641 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -185,7 +185,7 @@ specially in `org-element--object-lex'.") "\\)\\)") org-element--object-regexp (mapconcat #'identity - (let ((link-types (regexp-opt org-link-types))) + (let ((link-types (regexp-opt (org-link-types)))) (list ;; Sub/superscript. "\\(?:[_^][-{(*+.,[:alnum:]]\\)" @@ -3108,7 +3108,7 @@ Assume point is at the beginning of the link." (string-match "\\`\\.\\.?/" raw-link)) (setq type "file") (setq path raw-link)) - ;; Explicit type (http, irc, bbdb...). See `org-link-types'. + ;; Explicit type (http, irc, bbdb...). ((string-match org-link-types-re raw-link) (setq type (match-string 1 raw-link)) (setq path (substring raw-link (match-end 0)))) diff --git a/lisp/org.el b/lisp/org.el index 2202d41..5b92e12 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1758,6 +1758,73 @@ calls `table-recognize-table'." "Buffer-local version of `org-link-abbrev-alist', which see. The value of this is taken from the #+LINK lines.") +(defcustom org-link-parameters + '(("file" :complete #'org-file-complete-link) + ("file+emacs" :follow (lambda (path) (org--open-file-link path '(4)))) + ("file+sys" :follow (lambda (path) (org--open-file-link path 'system))) + ("http") ("https") ("ftp") ("mailto") + ("news") ("shell") ("elisp") + ("doi") ("message") ("help")) + "An alist of properties that defines all the links in Org mode. +The key in each association is a string of the link type. +Subsequent optional elements make up a p-list of link properties. + +:follow - A function that takes the link path as an argument. + +:export - A function that takes the link path, description and +export-backend as arguments. + +:store - A function responsible for storing the link. See the +function `org-store-link-functions'. + +:complete - A function that inserts a link with completion. The +function takes one optional prefix arg. + +:face - A face for the link, or a function that returns a face. +The function takes one argument which is the link path. The +default face is `org-link'. + +:mouse-face - The mouse-face. The default is `highlight'. + +:display - `full' will not fold the link in descriptive +display. Default is `org-link'. + +:help-echo - A string or function that takes (window object position) +as arguments and returns a string. + +:keymap - A keymap that is active on the link. The default is +`org-mouse-map'. + +:htmlize-link - A function for the htmlize-link. Defaults +to (list :uri \"type:path\") + +:activate-func - A function to run at the end of font-lock +activation. The function must accept (link-start link-end path bracketp) +as arguments." + :group 'org-link + :type '(alist :tag "Link display parameters" + :value-type plist)) + +(defun org-link-get-parameter (type key) + "Get TYPE link property for KEY. +TYPE is a string and KEY is a plist keyword." + (plist-get + (cdr (assoc type org-link-parameters)) + key)) + +(defun org-link-set-parameters (type &rest parameters) + "Set link TYPE properties to PARAMETERS. + PARAMETERS should be :key val pairs." + (let ((data (assoc type org-link-parameters))) + (if data (setcdr data (org-combine-plists (cdr data) parameters)) + (push (cons type parameters) org-link-parameters) + (org-make-link-regexps) + (org-element-update-syntax)))) + +(defun org-link-types () + "Returns a list of known link types." + (mapcar #'car org-link-parameters)) + (defcustom org-link-abbrev-alist nil "Alist of link abbreviations. The car of each element is a string, to be replaced at the start of a link. @@ -5490,7 +5557,7 @@ The following commands are available: org-display-table 4 (vconcat (mapcar (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) - org-ellipsis))) + org-ellipsis))) (if (stringp org-ellipsis) org-ellipsis "...")))) (setq buffer-display-table org-display-table)) (org-set-regexps-and-options) @@ -5658,9 +5725,6 @@ the rounding returns a past time." (require 'font-lock) (defconst org-non-link-chars "]\t\n\r<>") -(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "file+emacs" - "file+sys" "news" "shell" "elisp" "doi" "message" - "help")) (defvar org-link-types-re nil "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil @@ -5727,8 +5791,8 @@ stacked delimiters is N. Escaping delimiters is not possible." (defun org-make-link-regexps () "Update the link regular expressions. -This should be called after the variable `org-link-types' has changed." - (let ((types-re (regexp-opt org-link-types t))) +This should be called after the variable `org-link-parameters' has changed." + (let ((types-re (regexp-opt (org-link-types) t))) (setq org-link-types-re (concat "\\`" types-re ":") org-link-re-with-space @@ -5766,7 +5830,7 @@ This should be called after the variable `org-link-types' has changed." org-bracket-link-analytic-regexp++ (concat "\\[\\[" - "\\(" (regexp-opt (cons "coderef" org-link-types) t) ":\\)?" + "\\(" (regexp-opt (cons "coderef" (org-link-types)) t) ":\\)?" "\\([^]]+\\)" "\\]" "\\(\\[" "\\([^]]+\\)" "\\]\\)?" @@ -7393,7 +7457,7 @@ a block. Return a non-nil value when toggling is successful." ;; Remove overlays when changing major mode (add-hook 'org-mode-hook (lambda () (add-hook 'change-major-mode-hook - 'org-show-block-all 'append 'local))) + 'org-show-block-all 'append 'local))) ;;; Org-goto @@ -9666,60 +9730,32 @@ The refresh happens only for the current tree (not subtree)." (defvar org-store-link-plist nil "Plist with info about the most recently link created with `org-store-link'.") -(defvar org-link-protocols nil - "Link protocols added to Org-mode using `org-add-link-type'.") +(defun org-store-link-functions () + "Returns a list of functions that are called to create and store a link. +The functions defined in the :store property of +`org-link-parameters'. -(defvar org-store-link-functions nil - "List of functions that are called to create and store a link. Each function will be called in turn until one returns a non-nil -value. Each function should check if it is responsible for creating -this link (for example by looking at the major mode). -If not, it must exit and return nil. -If yes, it should return a non-nil value after a calling -`org-store-link-props' with a list of properties and values. -Special properties are: +value. Each function should check if it is responsible for +creating this link (for example by looking at the major mode). If +not, it must exit and return nil. If yes, it should return a +non-nil value after a calling `org-store-link-props' with a list +of properties and values. Special properties are: :type The link prefix, like \"http\". This must be given. :link The link, like \"http://www.astro.uva.nl/~dominik\". This is obligatory as well. :description Optional default description for the second pair of brackets in an Org-mode link. The user can still change - this when inserting this link into an Org-mode buffer. + this when inserting this link into an Org mode buffer. In addition to these, any additional properties can be specified -and then used in capture templates.") - -(defun org-add-link-type (type &optional follow export) - "Add TYPE to the list of `org-link-types'. -Re-compute all regular expressions depending on `org-link-types' - -FOLLOW and EXPORT are two functions. - -FOLLOW should take the link path as the single argument and do whatever -is necessary to follow the link, for example find a file or display -a mail message. - -EXPORT should format the link path for export to one of the export formats. -It should be a function accepting three arguments: - - path the path of the link, the text after the prefix (like \"http:\") - desc the description of the link, if any - format the export format, a symbol like `html' or `latex' or `ascii'. - -The function may use the FORMAT information to return different values -depending on the format. The return value will be put literally into -the exported file. If the return value is nil, this means Org should -do what it normally does with links which do not have EXPORT defined. - -Org mode has a built-in default for exporting links. If you are happy with -this default, there is no need to define an export function for the link -type. For a simple example of an export function, see `org-bbdb.el'." - (add-to-list 'org-link-types type t) - (org-make-link-regexps) - (org-element-update-syntax) - (if (assoc type org-link-protocols) - (setcdr (assoc type org-link-protocols) (list follow export)) - (push (list type follow export) org-link-protocols))) +and then used in capture templates." + (cl-loop for link in org-link-parameters + with store-func + do (setq store-func (org-link-get-parameter (car link) :store)) + if store-func + collect store-func)) (defvar org-agenda-buffer-name) ; Defined in org-agenda.el (defvar org-id-link-to-org-use-id) ; Defined in org-id.el @@ -9764,7 +9800,7 @@ active region." (delq nil (mapcar (lambda (f) (let (fs) (if (funcall f) (push f fs)))) - org-store-link-functions)) + (org-store-link-functions))) sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns)) (or (and (cdr sfuns) (funcall (intern @@ -10325,7 +10361,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (and (window-live-p cw) (select-window cw))) (setq all-prefixes (append (mapcar 'car abbrevs) (mapcar 'car org-link-abbrev-alist) - org-link-types)) + (org-link-types))) (unwind-protect ;; Fake a link history, containing the stored links. (let ((org--links-history @@ -10601,6 +10637,29 @@ they must return nil.") (defvar org-link-search-inhibit-query nil) ;; dynamically scoped (defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el +(defun org--open-file-link (path app) + "Open PATH using APP. + +PATH is from a file link, and can have the following syntax: + [[file:~/code/main.c::255]] + [[file:~/xx.org::My Target]] + [[file:~/xx.org::*My Target]] + [[file:~/xx.org::#my-custom-id]] + [[file:~/xx.org::/regexp/]] + +APP is '(4) to open the PATH in Emacs, or 'system to use a system application." + (let* ((fields (split-string path "::")) + (option (and (cdr fields) + (mapconcat #'identity (cdr fields) "")))) + (apply #'org-open-file + (car fields) + app + (cond ((not option) nil) + ((string-match-p "\\`[0-9]+\\'" option) + (list (string-to-number option))) + (t (list nil + (org-link-unescape option))))))) + (defun org-open-at-point (&optional arg reference-buffer) "Open link, timestamp, footnote or tags at point. diff --git a/lisp/ox.el b/lisp/ox.el index da985f3..3986ec3 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -4073,7 +4073,7 @@ meant to be translated with `org-export-data' or alike." ;;;; For Links ;; ;; `org-export-custom-protocol-maybe' handles custom protocol defined -;; with `org-add-link-type', which see. +;; in `org-link-parameters'. ;; ;; `org-export-get-coderef-format' returns an appropriate format ;; string for coderefs. diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index 8b07cca..09d2e2a 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -2571,8 +2571,8 @@ Para2" (should (string-match "success" - (let ((org-link-types (copy-sequence org-link-types))) - (org-add-link-type "foo" nil (lambda (p d f) "success")) + (progn + (org-link-set-parameters "foo" :export (lambda (p d f) "success")) (org-export-string-as "[[foo:path]]" (org-export-create-backend @@ -2586,9 +2586,9 @@ Para2" (should-not (string-match "success" - (let ((org-link-types (copy-sequence org-link-types))) - (org-add-link-type - "foo" nil (lambda (p d f) (and (eq f 'test) "success"))) + (progn + (org-link-set-parameters + "foo" :export (lambda (p d f) (and (eq f 'test) "success"))) (org-export-string-as "[[foo:path]]" (org-export-create-backend @@ -2603,9 +2603,9 @@ Para2" (should-not (string-match "success" - (let ((org-link-types (copy-sequence org-link-types))) - (org-add-link-type - "foo" nil (lambda (p d f) (and (eq f 'test) "success"))) + (progn + (org-link-set-parameters + "foo" :export (lambda (p d f) (and (eq f 'test) "success"))) (org-export-string-as "[[foo:path]]" (org-export-create-backend -- 2.9.0