summaryrefslogtreecommitdiff
path: root/lisp/forms.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/forms.el')
-rw-r--r--lisp/forms.el188
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)