mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-23 10:34:07 +00:00
Code Issues Releases Activity

(forms-read-file-filter): new hook function to

Browse Source 
preprocess file contents before being passed to forms mode.
(forms-write-file-filter): new hook function to preprocess file
contents before it is being saved to disk. Can be used to undo the
effects of `forms-read-file-filter'.
(forms-mode): Supply a default format if no `forms-format-list' was
specified.
Preprocess file contents using `forms-read-file-filter' and attach
`forms-write-file-filter' to the `local-write-file-hooks' of the file
buffer.
Present a friendly message if the visited file is empty or new.
(forms--intuit-from-file): New subroutine to get the number of fields
from the data file; constructs a default format list.
(forms-save-buffer): Forms mode wrapper for `save-buffer'.
(forms--change-commands, forms--exit): Use it.
(forms--update): Check for the presence of the field separator in any
of the fields.  Refuse update if found.
(forms-delete-record): Allow the last record of the file to be
deleted, even if not terminated by a newline.
(forms--local-write-file-function): Remove.  Didn't do any good.
Replaced by `forms-save-buffer'.
This commit is contained in:
Richard M. Stallman 1994-07-26 19:47:39 +00:00
parent 26d270ab48
commit 9c308ed258
1 changed files with 155 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

188
lisp/forms.el
View File

@ -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)