Update to Org 9.6-3-ga4d38e

1 files changed, 148 insertions, 74 deletions

diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index 108f031cde4..0b4457b0030 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -27,8 +27,12 @@
 
 ;;; Code:
 
+(require 'org-macs)
+(org-assert-version)
+
 (require 'org-compat)
 (require 'org-macs)
+(require 'org-fold)
 
 (defvar clean-buffer-list-kill-buffer-names)
 (defvar org-agenda-buffer-name)
@@ -38,7 +42,6 @@
 (defvar org-inhibit-startup)
 (defvar org-outline-regexp-bol)
 (defvar org-src-source-file-name)
-(defvar org-time-stamp-formats)
 (defvar org-ts-regexp)
 
 (declare-function calendar-cursor-to-date "calendar" (&optional error event))
@@ -47,7 +50,7 @@
 (declare-function org-back-to-heading "org" (&optional invisible-ok))
 (declare-function org-before-first-heading-p "org" ())
 (declare-function org-do-occur "org" (regexp &optional cleanup))
-(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-at-point "org-element" (&optional pom cached-only))
 (declare-function org-element-cache-refresh "org-element" (pos))
 (declare-function org-element-context "org-element" (&optional element))
 (declare-function org-element-lineage "org-element" (datum &optional types with-self))
@@ -66,10 +69,10 @@
 (declare-function org-mode "org" ())
 (declare-function org-occur "org" (regexp &optional keep-previous callback))
 (declare-function org-open-file "org" (path &optional in-emacs line search))
-(declare-function org-overview "org" ())
+(declare-function org-cycle-overview "org-cycle" ())
 (declare-function org-restart-font-lock "org" ())
 (declare-function org-run-like-in-org-mode "org" (cmd))
-(declare-function org-show-context "org" (&optional key))
+(declare-function org-fold-show-context "org-fold" (&optional key))
 (declare-function org-src-coderef-format "org-src" (&optional element))
 (declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
 (declare-function org-src-edit-buffer-p "org-src" (&optional buffer))
@@ -140,6 +143,19 @@ link.
   Function that inserts a link with completion.  The function
   takes one optional prefix argument.
 
+`:insert-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 link location (a string such as
+  \"~/foobar\", \"id:some-org-id\" or \"https://www.foo.com\")
+  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').  If it returns nil, no
+  default description is used, but no error is thrown (from the
+  user's perspective, this is equivalent to a default description
+  of \"\").
+
 `:display'
 
   Value for `invisible' text property on the hidden parts of the
@@ -199,7 +215,9 @@ You can interactively set the value of this variable by calling
 This function must take two parameters: the first one is the
 link, the second one is the description generated by
 `org-insert-link'.  The function should return the description to
-use."
+use.  If it returns nil, no default description is used, but no
+error is thrown (from the user’s perspective, this is equivalent
+to a default description of \"\")."
   :group 'org-link
   :type '(choice (const nil) (function))
   :safe #'null)
@@ -604,6 +622,22 @@ exact and fuzzy text search.")
 (defvar org-link--search-failed nil
   "Non-nil when last link search failed.")
 
+
+(defvar-local org-link--link-folding-spec '(org-link
+                                            (:global t)
+                                            (:ellipsis . nil)
+                                            (:isearch-open . t)
+                                            (:fragile . org-link--reveal-maybe))
+  "Folding spec used to hide invisible parts of links.")
+
+(defvar-local org-link--description-folding-spec '(org-link-description
+                                                   (:global t)
+                                                   (:ellipsis . nil)
+                                                   (:visible . t)
+                                                   (:isearch-open . nil)
+                                                   (:fragile . org-link--reveal-maybe))
+  "Folding spec used to reveal link description.")
+
 
 ;;; Internal Functions
 
@@ -700,7 +734,7 @@ followed by another \"%[A-F0-9]{2}\" group."
 		(make-indirect-buffer (current-buffer)
 				      indirect-buffer-name
 				      'clone))))
-      (with-current-buffer indirect-buffer (org-overview))
+      (with-current-buffer indirect-buffer (org-cycle-overview))
       indirect-buffer))))
 
 (defun org-link--search-radio-target (target)
@@ -718,7 +752,7 @@ White spaces are not significant."
 	(let ((object (org-element-context)))
 	  (when (eq (org-element-type object) 'radio-target)
 	    (goto-char (org-element-property :begin object))
-	    (org-show-context 'link-search)
+	    (org-fold-show-context 'link-search)
 	    (throw :radio-match nil))))
       (goto-char origin)
       (user-error "No match for radio target: %s" target))))
@@ -761,6 +795,13 @@ syntax around the string."
 		   (t nil))))
     string))
 
+(defun org-link--reveal-maybe (region _)
+  "Reveal folded link in REGION when needed.
+This function is intended to be used as :fragile property of a folding
+spec."
+  (org-with-point-at (car region)
+    (not (org-in-regexp org-link-any-re))))
+
 
 ;;; Public API
 
@@ -975,7 +1016,9 @@ LINK is escaped with backslashes for inclusion in buffer."
 		(replace-regexp-in-string "]\\'"
 					  (concat "\\&" zero-width-space)
 					  (org-trim description))))))
-    (if (not (org-string-nw-p link)) description
+    (if (not (org-string-nw-p link))
+        (or description
+            (error "Empty link"))
       (format "[[%s]%s]"
 	      (org-link-escape link)
 	      (if description (format "[%s]" description) "")))))
@@ -1257,7 +1300,7 @@ of matched result, which is either `dedicated' or `fuzzy'."
 	(error "No match for fuzzy expression: %s" normalized)))
     ;; Disclose surroundings of match, if appropriate.
     (when (and (derived-mode-p 'org-mode) (not stealth))
-      (org-show-context 'link-search))
+      (org-fold-show-context 'link-search))
     type))
 
 (defun org-link-heading-search-string (&optional string)
@@ -1322,7 +1365,7 @@ PATH is the sexp to evaluate, as a string."
 	       (string-match-p org-link-elisp-skip-confirm-regexp path))
 	  (not org-link-elisp-confirm-function)
 	  (funcall org-link-elisp-confirm-function
-		   (format "Execute %S as Elisp? "
+		   (format "Execute %s as Elisp? "
 			   (org-add-props path nil 'face 'org-warning))))
       (message "%s => %s" path
 	       (if (eq ?\( (string-to-char path))
@@ -1377,7 +1420,7 @@ PATH is the command to execute, as a string."
 	       (string-match-p org-link-shell-skip-confirm-regexp path))
 	  (not org-link-shell-confirm-function)
 	  (funcall org-link-shell-confirm-function
-		   (format "Execute %S in shell? "
+		   (format "Execute %s in shell? "
 			   (org-add-props path nil 'face 'org-warning))))
       (let ((buf (generate-new-buffer "*Org Shell Output*")))
 	(message "Executing %s" path)
@@ -1430,7 +1473,7 @@ is non-nil, move backward."
 	    (`nil nil)
 	    (link
 	     (goto-char (org-element-property :begin link))
-	     (when (org-invisible-p) (org-show-context))
+	     (when (org-invisible-p) (org-fold-show-context 'link-search))
 	     (throw :found t)))))
       (goto-char pos)
       (setq org-link--search-failed t)
@@ -1443,14 +1486,18 @@ If the link is in hidden text, expose it."
   (interactive)
   (org-next-link t))
 
+(defun org-link-descriptive-ensure ()
+  "Toggle the literal or descriptive display of links in current buffer if needed."
+  (if org-link-descriptive
+      (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil)
+    (org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t)))
+
 ;;;###autoload
 (defun org-toggle-link-display ()
-  "Toggle the literal or descriptive display of links."
+  "Toggle the literal or descriptive display of links in current buffer."
   (interactive)
-  (if org-link-descriptive (remove-from-invisibility-spec '(org-link))
-    (add-to-invisibility-spec '(org-link)))
-  (org-restart-font-lock)
-  (setq org-link-descriptive (not org-link-descriptive)))
+  (setq org-link-descriptive (not org-link-descriptive))
+  (org-link-descriptive-ensure))
 
 ;;;###autoload
 (defun org-store-link (arg &optional interactive?)
@@ -1519,10 +1566,8 @@ non-nil."
 		  t))))
 	(setq link (plist-get org-store-link-plist :link))
         ;; If store function actually set `:description' property, use
-        ;; it, even if it is nil.  Otherwise, fallback to link value.
-	(setq desc (if (plist-member org-store-link-plist :description)
-                       (plist-get org-store-link-plist :description)
-		     link)))
+        ;; it, even if it is nil.  Otherwise, fallback to nil (ask user).
+	(setq desc (plist-get org-store-link-plist :description)))
 
        ;; Store a link from a remote editing buffer.
        ((org-src-edit-buffer-p)
@@ -1563,7 +1608,7 @@ non-nil."
 	   (t (setq link nil)))))
 
        ;; We are in the agenda, link to referenced location
-       ((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name))
+       ((eq major-mode 'org-agenda-mode)
 	(let ((m (or (get-text-property (point) 'org-hd-marker)
 		     (get-text-property (point) 'org-marker))))
 	  (when m
@@ -1574,10 +1619,8 @@ non-nil."
 	(let ((cd (calendar-cursor-to-date)))
 	  (setq link
 		(format-time-string
-		 (car org-time-stamp-formats)
-		 (apply 'encode-time
-			(list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
-			      nil nil nil))))
+                 (org-time-stamp-format)
+		 (org-encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd))))
 	  (org-link-store-props :type "calendar" :date cd)))
 
        ((eq major-mode 'image-mode)
@@ -1592,7 +1635,7 @@ non-nil."
 	  (setq file (if file
 			 (abbreviate-file-name
 			  (expand-file-name (dired-get-filename nil t)))
-		       ;; otherwise, no file so use current directory.
+		       ;; Otherwise, no file so use current directory.
 		       default-directory))
 	  (setq cpltxt (concat "file:" file)
 		link cpltxt)))
@@ -1605,24 +1648,23 @@ non-nil."
 
        ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
 	(org-with-limited-levels
-         (cond
-	  ;; Store a link using the target at point.
+	 (setq custom-id (org-entry-get nil "CUSTOM_ID"))
+	 (cond
+	  ;; Store a link using the target at point
 	  ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
-	   (setq cpltxt
+	   (setq link
 		 (concat "file:"
 			 (abbreviate-file-name
 			  (buffer-file-name (buffer-base-buffer)))
 			 "::" (match-string 1))
-		 link cpltxt))
-          ;; Store a link using the CUSTOM_ID property.
-          ((setq custom-id (org-entry-get nil "CUSTOM_ID"))
-           (setq cpltxt
-		 (concat "file:"
-			 (abbreviate-file-name
-			  (buffer-file-name (buffer-base-buffer)))
-			 "::#" custom-id)
-		 link cpltxt))
-          ;; Store a link using (and perhaps creating) the ID property.
+                 ;; Target may be shortened when link is inserted.
+                 ;; Avoid [[target][file:~/org/test.org::target]]
+                 ;; links.  Maybe the case of identical target and
+                 ;; description should be handled by `org-insert-link'.
+                 cpltxt nil
+                 desc nil
+                 ;; Do not append #CUSTOM_ID link below.
+                 custom-id nil))
 	  ((and (featurep 'org-id)
 		(or (eq org-id-link-to-org-use-id t)
 		    (and interactive?
@@ -1631,13 +1673,12 @@ non-nil."
 				      'create-if-interactive-and-no-custom-id)
 				  (not custom-id))))
 		    (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
+	   ;; Store a link using the ID at point
 	   (setq link (condition-case nil
 			  (prog1 (org-id-store-link)
-			    (setq desc (or (plist-get org-store-link-plist
-						      :description)
-					   "")))
+			    (setq desc (plist-get org-store-link-plist :description)))
 			(error
-			 ;; Probably before first headline, link only to file.
+			 ;; Probably before first headline, link only to file
 			 (concat "file:"
 				 (abbreviate-file-name
 				  (buffer-file-name (buffer-base-buffer))))))))
@@ -1697,8 +1738,7 @@ non-nil."
 
       ;; We're done setting link and desc, clean up
       (when (consp link) (setq cpltxt (car link) link (cdr link)))
-      (setq link (or link cpltxt)
-	    desc (or desc cpltxt))
+      (setq link (or link cpltxt))
       (cond ((not desc))
 	    ((equal desc "NONE") (setq desc nil))
 	    (t (setq desc (org-link-display-format desc))))
@@ -1728,6 +1768,9 @@ The history can be used to select a link previously stored with
 press `RET' at the prompt), the link defaults to the most recently
 stored link.  As `SPC' triggers completion in the minibuffer, you need to
 use `M-SPC' or `C-q SPC' to force the insertion of a space character.
+Completion candidates include link descriptions.
+
+If there is a link under cursor then edit it.
 
 You will also be prompted for a description, and if one is given, it will
 be displayed in the buffer instead of the link.
@@ -1753,11 +1796,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 `:insert-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))
@@ -1767,7 +1813,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)
     (cond
      (link-location)		      ; specified by arg, just use it.
      ((org-in-regexp org-link-bracket-re 1)
@@ -1808,9 +1857,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
@@ -1821,15 +1867,19 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
 		   "Link: "
 		   (append
 		    (mapcar (lambda (x) (concat x ":")) all-prefixes)
-		    (mapcar #'car org-stored-links))
+		    (mapcar #'car org-stored-links)
+                    ;; Allow description completion.  Avoid "nil" option
+                    ;; in the case of `completing-read-default' and
+                    ;; an error in `ido-completing-read' when some links
+                    ;; have no description.
+                    (delq nil (mapcar 'cadr org-stored-links)))
 		   nil nil nil
 		   'org-link--history
 		   (caar org-stored-links)))
 	    (unless (org-string-nw-p link) (user-error "No link selected"))
 	    (dolist (l org-stored-links)
 	      (when (equal link (cadr l))
-		(setq link (car l))
-		(setq auto-desc t)))
+		(setq link (car l))))
 	    (when (or (member link all-prefixes)
 		      (and (equal ":" (substring link -1))
 			   (member (substring link 0 -1) all-prefixes)
@@ -1906,21 +1956,40 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
 	  (when (equal desc origpath)
 	    (setq desc path)))))
 
-    (unless auto-desc
-      (let ((initial-input
-	     (cond
-	      (description)
-	      ((not org-link-make-description-function) desc)
-	      (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))
-		    (sit-for 2)
-		    nil))))))
-	(setq desc (if (called-interactively-p 'any)
-		       (read-string "Description: " initial-input)
-		     initial-input))))
+    (let* ((type
+            (cond
+             ((and all-prefixes
+                   (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")))
+           (initial-input
+            (cond
+             (description)
+             (desc)
+             ((org-link-get-parameter type :insert-description)
+              (let ((def (org-link-get-parameter type :insert-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 `:insert-description': %S"
+                            def)
+                   (sit-for 2)
+                   nil))))
+             (org-link-make-description-function
+              (condition-case nil
+                  (funcall org-link-make-description-function link desc)
+                (error
+                 (message "Can't get link description from %S"
+                          org-link-make-description-function)
+                 (sit-for 2)
+                 nil))))))
+      (setq desc (if (called-interactively-p 'any)
+                     (read-string "Description: " initial-input)
+                   initial-input)))
 
     (unless (org-string-nw-p desc) (setq desc nil))
     (when remove (apply #'delete-region remove))
@@ -1989,6 +2058,10 @@ Also refresh fontification if needed."
 		  (cl-pushnew (org-element-property :value obj) rtn
 			      :test #'equal))))
 	    rtn))))
+    (setq targets
+          (sort targets
+                (lambda (a b)
+                  (> (length a) (length b)))))
     (setq org-target-link-regexp
 	  (and targets
 	       (concat before-re
@@ -2012,7 +2085,8 @@ Also refresh fontification if needed."
 				    (list old-regexp org-target-link-regexp)
 				    "\\|")
 				   after-re)))))
-	(when (featurep 'org-element)
+	(when (and (featurep 'org-element)
+                   (not (bound-and-true-p org-mode-loading)))
 	  (org-with-point-at 1
 	    (while (re-search-forward regexp nil t)
 	      (org-element-cache-refresh (match-beginning 1))))))