diff options
| author | Stefan Monnier | 2020-12-26 12:21:17 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2020-12-26 12:21:32 -0500 |
| commit | 4b2ca6bfc079c66cfcf39f2f36dc139012787535 (patch) | |
| tree | e475a0e35638f9ba23176ef5f5ad80b2b1afb25c | |
| parent | 25fb44fad15743cd7725aa73681c2652d5a23b09 (diff) | |
| download | emacs-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.el | 63 |
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)) |