[PATCH v4] ol.el: add description format parameter to org-link-parameters

[Hugo Heagren <hugo@heagren.com>]

[-- Attachment #1: Type: text/plain, Size: 1749 bytes --]

Since the last version of this patch, I have:
- moved the code which sets `type' in `org-insert-link' to a position
  where it covers more cases
- rewritten the macros used in the tests, so that always (and
  correctly) restore the original state after running, even after
  errors. Thanks to Max Nikulin for suggesting using `condition-case'

There is only one thing left which I am not happy with. Currently, the
test fails in the case where :default-description is 'ignore. This was
intended to test for situations where the parameter is set to a
function, but the function doesn't return a string (I used ignore
because it returns 'nil). Accordingly, the test is a `should-error'
(because the function *should* return a string, so we should error if
it doesn't, right?).

But the error condition is inside the error clause of a condition
case---which is only triggered if the code errors. Calling 'ignore
with any arguments and getting 'nil back doesn't cause any errors, so
the error clause is never triggered, and 'nil is just used as the
default description (which is then ignored, because it is 'nil --
other non-string values like numbers would not be ignored).

I'd like some input on what to do about this: I could rewrite the
tests so that a nil-value doesn't matter. In the case of this test, a
non-interactive call would just insert a link without a description.
Alternatively I could rewrite the function so that if the
:default-description parameter returns something, we error unless it
is a string.

tl;dr The question is: what is the Good Behaviour when
:default-description is set to something, which is meant to return a
string and returns 'nil instead? Should it be treated like an empty
string, or as an error?

Thanks,

Hugo

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-test-ol-tests-for-default-description-param-when-ins.patch --]
[-- Type: text/x-diff, Size: 4182 bytes --]

From ae17e87436def764f99b24add4debb5d7a481e1a Mon Sep 17 00:00:00 2001
From: Hugo Heagren <hugo@heagren.com>
Date: Tue, 21 Jun 2022 12:45:50 +0100
Subject: [PATCH 2/2] test-ol: tests for default-description param when
 inserting links

Add tests for various values of `:default-description' in
`org-link-parameters'.
---
 testing/lisp/test-ol.el | 92 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 92 insertions(+)

diff --git a/testing/lisp/test-ol.el b/testing/lisp/test-ol.el
index 429bb52ee..9114c6497 100644
--- a/testing/lisp/test-ol.el
+++ b/testing/lisp/test-ol.el
@@ -625,5 +625,97 @@ See https://github.com/yantar92/org/issues/4."
     (test-ol-parse-link-in-text
         "The <point>http://foo.com/(something)?after=parens link"))))
 
+;;; Insert Links
+
+(defmacro test-ol-with-link-parameters-as (type parameters &rest body)
+  "Pass TYPE/PARAMETERS to `org-link-parameters' and execute BODY.
+
+Save the original value of `org-link-parameters', execute
+`org-link-set-parameters' with the relevant args, execute BODY
+and restore `org-link-parameters'.
+
+TYPE is as in `org-link-set-parameters'.  PARAMETERS is a plist to
+be passed to `org-link-set-parameters'."
+  ;; Copy all keys in `parameters' and their original values to
+  ;; `orig-parameters'. For `parity': nil = odd, non-nill = even
+  `(let (parity orig-parameters)
+     (dolist (p ',parameters)
+       (unless parity
+         (setq orig-parameters
+               (plist-put orig-parameters p (org-link-get-parameter ,type p))))
+       (setq parity (not parity)))
+     ;; Set `parameters' values
+     (condition-case err
+         (let ((_ (org-link-set-parameters ,type ,@parameters))
+               ;; Do body
+               (rtn (progn ,@body)))
+           ;; Restore original values
+           (apply 'org-link-set-parameters ,type orig-parameters)
+           ;; Return whatever the body returned
+           rtn)
+       ;; In case of error, restore state anyway AND really error
+       (error
+        (apply 'org-link-set-parameters ,type orig-parameters)
+        (signal (car err) (cdr err))))))
+
+(defun test-ol-insert-link-get-desc (&optional link-location description)
+  "Insert link in temp buffer, return description.
+
+LINK-LOCATION and DESCRIPTION are passed to
+`org-insert-link' (COMPLETE-FILE is always nil)."
+  (org-test-with-temp-text ""
+    (org-insert-link nil link-location description)
+    (save-match-data
+      (when (and
+             (org-in-regexp org-link-bracket-re 1)
+             (match-end 2))
+        (match-string-no-properties 2)))))
+
+(defun test-ol/return-foobar (_link-test _desc)
+  "Return string \"foobar\".
+
+Take (and ignore) arguments conforming to `:default-description'
+API in `org-link-parameters'.  Used in test
+`test-ol/insert-link-default-description', for the case where
+`:default-description' is a function symbol."
+  "foobar")
+
+(ert-deftest test-ol/insert-link-default-description ()
+  "Test `:default-description' parameter handling."
+  ;; String case
+  (should
+   (string=
+    "foobar"
+    (test-ol-with-link-parameters-as
+     "id" (:default-description "foobar")
+     (test-ol-insert-link-get-desc "id:foo-bar"))))
+  ;; Lambda case
+  (should
+   (string=
+    "foobar"
+    (test-ol-with-link-parameters-as
+     "id" (:default-description (lambda (_link-test _desc) "foobar"))
+     (test-ol-insert-link-get-desc "id:foo-bar"))))
+  ;; Function symbol case
+  (should
+   (string=
+    "foobar"
+    (test-ol-with-link-parameters-as
+     "id" (:default-description #'test-ol/return-foobar)
+     (test-ol-insert-link-get-desc "id:foo-bar"))))
+  ;; `:default-description' parameter is defined, but doesn't return a
+  ;; string
+  (should-error
+   (test-ol-with-link-parameters-as
+    "id" (:default-description #'ignore)
+    (test-ol-insert-link-get-desc "id:foo-bar")))
+  ;; Description argument should override `:default-description'
+  (should
+   (string=
+    "notfoobar"
+    (test-ol-with-link-parameters-as
+     "id" (:default-description "foobar")
+     (test-ol-insert-link-get-desc "id:foo-bar" "notfoobar")))))
+
 (provide 'test-ol)
 ;;; test-ol.el ends here
-- 
2.20.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-ol.el-add-description-format-parameter-to-org-link-p.patch --]
[-- Type: text/x-diff, Size: 5472 bytes --]

From 12726d18487298907ff63374120d17ee733383a7 Mon Sep 17 00:00:00 2001
From: Hugo Heagren <hugo@heagren.com>
Date: Mon, 28 Mar 2022 23:18:45 +0100
Subject: [PATCH 1/2] ol.el: add description format parameter to
 org-link-parameters

* ol.el (org-link-parameters): add parameter `:default-description', a
string or a function.
* (org-insert-link): if no description is provided (pre-existing or as
an argument), next option is to use the `:default-description' (if
non-nil) parameter to generate one.

Default descriptions are predictable within a link type, but because
link types are quite diverse, are NOT predictable across many types. A
type-parameter is thus a good place to store information on the
default description.
---
 lisp/ol.el | 53 ++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 42 insertions(+), 11 deletions(-)

diff --git a/lisp/ol.el b/lisp/ol.el
index d4bd0e40c..00f3bce5c 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -141,6 +141,15 @@ link.
   Function that inserts a link with completion.  The function
   takes one optional prefix argument.
 
+`:default-description'
+
+  String or function used as a default when prompting users for a
+  link's description.  A string is used as-is, a function is
+  called with two arguments: the full link text, and the
+  description generated by `org-insert-link'.  It should return
+  the description to use (this reflects the behaviour of
+  `org-link-make-description-function').
+
 `:display'
 
   Value for `invisible' text property on the hidden parts of the
@@ -1804,11 +1813,14 @@ prefix negates `org-link-keep-stored-after-insertion'.
 If the LINK-LOCATION parameter is non-nil, this value will be used as
 the link location instead of reading one interactively.
 
-If the DESCRIPTION parameter is non-nil, this value will be used as the
-default description.  Otherwise, if `org-link-make-description-function'
-is non-nil, this function will be called with the link target, and the
-result will be the default link description.  When called non-interactively,
-don't allow to edit the default description."
+If the DESCRIPTION parameter is non-nil, this value will be used
+as the default description.  If not, and the chosen link type has
+a non-nil `:default-description' parameter, that is used to
+generate a description as described in `org-link-parameters'
+docstring. Otherwise, if `org-link-make-description-function' is
+non-nil, this function will be called with the link target, and
+the result will be the default link description.  When called
+non-interactively, don't allow to edit the default description."
   (interactive "P")
   (let* ((wcf (current-window-configuration))
 	 (origbuf (current-buffer))
@@ -1818,7 +1830,10 @@ don't allow to edit the default description."
 	 (desc region)
 	 (link link-location)
 	 (abbrevs org-link-abbrev-alist-local)
-	 entry all-prefixes auto-desc)
+	 (all-prefixes (append (mapcar #'car abbrevs)
+			       (mapcar #'car org-link-abbrev-alist)
+			       (org-link-types)))
+         entry auto-desc type)
     (cond
      (link-location)		      ; specified by arg, just use it.
      ((org-in-regexp org-link-bracket-re 1)
@@ -1859,9 +1874,6 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
 	  (unless (pos-visible-in-window-p (point-max))
 	    (org-fit-window-to-buffer))
 	  (and (window-live-p cw) (select-window cw))))
-      (setq all-prefixes (append (mapcar #'car abbrevs)
-				 (mapcar #'car org-link-abbrev-alist)
-				 (org-link-types)))
       (unwind-protect
 	  ;; Fake a link history, containing the stored links.
 	  (let ((org-link--history
@@ -1893,6 +1905,13 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
       (or entry (push link org-link--insert-history))
       (setq desc (or desc (nth 1 entry)))))
 
+    (setq type
+          (cond
+           ((string-match (rx-to-string `(: string-start (submatch (or ,@all-prefixes)) ":")) link)
+            (match-string 1 link))
+           ((file-name-absolute-p link) "file")
+           ((string-match "\\`\\.\\.?/" link) "file")))
+
     (when (funcall (if (equal complete-file '(64)) 'not 'identity)
 		   (not org-link-keep-stored-after-insertion))
       (setq org-stored-links (delq (assoc link org-stored-links)
@@ -1961,12 +1980,24 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
       (let ((initial-input
 	     (cond
 	      (description)
-	      ((not org-link-make-description-function) desc)
+              (desc)
+              ((org-link-get-parameter type :default-description)
+               (let ((def (org-link-get-parameter type :default-description)))
+                 (condition-case nil
+                     (cond
+                      ((stringp def) def)
+                      ((functionp def)
+                       (funcall def link desc)))
+                   (error
+                    (message "Can't get link description from org link parameter `:default-description': %S"
+			     def)
+		    (sit-for 2)
+                    nil))))
 	      (t (condition-case nil
 		     (funcall org-link-make-description-function link desc)
 		   (error
 		    (message "Can't get link description from %S"
-			     (symbol-name org-link-make-description-function))
+		             org-link-make-description-function)
 		    (sit-for 2)
 		    nil))))))
 	(setq desc (if (called-interactively-p 'any)
-- 
2.20.1