diff options
Diffstat (limited to 'lisp/forms.el')
| -rw-r--r-- | lisp/forms.el | 188 |
1 files changed, 155 insertions, 33 deletions
diff --git a/lisp/forms.el b/lisp/forms.el index 4f5efe45498..156dcf82450 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -123,6 +123,19 @@ ;;; perform `beginning-of-buffer' or `end-of-buffer' ;;; to perform `forms-first-field' resp. `forms-last-field'. ;;; +;;; forms-read-file-filter [symbol, default nil] +;;; If not nil: this should be the name of a +;;; function that is called after the forms data file +;;; has been read. It can be used to transform +;;; the contents of the file into a format more suitable +;;; for forms-mode processing. +;;; +;;; forms-write-file-filter [symbol, default nil] +;;; If not nil: this should be the name of a +;;; function that is called before the forms data file +;;; is written (saved) to disk. It can be used to undo +;;; the effects of `forms-read-file-filter', if any. +;;; ;;; forms-new-record-filter [symbol, default nil] ;;; If not nil: this should be the name of a ;;; function that is called when a new @@ -269,7 +282,7 @@ (defconst forms-version (substring "$Revision: 2.7 $" 11 -2) "The version number of forms-mode (as string). The complete RCS id is: - $Id: forms.el,v 2.7 1994/06/13 12:07:44 rms Exp rms $") + $Id: forms.el,v 2.7 1994/07/25 20:38:23 jv Exp $") (defvar forms-mode-hooks nil "Hook functions to be run upon entering Forms mode.") @@ -305,6 +318,15 @@ The replacement commands performs forms-next/prev-record.") "*Non-nil means redefine beginning/end-of-buffer in Forms mode. The replacement commands performs forms-first/last-record.") +(defvar forms-read-file-filter nil + "The name of a function that is called after reading the data file. +This can be used to change the contents of the file to something more +suitable for forms processing.") + +(defvar forms-write-file-filter nil + "The name of a function that is called before writing the data file. +This can be used to undo the effects of form-read-file-hook.") + (defvar forms-new-record-filter nil "The name of a function that is called when a new record is created.") @@ -428,10 +450,16 @@ Commands: Equivalent keys in read-only mode: (make-local-variable 'forms-forms-scroll) (make-local-variable 'forms-forms-jump) (make-local-variable 'forms-use-text-properties) + + ;; Filter functions. + (make-local-variable 'forms-read-file-filter) + (make-local-variable 'forms-write-file-filter) (make-local-variable 'forms-new-record-filter) (make-local-variable 'forms-modified-record-filter) ;; Make sure no filters exist. + (setq forms-read-file-filter nil) + (setq forms-write-file-filter nil) (setq forms-new-record-filter nil) (setq forms-modified-record-filter nil) @@ -452,20 +480,29 @@ Commands: Equivalent keys in read-only mode: (eval-current-buffer) (error "`enable-local-eval' inhibits buffer evaluation")) - ;; check if the mandatory variables make sense. + ;; Check if the mandatory variables make sense. (or forms-file (error (concat "Forms control file error: " "'forms-file' has not been set"))) - (or forms-number-of-fields - (error (concat "Forms control file error: " - "'forms-number-of-fields' has not been set"))) - (or (and (numberp forms-number-of-fields) - (> forms-number-of-fields 0)) - (error (concat "Forms control file error: " - "'forms-number-of-fields' must be a number > 0"))) + + ;; Check forms-field-sep first, since it can be needed to + ;; construct a default format list. (or (stringp forms-field-sep) (error (concat "Forms control file error: " "'forms-field-sep' is not a string"))) + + (if forms-number-of-fields + (or (and (numberp forms-number-of-fields) + (> forms-number-of-fields 0)) + (error (concat "Forms control file error: " + "'forms-number-of-fields' must be a number > 0"))) + (or (null forms-format-list) + (error (concat "Forms control file error: " + "'forms-number-of-fields' has not been set")))) + + (or forms-format-list + (forms--intuit-from-file)) + (if forms-multi-line (if (and (stringp forms-multi-line) (eq (length forms-multi-line) 1)) @@ -560,6 +597,25 @@ Commands: Equivalent keys in read-only mode: ;; find the data file (setq forms--file-buffer (find-file-noselect forms-file)) + ;; Pre-transform. + (let ((read-file-filter forms-read-file-filter) + (write-file-filter forms-write-file-filter)) + (if read-file-filter + (save-excursion + (set-buffer forms--file-buffer) + (let ((inhibit-read-only t)) + (run-hooks 'read-file-filter)) + (set-buffer-modified-p nil) + (if write-file-filter + (progn + (make-variable-buffer-local 'local-write-file-hooks) + (setq local-write-file-hooks (list write-file-filter))))) + (if write-file-filter + (save-excursion + (set-buffer forms--file-buffer) + (make-variable-buffer-local 'local-write-file-hooks) + (setq local-write-file-hooks write-file-filter))))) + ;; count the number of records, and set see if it may be modified (let (ro) (setq forms--total-records @@ -592,10 +648,27 @@ Commands: Equivalent keys in read-only mode: ;;(message "forms: proceeding setup (buffer)...") (set-buffer-modified-p nil) - ;; setup the first (or current) record to show - (if (< forms--current-record 1) - (setq forms--current-record 1)) - (forms-jump-record forms--current-record) + (if (= forms--total-records 0) + ;;(message "forms: proceeding setup (new file)...") + (progn + (insert + "GNU Emacs Forms Mode version " forms-version "\n\n" + (if (file-exists-p forms-file) + (concat "No records available in file \"" forms-file "\".\n\n") + (format "Creating new file \"%s\"\nwith %d field%s per record.\n\n" + forms-file forms-number-of-fields + (if (= 1 forms-number-of-fields) "" "s"))) + "Use " (substitute-command-keys "\\[forms-insert-record]") + " to create new records.\n") + (setq forms--current-record 1) + (setq buffer-read-only t) + (set-buffer-modified-p nil)) + + ;; setup the first (or current) record to show + (if (< forms--current-record 1) + (setq forms--current-record 1)) + (forms-jump-record forms--current-record) + ) ;; user customising ;;(message "forms: proceeding setup (user hooks)...") @@ -1082,6 +1155,52 @@ Commands: Equivalent keys in read-only mode: (setq forms--field nil))) )) +(defun forms--intuit-from-file () + "Get number of fields and a default form using the data file." + + ;; If `forms-number-of-fields' is not set, get it from the data file. + (if (null forms-number-of-fields) + + ;; Need a file to do this. + (if (not (file-exists-p forms-file)) + (error "Need existing file or explicit 'forms-number-of-records'.") + + ;; Visit the file and extract the first record. + (setq forms--file-buffer (find-file-noselect forms-file)) + (let ((read-file-filter forms-read-file-filter) + (the-record)) + (setq the-record + (save-excursion + (set-buffer forms--file-buffer) + (let ((inhibit-read-only t)) + (run-hooks 'read-file-filter)) + (goto-char (point-min)) + (forms--get-record))) + + ;; This may be overkill, but try to avoid interference with + ;; the normal processing. + (kill-buffer forms--file-buffer) + + ;; Count the number of fields in `the-record'. + (let (the-result + (start-pos 0) + found-pos + (field-sep-length (length forms-field-sep))) + (setq forms-number-of-fields 1) + (while (setq found-pos + (string-match forms-field-sep the-record start-pos)) + (progn + (setq forms-number-of-fields (1+ forms-number-of-fields)) + (setq start-pos (+ field-sep-length found-pos)))))))) + + ;; Construct default format list. + (setq forms-format-list (list "Forms file \"" forms-file "\".\n\n")) + (let ((i 0)) + (while (<= (setq i (1+ i)) forms-number-of-fields) + (setq forms-format-list + (append forms-format-list + (list (format "%4d: " i) i "\n")))))) + (defun forms--set-keymaps () "Set the keymaps used in this mode." @@ -1170,10 +1289,9 @@ Commands: Equivalent keys in read-only mode: (current-local-map) (current-global-map)))) ;; - ;; Use local-write-file-hooks to invoke our own buffer save - ;; function. Note however that it usually does not work. - (make-local-variable 'local-write-file-hooks) - (add-hook 'local-write-file-hooks 'forms--local-write-file-function) + ;; Save buffer + (local-set-key "\C-x\C-s" 'forms-save-buffer) + ;; ;; We have our own revert function - use it. (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'forms--revert-buffer) @@ -1182,18 +1300,12 @@ Commands: Equivalent keys in read-only mode: (defun forms--help () "Initial help for Forms mode." - ;; We should use (message (substitute-command-keys (concat "\\[forms-next-record]:next" " \\[forms-prev-record]:prev" " \\[forms-first-record]:first" " \\[forms-last-record]:last" " \\[describe-mode]:help")))) - ; but it's too slow .... -; (if forms-read-only -; (message "SPC:next DEL:prev <:first >:last ?:help q:exit") -; (message "C-c n:next C-c p:prev C-c <:first C-c >:last C-c ?:help C-c q:exit")) -; ) (defun forms--trans (subj arg rep) "Translate in SUBJ all chars ARG into char REP. ARG and REP should @@ -1213,9 +1325,7 @@ Commands: Equivalent keys in read-only mode: (forms--checkmod) (if (and save (buffer-modified-p forms--file-buffer)) - (save-excursion - (set-buffer forms--file-buffer) - (save-buffer))) + (forms-save-buffer)) (save-excursion (set-buffer forms--file-buffer) (delete-auto-save-file-if-necessary) @@ -1334,6 +1444,10 @@ As a side effect: sets `forms--the-record-list'." (setq the-record (mapconcat 'identity forms--the-record-list forms-field-sep)) + (if (string-match (regexp-quote forms-field-sep) + (mapconcat 'identity forms--the-record-list "")) + (error "Field separator occurs in record - update refused!")) + ;; Handle multi-line fields, if allowed. (if forms-multi-line (forms--trans the-record "\n" forms-multi-line)) @@ -1348,8 +1462,8 @@ As a side effect: sets `forms--the-record-list'." (set-buffer forms--file-buffer) ;; Use delete-region instead of kill-region, to avoid ;; adding junk to the kill-ring. - (delete-region (save-excursion (beginning-of-line) (point)) - (save-excursion (end-of-line) (point))) + (delete-region (progn (beginning-of-line) (point)) + (progn (beginning-of-line 2) (point)))) (insert the-record) (beginning-of-line)))))) @@ -1612,12 +1726,20 @@ it is called to fill (some of) the fields with default values." (re-search-forward regexp nil t)))) (setq forms--search-regexp regexp)) -(defun forms--local-write-file-function () - "Local write file hook." +(defun forms-save-buffer (&optional args) + "Forms mode replacement for save-buffer. +It saves the data buffer instead of the forms buffer. +Calls `forms-write-file-filter' before writing out the data." + (interactive "p") (forms--checkmod) - (save-excursion - (set-buffer forms--file-buffer) - (save-buffer)) + (let ((read-file-filter forms-read-file-filter)) + (save-excursion + (set-buffer forms--file-buffer) + (let ((inhibit-read-only t)) + (save-buffer args) + (if read-file-filter + (run-hooks 'read-file-filter)) + (set-buffer-modified-p nil)))) t) (defun forms--revert-buffer (&optional arg noconfirm) |