Browse Source

org-macs: Re-order functions and macros

Nicolas Goaziou 7 years ago
parent
commit
794dfaa6e0
1 changed files with 239 additions and 208 deletions
  1. 239 208
      lisp/org-macs.el

+ 239 - 208
lisp/org-macs.el

@@ -31,6 +31,9 @@
 
 ;;; Code:
 
+
+;;; Macros
+
 (defmacro org-with-gensyms (symbols &rest body)
   (declare (debug (sexp body)) (indent 1))
   `(let ,(mapcar (lambda (s)
@@ -38,6 +41,135 @@
                  symbols)
      ,@body))
 
+(defmacro org-preserve-lc (&rest body)
+  (declare (debug (body)))
+  (org-with-gensyms (line col)
+    `(let ((,line (org-current-line))
+	   (,col (current-column)))
+       (unwind-protect
+	   (progn ,@body)
+	 (org-goto-line ,line)
+	 (org-move-to-column ,col)))))
+
+;; Use `org-with-silent-modifications' to ignore cosmetic changes and
+;; `org-unmodified' to ignore real text modifications
+(defmacro org-unmodified (&rest body)
+  "Run BODY while preserving the buffer's `buffer-modified-p' state."
+  (declare (debug (body)))
+  (org-with-gensyms (was-modified)
+    `(let ((,was-modified (buffer-modified-p)))
+       (unwind-protect
+           (let ((buffer-undo-list t)
+		 (inhibit-modification-hooks t))
+	     ,@body)
+	 (set-buffer-modified-p ,was-modified)))))
+
+(defmacro org-without-partial-completion (&rest body)
+  (declare (debug (body)))
+  `(if (and (boundp 'partial-completion-mode)
+	    partial-completion-mode
+	    (fboundp 'partial-completion-mode))
+       (unwind-protect
+	   (progn
+	     (partial-completion-mode -1)
+	     ,@body)
+	 (partial-completion-mode 1))
+     ,@body))
+
+(defmacro org-with-point-at (pom &rest body)
+  "Move to buffer and point of point-or-marker POM for the duration of BODY."
+  (declare (debug (form body)) (indent 1))
+  (org-with-gensyms (mpom)
+    `(let ((,mpom ,pom))
+       (save-excursion
+	 (if (markerp ,mpom) (set-buffer (marker-buffer ,mpom)))
+	 (org-with-wide-buffer
+	  (goto-char (or ,mpom (point)))
+	  ,@body)))))
+
+(defmacro org-with-remote-undo (buffer &rest body)
+  "Execute BODY while recording undo information in two buffers."
+  (declare (debug (form body)) (indent 1))
+  (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2)
+    `(let ((,cline (org-current-line))
+	   (,cmd this-command)
+	   (,buf1 (current-buffer))
+	   (,buf2 ,buffer)
+	   (,undo1 buffer-undo-list)
+	   (,undo2 (with-current-buffer ,buffer buffer-undo-list))
+	   ,c1 ,c2)
+       ,@body
+       (when org-agenda-allow-remote-undo
+	 (setq ,c1 (org-verify-change-for-undo
+		    ,undo1 (with-current-buffer ,buf1 buffer-undo-list))
+	       ,c2 (org-verify-change-for-undo
+		    ,undo2 (with-current-buffer ,buf2 buffer-undo-list)))
+	 (when (or ,c1 ,c2)
+	   ;; make sure there are undo boundaries
+	   (and ,c1 (with-current-buffer ,buf1 (undo-boundary)))
+	   (and ,c2 (with-current-buffer ,buf2 (undo-boundary)))
+	   ;; remember which buffer to undo
+	   (push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2)
+		 org-agenda-undo-list))))))
+
+(defmacro org-no-read-only (&rest body)
+  "Inhibit read-only for BODY."
+  (declare (debug (body)))
+  `(let ((inhibit-read-only t)) ,@body))
+
+(defmacro org-save-outline-visibility (use-markers &rest body)
+  "Save and restore outline visibility around BODY.
+If USE-MARKERS is non-nil, use markers for the positions.
+This means that the buffer may change while running BODY,
+but it also means that the buffer should stay alive
+during the operation, because otherwise all these markers will
+point nowhere."
+  (declare (debug (form body)) (indent 1))
+  (org-with-gensyms (data)
+    `(let ((,data (org-outline-overlay-data ,use-markers)))
+       (unwind-protect
+	   (prog1 (progn ,@body)
+	     (org-set-outline-overlay-data ,data))
+	 (when ,use-markers
+	   (dolist (c ,data)
+	     (when (markerp (car c)) (move-marker (car c) nil))
+	     (when (markerp (cdr c)) (move-marker (cdr c) nil))))))))
+
+(defmacro org-with-wide-buffer (&rest body)
+  "Execute body while temporarily widening the buffer."
+  (declare (debug (body)))
+  `(save-excursion
+     (save-restriction
+       (widen)
+       ,@body)))
+
+(defmacro org-with-limited-levels (&rest body)
+  "Execute BODY with limited number of outline levels."
+  (declare (debug (body)))
+  `(progn
+     (defvar org-called-with-limited-levels)
+     (defvar org-outline-regexp)
+     (defvar outline-regexp)
+     (defvar org-outline-regexp-bol)
+     (let* ((org-called-with-limited-levels t)
+            (org-outline-regexp (org-get-limited-outline-regexp))
+            (outline-regexp org-outline-regexp)
+            (org-outline-regexp-bol (concat "^" org-outline-regexp)))
+       ,@body)))
+
+(defmacro org-eval-in-environment (environment form)
+  (declare (debug (form form)) (indent 1))
+  `(eval (list 'let ,environment ',form)))
+
+;;;###autoload
+(defmacro org-load-noerror-mustsuffix (file)
+  "Load FILE with optional arguments NOERROR and MUSTSUFFIX."
+  `(load ,file 'noerror nil nil 'mustsuffix))
+
+
+
+;;; String manipulation
+
 (defsubst org-trim (s &optional keep-lead)
   "Remove whitespace at the beginning and the end of string S.
 When optional argument KEEP-LEAD is non-nil, removing blank lines
@@ -142,94 +274,21 @@ Unlike to `string-width', this function takes into consideration
 Otherwise return nil."
   (and v (not (equal v "nil")) v))
 
-(defmacro org-preserve-lc (&rest body)
-  (declare (debug (body)))
-  (org-with-gensyms (line col)
-    `(let ((,line (org-current-line))
-	   (,col (current-column)))
-       (unwind-protect
-	   (progn ,@body)
-	 (org-goto-line ,line)
-	 (org-move-to-column ,col)))))
-
-;; Use `org-with-silent-modifications' to ignore cosmetic changes and
-;; `org-unmodified' to ignore real text modifications
-(defmacro org-unmodified (&rest body)
-  "Run BODY while preserving the buffer's `buffer-modified-p' state."
-  (declare (debug (body)))
-  (org-with-gensyms (was-modified)
-    `(let ((,was-modified (buffer-modified-p)))
-       (unwind-protect
-           (let ((buffer-undo-list t)
-		 (inhibit-modification-hooks t))
-	     ,@body)
-	 (set-buffer-modified-p ,was-modified)))))
-
-(defmacro org-without-partial-completion (&rest body)
-  (declare (debug (body)))
-  `(if (and (boundp 'partial-completion-mode)
-	    partial-completion-mode
-	    (fboundp 'partial-completion-mode))
-       (unwind-protect
-	   (progn
-	     (partial-completion-mode -1)
-	     ,@body)
-	 (partial-completion-mode 1))
-     ,@body))
-
-(defmacro org-with-point-at (pom &rest body)
-  "Move to buffer and point of point-or-marker POM for the duration of BODY."
-  (declare (debug (form body)) (indent 1))
-  (org-with-gensyms (mpom)
-    `(let ((,mpom ,pom))
-       (save-excursion
-	 (if (markerp ,mpom) (set-buffer (marker-buffer ,mpom)))
-	 (org-with-wide-buffer
-	  (goto-char (or ,mpom (point)))
-	  ,@body)))))
+(defun org-unbracket-string (pre post string)
+  "Remove PRE/POST from the beginning/end of STRING.
+Both PRE and POST must be pre-/suffixes of STRING, or neither is
+removed."
+  (if (and (string-prefix-p pre string)
+	   (string-suffix-p post string))
+      (substring string (length pre) (- (length post)))
+    string))
 
-(defmacro org-with-remote-undo (buffer &rest body)
-  "Execute BODY while recording undo information in two buffers."
-  (declare (debug (form body)) (indent 1))
-  (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2)
-    `(let ((,cline (org-current-line))
-	   (,cmd this-command)
-	   (,buf1 (current-buffer))
-	   (,buf2 ,buffer)
-	   (,undo1 buffer-undo-list)
-	   (,undo2 (with-current-buffer ,buffer buffer-undo-list))
-	   ,c1 ,c2)
-       ,@body
-       (when org-agenda-allow-remote-undo
-	 (setq ,c1 (org-verify-change-for-undo
-		    ,undo1 (with-current-buffer ,buf1 buffer-undo-list))
-	       ,c2 (org-verify-change-for-undo
-		    ,undo2 (with-current-buffer ,buf2 buffer-undo-list)))
-	 (when (or ,c1 ,c2)
-	   ;; make sure there are undo boundaries
-	   (and ,c1 (with-current-buffer ,buf1 (undo-boundary)))
-	   (and ,c2 (with-current-buffer ,buf2 (undo-boundary)))
-	   ;; remember which buffer to undo
-	   (push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2)
-		 org-agenda-undo-list))))))
+(defsubst org-current-line-string (&optional to-here)
+  (buffer-substring (point-at-bol) (if to-here (point) (point-at-eol))))
 
-(defmacro org-no-read-only (&rest body)
-  "Inhibit read-only for BODY."
-  (declare (debug (body)))
-  `(let ((inhibit-read-only t)) ,@body))
 
-(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
-				   rear-nonsticky t mouse-map t fontified t
-				   org-emphasis t)
-  "Properties to remove when a string without properties is wanted.")
-
-(defsubst org-no-properties (s &optional restricted)
-  "Remove all text properties from string S.
-When RESTRICTED is non-nil, only remove the properties listed
-in `org-rm-props'."
-  (if restricted (remove-text-properties 0 (length s) org-rm-props s)
-    (set-text-properties 0 (length s) nil s))
-  s)
+
+;;; List manipulation
 
 (defsubst org-get-alist-option (option key)
   (cond ((eq key t) t)
@@ -238,48 +297,23 @@ in `org-rm-props'."
 	(t (let ((r (cdr (assq 'default option))))
 	     (if (listp r) (delq nil r) r)))))
 
-(defsubst org-check-external-command (cmd &optional use no-error)
-  "Check if external program CMD for USE exists, error if not.
-When the program does exist, return its path.
-When it does not exist and NO-ERROR is set, return nil.
-Otherwise, throw an error.  The optional argument USE can describe what this
-program is needed for, so that the error message can be more informative."
-  (or (executable-find cmd)
-      (if no-error
-	  nil
-	(error "Can't find `%s'%s" cmd
-	       (if use (format " (%s)" use) "")))))
-
 (defsubst org-last (list)
   "Return the last element of LIST."
   (car (last list)))
 
-(defun org-let (list &rest body)
-  (eval (cons 'let (cons list body))))
-(put 'org-let 'lisp-indent-function 1)
-
-(defun org-let2 (list1 list2 &rest body)
-  (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
-(put 'org-let2 'lisp-indent-function 2)
-
-(defsubst org-call-with-arg (command arg)
-  "Call COMMAND interactively, but pretend prefix arg was ARG."
-  (let ((current-prefix-arg arg)) (call-interactively command)))
-
-(defsubst org-current-line (&optional pos)
-  (save-excursion
-    (and pos (goto-char pos))
-    ;; works also in narrowed buffer, because we start at 1, not point-min
-    (+ (if (bolp) 1 0) (count-lines 1 (point)))))
+(defun org-plist-delete (plist property)
+  "Delete PROPERTY from PLIST.
+This is in contrast to merely setting it to 0."
+  (let (p)
+    (while plist
+      (if (not (eq property (car plist)))
+	  (setq p (plist-put p (car plist) (nth 1 plist))))
+      (setq plist (cddr plist)))
+    p))
 
-(defsubst org-goto-line (N)
-  (save-restriction
-    (widen)
-    (goto-char (point-min))
-    (forward-line (1- N))))
 
-(defsubst org-current-line-string (&optional to-here)
-  (buffer-substring (point-at-bol) (if to-here (point) (point-at-eol))))
+
+;;; Regexp matching
 
 (defsubst org-pos-in-match-range (pos n)
   (and (match-beginning n)
@@ -292,76 +326,38 @@ program is needed for, so that the error message can be more informative."
     (beginning-of-line)
     (looking-at regexp)))
 
-(defun org-plist-delete (plist property)
-  "Delete PROPERTY from PLIST.
-This is in contrast to merely setting it to 0."
-  (let (p)
-    (while plist
-      (if (not (eq property (car plist)))
-	  (setq p (plist-put p (car plist) (nth 1 plist))))
-      (setq plist (cddr plist)))
-    p))
 
-(defmacro org-save-outline-visibility (use-markers &rest body)
-  "Save and restore outline visibility around BODY.
-If USE-MARKERS is non-nil, use markers for the positions.
-This means that the buffer may change while running BODY,
-but it also means that the buffer should stay alive
-during the operation, because otherwise all these markers will
-point nowhere."
-  (declare (debug (form body)) (indent 1))
-  (org-with-gensyms (data)
-    `(let ((,data (org-outline-overlay-data ,use-markers)))
-       (unwind-protect
-	   (prog1 (progn ,@body)
-	     (org-set-outline-overlay-data ,data))
-	 (when ,use-markers
-	   (dolist (c ,data)
-	     (when (markerp (car c)) (move-marker (car c) nil))
-	     (when (markerp (cdr c)) (move-marker (cdr c) nil))))))))
+
+;;; Motion
 
-(defmacro org-with-wide-buffer (&rest body)
-  "Execute body while temporarily widening the buffer."
-  (declare (debug (body)))
-  `(save-excursion
-     (save-restriction
-       (widen)
-       ,@body)))
+(defsubst org-goto-line (N)
+  (save-restriction
+    (widen)
+    (goto-char (point-min))
+    (forward-line (1- N))))
 
-(defmacro org-with-limited-levels (&rest body)
-  "Execute BODY with limited number of outline levels."
-  (declare (debug (body)))
-  `(progn
-     (defvar org-called-with-limited-levels)
-     (defvar org-outline-regexp)
-     (defvar outline-regexp)
-     (defvar org-outline-regexp-bol)
-     (let* ((org-called-with-limited-levels t)
-            (org-outline-regexp (org-get-limited-outline-regexp))
-            (outline-regexp org-outline-regexp)
-            (org-outline-regexp-bol (concat "^" org-outline-regexp)))
-       ,@body)))
+(defsubst org-current-line (&optional pos)
+  (save-excursion
+    (and pos (goto-char pos))
+    ;; works also in narrowed buffer, because we start at 1, not point-min
+    (+ (if (bolp) 1 0) (count-lines 1 (point)))))
 
-(defvar org-outline-regexp) ; defined in org.el
-(defvar org-odd-levels-only) ; defined in org.el
-(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el
-(defun org-get-limited-outline-regexp ()
-  "Return outline-regexp with limited number of levels.
-The number of levels is controlled by `org-inlinetask-min-level'"
-  (cond ((not (derived-mode-p 'org-mode))
-	 outline-regexp)
-	((not (featurep 'org-inlinetask))
-	 org-outline-regexp)
-	(t
-	 (let* ((limit-level (1- org-inlinetask-min-level))
-		(nstars (if org-odd-levels-only
-			    (1- (* limit-level 2))
-			  limit-level)))
-	   (format "\\*\\{1,%d\\} " nstars)))))
 
-(defmacro org-eval-in-environment (environment form)
-  (declare (debug (form form)) (indent 1))
-  `(eval (list 'let ,environment ',form)))
+
+;;; Text properties
+
+(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
+				   rear-nonsticky t mouse-map t fontified t
+				   org-emphasis t)
+  "Properties to remove when a string without properties is wanted.")
+
+(defsubst org-no-properties (s &optional restricted)
+  "Remove all text properties from string S.
+When RESTRICTED is non-nil, only remove the properties listed
+in `org-rm-props'."
+  (if restricted (remove-text-properties 0 (length s) org-rm-props s)
+    (set-text-properties 0 (length s) nil s))
+  s)
 
 (defun org-make-parameter-alist (flat)
   "Return alist based on FLAT.
@@ -372,29 +368,9 @@ the value in cdr."
     (cons (list (car flat) (cadr flat))
 	  (org-make-parameter-alist (cddr flat)))))
 
-;;;###autoload
-(defmacro org-load-noerror-mustsuffix (file)
-  "Load FILE with optional arguments NOERROR and MUSTSUFFIX."
-  `(load ,file 'noerror nil nil 'mustsuffix))
 
-(defun org-unbracket-string (pre post string)
-  "Remove PRE/POST from the beginning/end of STRING.
-Both PRE and POST must be pre-/suffixes of STRING, or neither is
-removed."
-  (if (and (string-prefix-p pre string)
-	   (string-suffix-p post string))
-      (substring string (length pre) (- (length post)))
-    string))
-
-(defun org-read-function (prompt &optional allow-empty?)
-  "Prompt for a function.
-If ALLOW-EMPTY? is non-nil, return nil rather than raising an
-error when the user input is empty."
-  (let ((func (completing-read prompt obarray #'fboundp t)))
-    (cond ((not (string= func ""))
-	   (intern func))
-	  (allow-empty? nil)
-	  (t (user-error "Empty input is not valid")))))
+
+;;; Local variables
 
 (defconst org-unique-local-variables
   '(org-element--cache
@@ -433,6 +409,61 @@ Optional argument REGEXP selects variables to clone."
 	 (ignore-errors (set (make-local-variable name) value)))))))
 
 
+
+;;; Miscellaneous
+
+(defsubst org-check-external-command (cmd &optional use no-error)
+  "Check if external program CMD for USE exists, error if not.
+When the program does exist, return its path.
+When it does not exist and NO-ERROR is set, return nil.
+Otherwise, throw an error.  The optional argument USE can describe what this
+program is needed for, so that the error message can be more informative."
+  (or (executable-find cmd)
+      (if no-error
+	  nil
+	(error "Can't find `%s'%s" cmd
+	       (if use (format " (%s)" use) "")))))
+
+(defun org-let (list &rest body)
+  (eval (cons 'let (cons list body))))
+(put 'org-let 'lisp-indent-function 1)
+
+(defun org-let2 (list1 list2 &rest body)
+  (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
+(put 'org-let2 'lisp-indent-function 2)
+
+(defsubst org-call-with-arg (command arg)
+  "Call COMMAND interactively, but pretend prefix arg was ARG."
+  (let ((current-prefix-arg arg)) (call-interactively command)))
+
+(defvar org-outline-regexp) ; defined in org.el
+(defvar org-odd-levels-only) ; defined in org.el
+(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el
+(defun org-get-limited-outline-regexp ()
+  "Return outline-regexp with limited number of levels.
+The number of levels is controlled by `org-inlinetask-min-level'"
+  (cond ((not (derived-mode-p 'org-mode))
+	 outline-regexp)
+	((not (featurep 'org-inlinetask))
+	 org-outline-regexp)
+	(t
+	 (let* ((limit-level (1- org-inlinetask-min-level))
+		(nstars (if org-odd-levels-only
+			    (1- (* limit-level 2))
+			  limit-level)))
+	   (format "\\*\\{1,%d\\} " nstars)))))
+
+(defun org-read-function (prompt &optional allow-empty?)
+  "Prompt for a function.
+If ALLOW-EMPTY? is non-nil, return nil rather than raising an
+error when the user input is empty."
+  (let ((func (completing-read prompt obarray #'fboundp t)))
+    (cond ((not (string= func ""))
+	   (intern func))
+	  (allow-empty? nil)
+	  (t (user-error "Empty input is not valid")))))
+
+
 (provide 'org-macs)
 
 ;;; org-macs.el ends here