Hello, Bastien <b...@gnu.org> writes:
>>> Now, I'm not sure who wants to try implementing Nicolas suggestion to >>> let ox.el expand attachments into file links: since you both know the >>> issue better than I do, I suggest one of you can try? >> >> I will try to propose a patch by tomorrow evening. > > Thanks! > > If things are okay, I'll then have some time on sunday to prepare for > the release on monday. This is the first part of the suggested changes. These do not touch attachment modifications, but rather improve the tooling in "ol.el". In a nutshell: `org-link-parameters' accepts a new property, :open, which is like :follow, but function installed there is called with a universal prefix argument. It could replace :follow altogether, but for compatibility reasons, they both live side by side for the moment. Also, :export function is called with a fourth argument, the export info channel. I updated the export back-ends to handle the new signature, and provided a compatibility layers for link libraries in the wild, which may still use three arguments. There are two new tools: `org-link-open-as-file' and `org-export-link-as-file'. They can be used as helper functions for, respectively, :open and :export functions. WDYT? Regards, -- Nicolas Goaziou
>From 59172eb6c5edd5e74a6fd248e975065437bf5072 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <m...@nicolasgoaziou.fr> Date: Fri, 14 Feb 2020 10:00:15 +0100 Subject: [PATCH 1/2] Extend export tooling in link parameters * lisp/ol.el (org-link-parameters): Allow a fourth "info" argument for `:export' property. Expound docstring. * lisp/ox.el (org-export-custom-protocol-maybe): Accept a fourth optional argument. * lisp/ox-ascii.el (org-ascii--describe-links): (org-ascii-link): * lisp/ox-beamer.el (org-beamer-link): * lisp/ox-html.el (org-html-link): * lisp/ox-latex.el (org-latex-link): * lisp/ox-man.el (org-man-link): * lisp/ox-md.el (org-md-link): * lisp/ox-odt.el (org-odt-link): * lisp/ox-org.el (org-org-link): * lisp/ox-texinfo.el (org-texinfo-link): * contrib/lisp/ox-groff.el (org-groff-link): Provide expected fourth argument. * lisp/ox.el (org-export-link-as-file): New function. * lisp/ol.el (org-link-parameters): Add reference to new function in docstring. * testing/lisp/test-ox.el (test-org-export/link-as-file): Add tests. (test-org-export/custom-protocol-maybe): Update tests. --- contrib/lisp/ox-groff.el | 2 +- lisp/ol.el | 99 ++++++++++++++++++++++++++++++---------- lisp/ox-ascii.el | 4 +- lisp/ox-beamer.el | 2 +- lisp/ox-html.el | 2 +- lisp/ox-latex.el | 2 +- lisp/ox-man.el | 4 +- lisp/ox-md.el | 2 +- lisp/ox-odt.el | 2 +- lisp/ox-org.el | 4 +- lisp/ox-texinfo.el | 2 +- lisp/ox.el | 37 +++++++++++---- testing/lisp/test-ox.el | 32 +++++++++++-- 13 files changed, 146 insertions(+), 48 deletions(-) diff --git a/contrib/lisp/ox-groff.el b/contrib/lisp/ox-groff.el index 9f7d3f11f..9f0a32432 100644 --- a/contrib/lisp/ox-groff.el +++ b/contrib/lisp/ox-groff.el @@ -1248,7 +1248,7 @@ INFO is a plist holding contextual information. See ((string= type "file") (org-export-file-uri raw-path)) (t raw-path)))) (cond - ((org-export-custom-protocol-maybe link desc 'groff)) + ((org-export-custom-protocol-maybe link desc 'groff info)) ;; Image file. (imagep (org-groff-link--inline-image link info)) ;; import groff files diff --git a/lisp/ol.el b/lisp/ol.el index ce53b3e69..f850a5313 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -86,42 +86,93 @@ :group 'org) (defcustom org-link-parameters nil - "An alist of properties that defines all the links in Org mode. + "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 plist of link properties. +Subsequent optional elements make up a property list for that +type. + +All properties ar optional. However, the most important ones +are, in this order, `:follow', `:export', and `:store', described +below. + +`:follow' + + Function that takes the link path (a string) as an argument and + \"opens\" the link. + +`:export' + + Function that accepts three mandatory arguments : + - the path, as a string, + - the description as a string, or nil, + - the export back-end. + + Optionally, it may accept the export communication channel as + a fourth argument, in case you need using Org Export tooling, + e.g., `org-export-link-as-file'. + + When nil, export for that type of link is delegated to the + back-end. + +`:store' + + Function responsible for storing the link. See the function + `org-store-link-functions' for a description of the expected + arguments. + +Additional properties provide more specific control over the +link. + +`:activate-func' + + Function to run at the end of Font Lock activation. It must + accept four arguments: + - the buffer position at the start of the link, + - the buffer position at its end, + - the path, as a string, + - a boolean, non-nil when the link has brackets. + +`:complete' + + Function that inserts a link with completion. The function + takes one optional prefix argument. + +`:display' + + Value for `invisible' text property on the hidden parts of the + link. The most useful value is `full', which will not fold the + link in descriptive display. Default is `org-link'. + +`:face' -:follow - A function that takes the link path as an argument. + Face for the link, or a function returning a face. The + function takes one argument, which is the path. -:export - A function that takes the link path, description and -export-backend as arguments. + The default face is `org-link'. -:store - A function responsible for storing the link. See the -function `org-store-link-functions'. +`:help-echo' -:complete - A function that inserts a link with completion. The -function takes one optional prefix argument. + String or function used as a value for the `help-echo' text + property. The function is called with one argument, the help + string to display, and should return a string. -: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'. +`:htmlize-link' -:mouse-face - The mouse-face. The default is `highlight'. + Function or plist for the `htmlize-link' text property. The + function takes no argument. -:display - `full' will not fold the link in descriptive -display. Default is `org-link'. + Default is (:uri \"type:path\") -:help-echo - A string or function that takes (window object position) -as arguments and returns a string. +`:keymap' -:keymap - A keymap that is active on the link. The default is -`org-mouse-map'. + Active keymap when point is on the link. Default is + `org-mouse-map'. -:htmlize-link - A function for the htmlize-link. Defaults -to (list :uri \"type:path\") +`:mouse-face' -: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." + Face used when hovering over the link. Default is + `highlight'." :group 'org-link :package-version '(Org . "9.1") :type '(alist :tag "Link display parameters" diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index 4ffb44a97..dc9846647 100644 --- a/lisp/ox-ascii.el +++ b/lisp/ox-ascii.el @@ -957,7 +957,7 @@ channel." ((not (org-element-contents link)) nil) ;; Do not add a link already handled by custom export ;; functions. - ((org-export-custom-protocol-maybe link anchor 'ascii) nil) + ((org-export-custom-protocol-maybe link anchor 'ascii info) nil) (t (concat (org-ascii--fill-string @@ -1578,7 +1578,7 @@ INFO is a plist holding contextual information." (concat type ":" raw-path)) (t (concat type ":" raw-path))))) (cond - ((org-export-custom-protocol-maybe link desc 'ascii)) + ((org-export-custom-protocol-maybe link desc 'ascii info)) ((string= type "coderef") (format (org-export-get-coderef-format path desc) (org-export-resolve-coderef path info))) diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el index 23656db44..66589fac5 100644 --- a/lisp/ox-beamer.el +++ b/lisp/ox-beamer.el @@ -731,7 +731,7 @@ channel." "Transcode a LINK object into Beamer code. CONTENTS is the description part of the link. INFO is a plist used as a communication channel." - (or (org-export-custom-protocol-maybe link contents 'beamer) + (or (org-export-custom-protocol-maybe link contents 'beamer info) ;; Fall-back to LaTeX export. However, prefer "\hyperlink" over ;; "\hyperref" since the former handles overlay specifications. (let ((latex-link (org-export-with-backend 'latex link contents info))) diff --git a/lisp/ox-html.el b/lisp/ox-html.el index ea6aa63c3..1ce41ee1a 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -3054,7 +3054,7 @@ INFO is a plist holding contextual information. See (if (org-string-nw-p attr) (concat " " attr) "")))) (cond ;; Link type is handled by a special function. - ((org-export-custom-protocol-maybe link desc 'html)) + ((org-export-custom-protocol-maybe link desc 'html info)) ;; Image file. ((and (plist-get info :html-inline-images) (org-export-inline-image-p diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 1361f336c..bf242db08 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -2537,7 +2537,7 @@ INFO is a plist holding contextual information. See raw-path))))) (cond ;; Link type is handled by a special function. - ((org-export-custom-protocol-maybe link desc 'latex)) + ((org-export-custom-protocol-maybe link desc 'latex info)) ;; Image file. (imagep (org-latex--inline-image link info)) ;; Radio link: Transcode target's contents and use them as link's diff --git a/lisp/ox-man.el b/lisp/ox-man.el index b6925c696..dce11f450 100644 --- a/lisp/ox-man.el +++ b/lisp/ox-man.el @@ -603,7 +603,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;; Link -(defun org-man-link (link desc _info) +(defun org-man-link (link desc info) "Transcode a LINK object from Org to Man. DESC is the description part of the link, or the empty string. @@ -623,7 +623,7 @@ INFO is a plist holding contextual information. See (t raw-path)))) (cond ;; Link type is handled by a special function. - ((org-export-custom-protocol-maybe link desc 'man)) + ((org-export-custom-protocol-maybe link desc 'man info)) ;; External link with a description part. ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc)) ;; External link without a description part. diff --git a/lisp/ox-md.el b/lisp/ox-md.el index 7515df3a2..0e2559afe 100644 --- a/lisp/ox-md.el +++ b/lisp/ox-md.el @@ -412,7 +412,7 @@ INFO is a plist holding contextual information. See (t raw-path)))) (cond ;; Link type is handled by a special function. - ((org-export-custom-protocol-maybe link desc 'md)) + ((org-export-custom-protocol-maybe link desc 'md info)) ((member type '("custom-id" "id" "fuzzy")) (let ((destination (if (string= type "fuzzy") (org-export-resolve-fuzzy-link link info) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index 49e37cc1d..64bb97811 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -2715,7 +2715,7 @@ INFO is a plist holding contextual information. See (path (replace-regexp-in-string "&" "&" path))) (cond ;; Link type is handled by a special function. - ((org-export-custom-protocol-maybe link desc 'odt)) + ((org-export-custom-protocol-maybe link desc 'odt info)) ;; Image file. ((and (not desc) imagep) (org-odt-link--inline-image link info)) ;; Formula file. diff --git a/lisp/ox-org.el b/lisp/ox-org.el index 97d8d0e92..740419e0e 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -165,11 +165,11 @@ CONTENTS is nil. INFO is ignored." '("AUTHOR" "CREATOR" "DATE" "EMAIL" "OPTIONS" "TITLE")) (org-element-keyword-interpreter keyword nil)))) -(defun org-org-link (link contents _info) +(defun org-org-link (link contents info) "Transcode LINK object back into Org syntax. CONTENTS is the description of the link, as a string, or nil. INFO is a plist containing current export state." - (or (org-export-custom-protocol-maybe link contents 'org) + (or (org-export-custom-protocol-maybe link contents 'org info) (org-element-link-interpreter link contents))) (defun org-org-template (contents info) diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el index 89c6746d8..50d131fed 100644 --- a/lisp/ox-texinfo.el +++ b/lisp/ox-texinfo.el @@ -1064,7 +1064,7 @@ INFO is a plist holding contextual information. See (org-export-file-uri raw-path)) (t raw-path)))) (cond - ((org-export-custom-protocol-maybe link desc 'texinfo)) + ((org-export-custom-protocol-maybe link desc 'texinfo info)) ((org-export-inline-image-p link org-texinfo-inline-image-rules) (org-texinfo--inline-image link info)) ((equal type "radio") diff --git a/lisp/ox.el b/lisp/ox.el index b5cf9cc73..260efecba 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -4185,8 +4185,23 @@ meant to be translated with `org-export-data' or alike." (org-define-error 'org-link-broken "Unable to resolve link; aborting") -(defun org-export-custom-protocol-maybe (link desc backend) - "Try exporting LINK with a dedicated function. +(defun org-export-link-as-file (path description backend info) + "Pretend PATH is a file name, and export it. + +DESCRIPTION, when non-nil, is the description of the link, as +a string. BACKEND is the symbol representing the back-end used +for export. INFO is the communication channel, as a plist. + +This function is meant to be used as a possible tool for +`:export' property in `org-link-parameters'." + (org-export-data-with-backend + (org-element-parse-secondary-string + (org-link-make-string (concat "file:" path) description) '(link)) + backend + info)) + +(defun org-export-custom-protocol-maybe (link desc backend &optional info) + "Try exporting LINK object with a dedicated function. DESC is its description, as a string, or nil. BACKEND is the back-end used for export, as a symbol. @@ -4197,14 +4212,20 @@ A custom protocol has precedence over regular back-end export. The function ignores links with an implicit type (e.g., \"custom-id\")." (let ((type (org-element-property :type link))) - (unless (or (member type '("coderef" "custom-id" "fuzzy" "radio")) + (unless (or (member type '("coderef" "custom-id" "fuzzy" "radio" nil)) (not backend)) - (let ((protocol (org-link-get-parameter type :export))) + (let ((protocol (org-link-get-parameter type :export)) + (path (org-element-property :path link))) (and (functionp protocol) - (funcall protocol - (org-element-property :path link) - desc - backend)))))) + (condition-case nil + (funcall protocol path desc backend info) + ;; XXX: The function used (< Org 9.4) to accept only + ;; three mandatory arguments. Type-specific `:export' + ;; functions in the wild may not handle current + ;; signature. Provide backward compatibility support + ;; for them. + (wrong-number-of-arguments + (funcall protocol path desc backend)))))))) (defun org-export-get-coderef-format (path desc) "Return format string for code reference link. diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index 29916b4f6..551d9b717 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -2965,6 +2965,32 @@ Para2" ;;; Links +(ert-deftest test-org-export/link-as-file () + "Test `org-export-link-as-file' specifications." + ;; Export path as a "file"-type link. + (should + (equal "success" + (let ((backend + (org-export-create-backend + :name 'test + :transcoders + '((link . (lambda (l _c _i) + (if (equal "file" (org-element-property :type l)) + "success" + "failure"))))))) + (org-export-link-as-file "foo.org" nil backend nil)))) + ;; Exported path handles "file"-type specific properties, + ;; e.g., :search-option. + (should + (equal "bar" + (let ((backend + (org-export-create-backend + :name 'test + :transcoders + '((link . (lambda (l _c _i) + (org-element-property :search-option l))))))) + (org-export-link-as-file "foo.org::bar" nil backend nil))))) + (ert-deftest test-org-export/custom-protocol-maybe () "Test `org-export-custom-protocol-maybe' specifications." (should @@ -2980,7 +3006,7 @@ Para2" '((section . (lambda (s c i) c)) (paragraph . (lambda (p c i) c)) (link . (lambda (l c i) - (or (org-export-custom-protocol-maybe l c 'test) + (or (org-export-custom-protocol-maybe l c 'test i) "failure"))))))))) (should-not (string-match @@ -2996,7 +3022,7 @@ Para2" '((section . (lambda (s c i) c)) (paragraph . (lambda (p c i) c)) (link . (lambda (l c i) - (or (org-export-custom-protocol-maybe l c 'no-test) + (or (org-export-custom-protocol-maybe l c 'no-test i) "failure"))))))))) ;; Ignore anonymous back-ends. (should-not @@ -3012,7 +3038,7 @@ Para2" '((section . (lambda (s c i) c)) (paragraph . (lambda (p c i) c)) (link . (lambda (l c i) - (or (org-export-custom-protocol-maybe l c nil) + (or (org-export-custom-protocol-maybe l c nil i) "failure")))))))))) (ert-deftest test-org-export/get-coderef-format () -- 2.25.0
>From 371a3294887cdb714aff14494c5286a19524c807 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <m...@nicolasgoaziou.fr> Date: Sat, 15 Feb 2020 17:31:34 +0100 Subject: [PATCH 2/2] ol: Extend open tooling in link parameters * lisp/ol.el (org-link-parameters): Add :open parameter. (org-link-open): Call custom-link functions after internal ones. (org-link-open-as-file): New function. (org-link-parameters): Reference new function. (org-link-open): Use new function. --- lisp/ol.el | 75 +++++++++++++++++++++++++++++++----------------------- 1 file changed, 43 insertions(+), 32 deletions(-) diff --git a/lisp/ol.el b/lisp/ol.el index f850a5313..710947c92 100644 --- a/lisp/ol.el +++ b/lisp/ol.el @@ -93,13 +93,21 @@ Subsequent optional elements make up a property list for that type. All properties ar optional. However, the most important ones -are, in this order, `:follow', `:export', and `:store', described -below. +are, in this order, `:open' (or `:follow'), `:export', and +`:store', described below. +`:open' `:follow' - Function that takes the link path (a string) as an argument and - \"opens\" the link. + Function used to follow the link, when `org-open-at-point' is + command runs on it. + + The function stored in `:open' is called with two arguments: + the path, as a string, and a universal prefix argument, whereas + the one stored in `:follow' is called with the path only. + + You may use `org-link-open-as-file' helper function for types + similar to \"file\". `:export' @@ -990,37 +998,14 @@ for internal and \"file\" links, or stored as a parameter in (let ((type (org-element-property :type link)) (path (org-element-property :path link))) (cond + ;; Opening a "file" link requires special treatment since we + ;; first need to integrate search option, if any. ((member type '("file" "attachment")) (when (string= type "attachment") (setq path (org-attach-link-expand link))) - (if (string-match "[*?{]" (file-name-nondirectory path)) - (dired path) - ;; Look into `org-link-parameters' in order to find - ;; a DEDICATED-FUNCTION to open file. The function will be - ;; applied on raw link instead of parsed link due to the - ;; limitation in `org-add-link-type' ("open" function called - ;; with a single argument). If no such function is found, - ;; fallback to `org-open-file'. - (let* ((option (org-element-property :search-option link)) - (app (org-element-property :application link)) - (dedicated-function - (org-link-get-parameter (if app (concat type "+" app) type) - :follow))) - (if dedicated-function - (funcall dedicated-function - (concat path - (and option (concat "::" option)))) - (apply #'org-open-file - path - (cond (arg) - ((equal app "emacs") 'emacs) - ((equal app "sys") 'system)) - (cond ((not option) nil) - ((string-match-p "\\`[0-9]+\\'" option) - (list (string-to-number option))) - (t (list nil option)))))))) - ((functionp (org-link-get-parameter type :follow)) - (funcall (org-link-get-parameter type :follow) path)) + (let* ((option (org-element-property :search-option link)) + (path (if option (concat path "::" option) path))) + (org-link-open-as-file path arg))) ((member type '("coderef" "custom-id" "fuzzy" "radio")) (unless (run-hook-with-args-until-success 'org-open-link-functions path) (if (not arg) (org-mark-ring-push) @@ -1042,6 +1027,10 @@ for internal and \"file\" links, or stored as a parameter in (>= (point-max) destination)) (widen)) (goto-char destination)))) + ((functionp (org-link-get-parameter type :open)) + (funcall (org-link-get-parameter type :open) path arg)) + ((functionp (org-link-get-parameter type :follow)) + (funcall (org-link-get-parameter type :follow) path)) (t (browse-url-at-point))))) (defun org-link-open-from-string (s &optional arg) @@ -1240,6 +1229,28 @@ of matched result, which is either `dedicated' or `fuzzy'." (reverse slines))) "\n"))))) (mapconcat #'identity (split-string s) " "))) +(defun org-link-open-as-file (path arg) + "Pretend PATH is a file name and open it. + +According to \"file\"-link syntax, PATH may include addition +search options, separated from the file name with \"::\". + +This function is meant to be used as a possible tool for `:open' +property in `org-link-parameters.'" + (if (string-match "[*?{]" (file-name-nondirectory path)) + (dired path) + (let* ((option (and (string-match "::\\(.*\\)\\'" path) + (match-string 1 path))) + (path (if (not option) path + (substring path 0 (match-beginning 0))))) + (apply #'org-open-file + path + arg + (cond ((not option) nil) + ((string-match-p "\\`[0-9]+\\'" option) + (list (string-to-number option))) + (t (list nil option))))))) + (defun org-link-display-format (s) "Replace links in string S with their description. If there is no description, use the link target." -- 2.25.0