aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2020-12-26 12:21:17 -0500
committerStefan Monnier2020-12-26 12:21:32 -0500
commit4b2ca6bfc079c66cfcf39f2f36dc139012787535 (patch)
treee475a0e35638f9ba23176ef5f5ad80b2b1afb25c
parent25fb44fad15743cd7725aa73681c2652d5a23b09 (diff)
downloademacs-4b2ca6bfc079c66cfcf39f2f36dc139012787535.tar.gz
emacs-4b2ca6bfc079c66cfcf39f2f36dc139012787535.zip
* lisp/forms.el (forms--run-functions): New function
(forms--intuit-from-file, forms-save-buffer): Use it. (forms-mode): Use it to fix regression. Remove always-true test. Fix incorrect uses of `fboundp`. (forms--iif-hook): Use `add-hook`. (forms--iif-post-command-hook): Use `remove-hook` and fix typo. (forms--debug): Use `mapconcat`.
-rw-r--r--lisp/forms.el63
1 files changed, 33 insertions, 30 deletions
diff --git a/lisp/forms.el b/lisp/forms.el
index 8974f99ef57..b8638bc6e20 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -436,6 +436,14 @@ Also, initial position is at last record."
436 436
437(defvar read-file-filter) ; bound in forms--intuit-from-file 437(defvar read-file-filter) ; bound in forms--intuit-from-file
438 438
439;; The code used to use `run-hooks' but in a way that's actually
440;; incompatible with hooks (and with lexical scoping), so this function
441;; approximates the actual behavior that `run-hooks' provided.
442(defun forms--run-functions (functions)
443 (if (functionp functions)
444 (funcall functions)
445 (mapc #'funcall functions)))
446
439;;;###autoload 447;;;###autoload
440(defun forms-mode (&optional primary) 448(defun forms-mode (&optional primary)
441 ;; FIXME: use define-derived-mode 449 ;; FIXME: use define-derived-mode
@@ -547,8 +555,6 @@ Commands: Equivalent keys in read-only mode:
547 "`forms-multi-line' is equal to `forms-field-sep'"))) 555 "`forms-multi-line' is equal to `forms-field-sep'")))
548 (error (concat "Forms control file error: " 556 (error (concat "Forms control file error: "
549 "`forms-multi-line' must be nil or a one-character string")))) 557 "`forms-multi-line' must be nil or a one-character string"))))
550 (or (fboundp 'set-text-properties)
551 (setq forms-use-text-properties nil))
552 558
553 ;; Validate and process forms-format-list. 559 ;; Validate and process forms-format-list.
554 ;;(message "forms: pre-processing format list...") 560 ;;(message "forms: pre-processing format list...")
@@ -568,12 +574,12 @@ Commands: Equivalent keys in read-only mode:
568 574
569 ;; Check if record filters are defined. 575 ;; Check if record filters are defined.
570 (if (and forms-new-record-filter 576 (if (and forms-new-record-filter
571 (not (fboundp forms-new-record-filter))) 577 (not (functionp forms-new-record-filter)))
572 (error (concat "Forms control file error: " 578 (error (concat "Forms control file error: "
573 "`forms-new-record-filter' is not a function"))) 579 "`forms-new-record-filter' is not a function")))
574 580
575 (if (and forms-modified-record-filter 581 (if (and forms-modified-record-filter
576 (not (fboundp forms-modified-record-filter))) 582 (not (functionp forms-modified-record-filter)))
577 (error (concat "Forms control file error: " 583 (error (concat "Forms control file error: "
578 "`forms-modified-record-filter' is not a function"))) 584 "`forms-modified-record-filter' is not a function")))
579 585
@@ -647,7 +653,7 @@ Commands: Equivalent keys in read-only mode:
647 (with-current-buffer forms--file-buffer 653 (with-current-buffer forms--file-buffer
648 (let ((inhibit-read-only t) 654 (let ((inhibit-read-only t)
649 (file-modified (buffer-modified-p))) 655 (file-modified (buffer-modified-p)))
650 (mapc #'funcall read-file-filter) 656 (forms--run-functions read-file-filter)
651 (if (not file-modified) (set-buffer-modified-p nil))) 657 (if (not file-modified) (set-buffer-modified-p nil)))
652 (if write-file-filter 658 (if write-file-filter
653 (add-hook 'write-file-functions write-file-filter nil t))) 659 (add-hook 'write-file-functions write-file-filter nil t)))
@@ -875,8 +881,7 @@ Commands: Equivalent keys in read-only mode:
875 (list 'face forms--rw-face 'front-sticky '(face)))) 881 (list 'face forms--rw-face 'front-sticky '(face))))
876 882
877 ;; Enable `post-command-hook' to restore the properties. 883 ;; Enable `post-command-hook' to restore the properties.
878 (setq post-command-hook 884 (add-hook 'post-command-hook #'forms--iif-post-command-hook))
879 (append (list 'forms--iif-post-command-hook) post-command-hook)))
880 885
881 ;; No action needed. Clear marker. 886 ;; No action needed. Clear marker.
882 (setq forms--iif-start nil))) 887 (setq forms--iif-start nil)))
@@ -885,8 +890,7 @@ Commands: Equivalent keys in read-only mode:
885 "`post-command-hook' function for read-only segments." 890 "`post-command-hook' function for read-only segments."
886 891
887 ;; Disable `post-command-hook'. 892 ;; Disable `post-command-hook'.
888 (setq post-command-hook 893 (remove-hook 'post-command-hook #'forms--iif-post-command-hook)
889 (delq 'forms--iif-hook-post-command-hook post-command-hook))
890 894
891 ;; Restore properties. 895 ;; Restore properties.
892 (if forms--iif-start 896 (if forms--iif-start
@@ -916,7 +920,7 @@ Commands: Equivalent keys in read-only mode:
916 (if forms-use-text-properties 920 (if forms-use-text-properties
917 `(lambda (arg) 921 `(lambda (arg)
918 (let ((inhibit-read-only t)) 922 (let ((inhibit-read-only t))
919 ,@(apply 'append 923 ,@(apply #'append
920 (mapcar #'forms--make-format-elt-using-text-properties 924 (mapcar #'forms--make-format-elt-using-text-properties
921 forms-format-list)) 925 forms-format-list))
922 ;; Prevent insertion before the first text. 926 ;; Prevent insertion before the first text.
@@ -929,7 +933,7 @@ Commands: Equivalent keys in read-only mode:
929 '(rear-nonsticky nil))) 933 '(rear-nonsticky nil)))
930 (setq forms--iif-start nil)) 934 (setq forms--iif-start nil))
931 `(lambda (arg) 935 `(lambda (arg)
932 ,@(apply 'append 936 ,@(apply #'append
933 (mapcar #'forms--make-format-elt forms-format-list))))) 937 (mapcar #'forms--make-format-elt forms-format-list)))))
934 938
935 ;; We have tallied the number of markers and dynamic texts, 939 ;; We have tallied the number of markers and dynamic texts,
@@ -1100,7 +1104,7 @@ Commands: Equivalent keys in read-only mode:
1100 `(lambda nil 1104 `(lambda nil
1101 (let (here) 1105 (let (here)
1102 (goto-char (point-min)) 1106 (goto-char (point-min))
1103 ,@(apply 'append 1107 ,@(apply #'append
1104 (mapcar 1108 (mapcar
1105 #'forms--make-parser-elt 1109 #'forms--make-parser-elt
1106 (append forms-format-list (list nil))))))))) 1110 (append forms-format-list (list nil)))))))))
@@ -1219,7 +1223,7 @@ Commands: Equivalent keys in read-only mode:
1219 (setq the-record 1223 (setq the-record
1220 (with-current-buffer forms--file-buffer 1224 (with-current-buffer forms--file-buffer
1221 (let ((inhibit-read-only t)) 1225 (let ((inhibit-read-only t))
1222 (run-hooks 'read-file-filter)) 1226 (forms--run-functions read-file-filter))
1223 (goto-char (point-min)) 1227 (goto-char (point-min))
1224 (forms--get-record))) 1228 (forms--get-record)))
1225 1229
@@ -1427,7 +1431,7 @@ Commands: Equivalent keys in read-only mode:
1427 ;; 1431 ;;
1428 ;; We have our own revert function - use it. 1432 ;; We have our own revert function - use it.
1429 (make-local-variable 'revert-buffer-function) 1433 (make-local-variable 'revert-buffer-function)
1430 (setq revert-buffer-function 'forms--revert-buffer) 1434 (setq revert-buffer-function #'forms--revert-buffer)
1431 1435
1432 t) 1436 t)
1433 1437
@@ -1900,7 +1904,7 @@ after writing out the data."
1900 ;; Write file hooks are run via write-file-functions. 1904 ;; Write file hooks are run via write-file-functions.
1901 ;; (if write-file-filter 1905 ;; (if write-file-filter
1902 ;; (save-excursion 1906 ;; (save-excursion
1903 ;; (run-hooks 'write-file-filter))) 1907 ;; (forms--run-functions write-file-filter)))
1904 1908
1905 ;; If they have a write-file-filter, force the buffer to be 1909 ;; If they have a write-file-filter, force the buffer to be
1906 ;; saved even if it doesn't seem to be changed. First, they 1910 ;; saved even if it doesn't seem to be changed. First, they
@@ -1912,7 +1916,7 @@ after writing out the data."
1912 (save-buffer args) 1916 (save-buffer args)
1913 (if read-file-filter 1917 (if read-file-filter
1914 (save-excursion 1918 (save-excursion
1915 (run-hooks 'read-file-filter))) 1919 (forms--run-functions read-file-filter)))
1916 (set-buffer-modified-p nil))) 1920 (set-buffer-modified-p nil)))
1917 ;; Make sure we end up with the same record number as we started. 1921 ;; Make sure we end up with the same record number as we started.
1918 ;; Since read-file-filter may perform arbitrary transformations on 1922 ;; Since read-file-filter may perform arbitrary transformations on
@@ -2037,20 +2041,19 @@ Usage: (setq forms-number-of-fields
2037(defun forms--debug (&rest args) 2041(defun forms--debug (&rest args)
2038 "Internal debugging routine." 2042 "Internal debugging routine."
2039 (if forms--debug 2043 (if forms--debug
2040 (let ((ret nil)) 2044 (let ((ret
2041 (while args 2045 (mapconcat
2042 (let ((el (car-safe args))) 2046 (lambda (el)
2043 (setq args (cdr-safe args)) 2047 (if (stringp el) el
2044 (if (stringp el) 2048 (concat (prin1-to-string el) " = "
2045 (setq ret (concat ret el)) 2049 (if (boundp el)
2046 (setq ret (concat ret (prin1-to-string el) " = ")) 2050 (prin1-to-string (eval el))
2047 (if (boundp el) 2051 "<unbound>")
2048 (let ((vel (eval el))) 2052 "\n"
2049 (setq ret (concat ret (prin1-to-string vel) "\n"))) 2053 (if (fboundp el)
2050 (setq ret (concat ret "<unbound>" "\n"))) 2054 (concat (prin1-to-string (symbol-function el))
2051 (if (fboundp el) 2055 "\n")))))
2052 (setq ret (concat ret (prin1-to-string (symbol-function el)) 2056 args "")))
2053 "\n"))))))
2054 (with-current-buffer (get-buffer-create "*forms-mode debug*") 2057 (with-current-buffer (get-buffer-create "*forms-mode debug*")
2055 (if (zerop (buffer-size)) 2058 (if (zerop (buffer-size))
2056 (emacs-lisp-mode)) 2059 (emacs-lisp-mode))