diff options
Diffstat (limited to 'lisp/org/org-macs.el')
| -rw-r--r-- | lisp/org/org-macs.el | 91 |
1 files changed, 66 insertions, 25 deletions
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 58d3fd39922..044056b7a04 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))) @@ -1145,7 +1185,7 @@ nil, just return 0." ((numberp s) s) ((stringp s) (condition-case nil - (float-time (apply #'encode-time (org-parse-time-string s))) + (float-time (encode-time (org-parse-time-string s))) (error 0))) (t 0))) @@ -1212,7 +1252,7 @@ following special strings: \"<now>\", \"<today>\", \"<tomorrow>\", and \"<yesterday>\". Return 0. if S is not recognized as a valid value." - (let ((today (float-time (apply #'encode-time + (let ((today (float-time (encode-time (append '(0 0 0) (nthcdr 3 (decode-time))))))) (save-match-data (cond @@ -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))) |