Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs into feature/pgtk

1 files changed, 64 insertions, 23 deletions

diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index 58d3fd39922..0779c3a82c8 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
 
-;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Author: Carsten Dominik <carsten.dominik@gmail.com>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: https://orgmode.org
 ;;
@@ -39,6 +39,7 @@
 (declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
 
 (defvar org-ts-regexp0)
+(defvar ffap-url-regexp)
 
 
 ;;; Macros
@@ -172,7 +173,7 @@ because otherwise all these markers will point to nowhere."
        ,@body)))
 
 (defmacro org-eval-in-environment (environment form)
-  (declare (debug (form form)) (indent 1))
+  (declare (debug (form form)) (indent 1) (obsolete cl-progv "2021"))
   `(eval (list 'let ,environment ',form)))
 
 ;;;###autoload
@@ -208,7 +209,7 @@ because otherwise all these markers will point to nowhere."
 
 (defmacro org-no-popups (&rest body)
   "Suppress popup windows and evaluate BODY."
-  `(let (pop-up-frames display-buffer-alist)
+  `(let (pop-up-frames pop-up-windows)
      ,@body))
 
 
@@ -325,17 +326,19 @@ it for output."
 
 ;;; Indentation
 
-(defun org-do-remove-indentation (&optional n)
+(defun org-do-remove-indentation (&optional n skip-fl)
   "Remove the maximum common indentation from the buffer.
 When optional argument N is a positive integer, remove exactly
-that much characters from indentation, if possible.  Return nil
-if it fails."
+that much characters from indentation, if possible.  When
+optional argument SKIP-FL is non-nil, skip the first
+line.  Return nil if it fails."
   (catch :exit
     (goto-char (point-min))
     ;; Find maximum common indentation, if not specified.
     (let ((n (or n
 		 (let ((min-ind (point-max)))
 		   (save-excursion
+                     (when skip-fl (forward-line))
 		     (while (re-search-forward "^[ \t]*\\S-" nil t)
 		       (let ((ind (current-indentation)))
 			 (if (zerop ind) (throw :exit nil)
@@ -343,6 +346,7 @@ if it fails."
 		   min-ind))))
       (if (zerop n) (throw :exit nil)
 	;; Remove exactly N indentation, but give up if not possible.
+        (when skip-fl (forward-line))
 	(while (not (eobp))
 	  (let ((ind (progn (skip-chars-forward " \t") (current-column))))
 	    (cond ((eolp) (delete-region (line-beginning-position) (point)))
@@ -366,15 +370,17 @@ error when the user input is empty."
 	  (allow-empty? nil)
 	  (t (user-error "Empty input is not valid")))))
 
+(declare-function org-time-stamp-inactive "org" (&optional arg))
+
 (defun org-completing-read (&rest args)
   "Completing-read with SPACE being a normal character."
   (let ((enable-recursive-minibuffers t)
 	(minibuffer-local-completion-map
 	 (copy-keymap minibuffer-local-completion-map)))
-    (define-key minibuffer-local-completion-map " " 'self-insert-command)
-    (define-key minibuffer-local-completion-map "?" 'self-insert-command)
+    (define-key minibuffer-local-completion-map " " #'self-insert-command)
+    (define-key minibuffer-local-completion-map "?" #'self-insert-command)
     (define-key minibuffer-local-completion-map (kbd "C-c !")
-      'org-time-stamp-inactive)
+      #'org-time-stamp-inactive)
     (apply #'completing-read args)))
 
 (defun org--mks-read-key (allowed-keys prompt navigation-keys)
@@ -470,8 +476,8 @@ is selected, only the bare key is returned."
 		(goto-char (point-min))
 		(org-fit-window-to-buffer)
 		(message "") ; With this line the prompt appears in
-			     ; the minibuffer. Else keystrokes may
-			     ; appear, which is spurious.
+                                        ; the minibuffer. Else keystrokes may
+                                        ; appear, which is spurious.
 		(let ((pressed (org--mks-read-key
 				allowed-keys prompt
 				(not (pos-visible-in-window-p (1- (point-max)))))))
@@ -535,6 +541,11 @@ that may remove elements by altering the list structure."
     (setq list (delete (pop elts) list)))
   list)
 
+(defun org-plist-delete-all (plist props)
+  "Delete all elements in PROPS from PLIST."
+  (dolist (e props plist)
+    (setq plist (org-plist-delete plist e))))
+
 (defun org-plist-delete (plist property)
   "Delete PROPERTY from PLIST.
 This is in contrast to merely setting it to 0."
@@ -627,6 +638,30 @@ program is needed for, so that the error message can be more informative."
   (let ((message-log-max nil))
     (apply #'message args)))
 
+(defmacro org-dlet (binders &rest body)
+  "Like `let*' but using dynamic scoping."
+  (declare (indent 1) (debug let))
+  (let ((vars (mapcar (lambda (binder)
+                        (if (consp binder) (car binder) binder))
+                      binders)))
+    `(progn
+       (with-no-warnings
+         ,@(mapcar (lambda (var) `(defvar ,var)) vars))
+       (let* ,binders ,@body))))
+
+(defmacro org-pushnew-to-end (val var)
+  "Like `cl-pushnew' but pushes to the end of the list.
+Uses `equal' for comparisons.
+
+Beware: this performs O(N) memory allocations, so if you use it in a loop, you
+get an unnecessary O(N²) space complexity, so you're usually better off using
+`cl-pushnew' (with a final `reverse' if you care about the order of elements)."
+  (declare (debug (form gv-place)))
+  (let ((v (make-symbol "v")))
+    `(let ((,v ,val))
+       (unless (member ,v ,var)
+         (setf ,var (append ,var (list ,v)))))))
+
 (defun org-eval (form)
   "Eval FORM and return result."
   (condition-case error
@@ -781,6 +816,10 @@ return nil."
 	   (list context (match-beginning group) (match-end group))
 	 t)))
 
+(defun org-url-p (s)
+  "Non-nil if string S is a URL."
+  (require 'ffap)
+  (and ffap-url-regexp (string-match-p ffap-url-regexp s)))
 
 
 ;;; String manipulation
@@ -975,7 +1014,7 @@ IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
 many lines, whatever width that takes.
 The return value is a list of lines, without newlines at the end."
   (let* ((words (split-string string))
-	 (maxword (apply 'max (mapcar 'org-string-width words)))
+	 (maxword (apply #'max (mapcar #'org-string-width words)))
 	 w ll)
     (cond (width
 	   (org--do-wrap words (max maxword width)))
@@ -1072,10 +1111,11 @@ that will be added to PLIST.  Returns the string that was modified."
   string)
 
 (defun org-make-parameter-alist (flat)
+  ;; FIXME: "flat" is called a "plist"!
   "Return alist based on FLAT.
 FLAT is a list with alternating symbol names and values.  The
 returned alist is a list of lists with the symbol name in car and
-the value in cdr."
+the value in cadr."
   (when flat
     (cons (list (car flat) (cadr flat))
 	  (org-make-parameter-alist (cddr flat)))))
@@ -1122,13 +1162,13 @@ move it back by one char before doing this check."
     (org-invisible-p)))
 
 (defun org-find-visible ()
-  "Return closest visible buffer position, or `point-max'"
+  "Return closest visible buffer position, or `point-max'."
   (if (org-invisible-p)
       (next-single-char-property-change (point) 'invisible)
     (point)))
 
 (defun org-find-invisible ()
-  "Return closest invisible buffer position, or `point-max'"
+  "Return closest invisible buffer position, or `point-max'."
   (if (org-invisible-p)
       (point)
     (next-single-char-property-change (point) 'invisible)))
@@ -1221,10 +1261,11 @@ Return 0. if S is not recognized as a valid value."
        ((string= s "<tomorrow>") (+ 86400.0 today))
        ((string= s "<yesterday>") (- today 86400.0))
        ((string-match "\\`<\\([-+][0-9]+\\)\\([hdwmy]\\)>\\'" s)
-	(+ today
+	(+ (if (string= (match-string 2 s) "h") (float-time) today)
 	   (* (string-to-number (match-string 1 s))
 	      (cdr (assoc (match-string 2 s)
-			  '(("d" . 86400.0)   ("w" . 604800.0)
+			  '(("h" . 3600.0)
+			    ("d" . 86400.0)   ("w" . 604800.0)
 			    ("m" . 2678400.0) ("y" . 31557600.0)))))))
        ((string-match org-ts-regexp0 s) (org-2ft s))
        (t 0.)))))
@@ -1238,13 +1279,13 @@ window."
 	(scrldn (if additional-keys `(?\d ?\M-v) ?\M-v)))
     (pcase key
       (?\C-n (if (not (pos-visible-in-window-p (point-max)))
-	      (ignore-errors (scroll-up 1))
-	    (message "End of buffer")
-	    (sit-for 1)))
+	         (ignore-errors (scroll-up 1))
+	       (message "End of buffer")
+	       (sit-for 1)))
       (?\C-p (if (not (pos-visible-in-window-p (point-min)))
-	      (ignore-errors (scroll-down 1))
-	    (message "Beginning of buffer")
-	    (sit-for 1)))
+	         (ignore-errors (scroll-down 1))
+	       (message "Beginning of buffer")
+	       (sit-for 1)))
       ;; SPC or
       ((guard (memq key scrlup))
        (if (not (pos-visible-in-window-p (point-max)))