1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-24 07:20:37 +00:00

Use `error' where possible to signal errors.

Remove (beep)s for warnings.
Change comment about the iif hook to reflect the actual reason.
Correct error in field numbering.

(forms-mode): Make `forms--elements' local before calling
`forms--process-format-list'.

(forms-save-buffer): `forms-write-file-filter' and
`forms-read-file-filter' were not called correctly.
This commit is contained in:
Karl Heuer 1997-06-10 18:32:33 +00:00
parent 1a2b7f51aa
commit 38bd9da2df

View File

@ -1,6 +1,6 @@
;;; forms.el --- Forms mode: edit a file as a form to fill in ;;; forms.el --- Forms mode: edit a file as a form to fill in
;; Copyright (C) 1991, 1994, 1995, 1996 Free Software Foundation, Inc. ;; Copyright (C) 1991, 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; Author: Johan Vromans <jvromans@squirrel.nl> ;; Author: Johan Vromans <jvromans@squirrel.nl>
@ -292,10 +292,10 @@
(provide 'forms) ;;; official (provide 'forms) ;;; official
(provide 'forms-mode) ;;; for compatibility (provide 'forms-mode) ;;; for compatibility
(defconst forms-version (substring "$Revision: 2.20 $" 11 -2) (defconst forms-version (substring "$Revision: 2.29 $" 11 -2)
"The version number of forms-mode (as string). The complete RCS id is: "The version number of forms-mode (as string). The complete RCS id is:
$Id: forms.el,v 2.20 1996/03/01 20:31:29 jv Exp $") $Id: forms.el,v 2.29 1996/03/01 21:13:01 jvromans Exp kwzh $")
(defvar forms-mode-hooks nil (defvar forms-mode-hooks nil
"Hook functions to be run upon entering Forms mode.") "Hook functions to be run upon entering Forms mode.")
@ -538,6 +538,7 @@ Commands: Equivalent keys in read-only mode:
;; Validate and process forms-format-list. ;; Validate and process forms-format-list.
;;(message "forms: pre-processing format list...") ;;(message "forms: pre-processing format list...")
(make-local-variable 'forms--elements)
(forms--process-format-list) (forms--process-format-list)
;; Build the formatter and parser. ;; Build the formatter and parser.
@ -545,7 +546,6 @@ Commands: Equivalent keys in read-only mode:
(make-local-variable 'forms--format) (make-local-variable 'forms--format)
(make-local-variable 'forms--markers) (make-local-variable 'forms--markers)
(make-local-variable 'forms--dyntexts) (make-local-variable 'forms--dyntexts)
(make-local-variable 'forms--elements)
;;(message "forms: building parser...") ;;(message "forms: building parser...")
(forms--make-format) (forms--make-format)
(make-local-variable 'forms--parser) (make-local-variable 'forms--parser)
@ -770,7 +770,7 @@ Commands: Equivalent keys in read-only mode:
el forms-number-of-fields)) el forms-number-of-fields))
;; Store forms order. ;; Store forms order.
(if (> field-num (length forms--elements)) (if (>= field-num (length forms--elements))
(setq forms--elements (vconcat forms--elements (1- el))) (setq forms--elements (vconcat forms--elements (1- el)))
(aset forms--elements field-num (1- el))) (aset forms--elements field-num (1- el)))
(setq field-num (1+ field-num)) (setq field-num (1+ field-num))
@ -821,13 +821,13 @@ Commands: Equivalent keys in read-only mode:
;; Special treatment for read-only segments. ;; Special treatment for read-only segments.
;; ;;
;; If text is inserted between two read-only segments, it inherits the ;; If text is inserted between two read-only segments, there seems to
;; read-only properties. This is not what we want. ;; be no way to give the newly inserted text the RW face.
;; To solve this, read-only segments get the `insert-in-front-hooks' ;; To solve this, read-only segments get the `insert-in-front-hooks'
;; property set with a function that temporarily switches the properties ;; property set with a function that temporarily switches the
;; of the first character of the segment to read-write, so the new ;; properties of the first character of the segment to the RW face, so
;; text gets the right properties. ;; the new text gets the right face. The `post-command-hook' is
;; The `post-command-hook' is used to restore the original properties. ;; used to restore the original properties.
(defvar forms--iif-start nil (defvar forms--iif-start nil
"Record start of modification command.") "Record start of modification command.")
@ -1458,10 +1458,8 @@ Commands: Equivalent keys in read-only mode:
(delete-auto-save-file-if-necessary) (delete-auto-save-file-if-necessary)
(kill-buffer (current-buffer))) (kill-buffer (current-buffer)))
(if (get-buffer buf) ; not killed??? (if (get-buffer buf) ; not killed???
(if save (if save
(progn (error "Problem saving buffer %s" (buffer-name buf)))
(beep)
(message "Problem saving buffers?")))
(delete-auto-save-file-if-necessary) (delete-auto-save-file-if-necessary)
(kill-buffer (current-buffer))))) (kill-buffer (current-buffer)))))
@ -1508,7 +1506,6 @@ Commands: Equivalent keys in read-only mode:
nil nil
(if (null forms-check-number-of-fields) (if (null forms-check-number-of-fields)
nil nil
(beep)
(message "Warning: this record has %d fields instead of %d" (message "Warning: this record has %d fields instead of %d"
(length forms--the-record-list) forms-number-of-fields)) (length forms--the-record-list) forms-number-of-fields))
(if (< (length forms--the-record-list) forms-number-of-fields) (if (< (length forms--the-record-list) forms-number-of-fields)
@ -1563,38 +1560,34 @@ Commands: Equivalent keys in read-only mode:
As a side effect: sets `forms--the-record-list'." As a side effect: sets `forms--the-record-list'."
(if forms-read-only (if forms-read-only
(progn (error "Buffer is read-only"))
(message "Read-only buffer!")
(beep))
(let (the-record) (let (the-record)
;; Build new record. ;; Build new record.
(setq forms--the-record-list (forms--parse-form)) (setq forms--the-record-list (forms--parse-form))
(setq the-record (setq the-record
(mapconcat 'identity forms--the-record-list forms-field-sep)) (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))
(if (string-match (regexp-quote forms-field-sep) ;; A final sanity check before updating.
(mapconcat 'identity forms--the-record-list "")) (if (string-match "\n" the-record)
(error "Field separator occurs in record - update refused!")) (error "Multi-line fields in this record - update refused"))
;; Handle multi-line fields, if allowed. (save-excursion
(if forms-multi-line (set-buffer forms--file-buffer)
(forms--trans the-record "\n" forms-multi-line)) ;; Use delete-region instead of kill-region, to avoid
;; adding junk to the kill-ring.
;; A final sanity check before updating. (delete-region (save-excursion (beginning-of-line) (point))
(if (string-match "\n" the-record) (save-excursion (end-of-line) (point)))
(progn (insert the-record)
(message "Multi-line fields in this record - update refused!") (beginning-of-line))))
(beep))
(save-excursion
(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)))
(insert the-record)
(beginning-of-line))))))
(defun forms--checkmod () (defun forms--checkmod ()
"Check if this form has been modified, and call forms--update if so." "Check if this form has been modified, and call forms--update if so."
@ -1653,45 +1646,43 @@ As a side effect: sets `forms--the-record-list'."
;; Verify that the record number is within range. ;; Verify that the record number is within range.
(if (or (> arg forms--total-records) (if (or (> arg forms--total-records)
(<= arg 0)) (<= arg 0))
(progn (error
(beep)
;; Don't give the message if just paging. ;; Don't give the message if just paging.
(if (not relative) (if (not relative)
(message "Record number %d out of range 1..%d" (message "Record number %d out of range 1..%d"
arg forms--total-records)) arg forms--total-records)
) "")))
;; Flush. ;; Flush.
(forms--checkmod) (forms--checkmod)
;; Calculate displacement. ;; Calculate displacement.
(let ((disp (- arg forms--current-record)) (let ((disp (- arg forms--current-record))
(cur forms--current-record)) (cur forms--current-record))
;; `forms--show-record' needs it now. ;; `forms--show-record' needs it now.
(setq forms--current-record arg) (setq forms--current-record arg)
;; Get the record and show it. ;; Get the record and show it.
(forms--show-record (forms--show-record
(save-excursion (save-excursion
(set-buffer forms--file-buffer) (set-buffer forms--file-buffer)
(beginning-of-line) (beginning-of-line)
;; Move, and adjust the amount if needed (shouldn't happen). ;; Move, and adjust the amount if needed (shouldn't happen).
(if relative (if relative
(if (zerop disp) (if (zerop disp)
nil nil
(setq cur (+ cur disp (- (forward-line disp))))) (setq cur (+ cur disp (- (forward-line disp)))))
(setq cur (+ cur disp (- (goto-line arg))))) (setq cur (+ cur disp (- (goto-line arg)))))
(forms--get-record))) (forms--get-record)))
;; This shouldn't happen. ;; This shouldn't happen.
(if (/= forms--current-record cur) (if (/= forms--current-record cur)
(progn (progn
(setq forms--current-record cur) (setq forms--current-record cur)
(beep) (error "Stuck at record %d" cur)))))
(message "Stuck at record %d" cur))))))
(defun forms-first-record () (defun forms-first-record ()
"Jump to first record." "Jump to first record."
@ -1709,7 +1700,6 @@ As a side effect: re-calculates the number of records in the data file."
(count-lines (point-min) (point-max))))) (count-lines (point-min) (point-max)))))
(if (= numrec forms--total-records) (if (= numrec forms--total-records)
nil nil
(beep)
(setq forms--total-records numrec) (setq forms--total-records numrec)
(message "Warning: number of records changed to %d" forms--total-records))) (message "Warning: number of records changed to %d" forms--total-records)))
(forms-jump-record forms--total-records)) (forms-jump-record forms--total-records))
@ -1736,8 +1726,7 @@ Otherwise enables edit mode if the visited file is writable."
buffer-read-only) buffer-read-only)
(progn (progn
(setq forms-read-only t) (setq forms-read-only t)
(message "No write access to `%s'" forms-file) (message "No write access to `%s'" forms-file))
(beep))
(setq forms-read-only nil)) (setq forms-read-only nil))
(if (equal ro forms-read-only) (if (equal ro forms-read-only)
nil nil
@ -1896,16 +1885,22 @@ after the current record."
(defun forms-save-buffer (&optional args) (defun forms-save-buffer (&optional args)
"Forms mode replacement for save-buffer. "Forms mode replacement for save-buffer.
It saves the data buffer instead of the forms buffer. It saves the data buffer instead of the forms buffer.
Calls `forms-write-file-filter' before writing out the data." Calls `forms-write-file-filter' before, and `forms-read-file-filter'
after writing out the data."
(interactive "p") (interactive "p")
(forms--checkmod) (forms--checkmod)
(let ((read-file-filter forms-read-file-filter)) (let ((write-file-filter forms-write-file-filter)
(read-file-filter forms-read-file-filter))
(save-excursion (save-excursion
(set-buffer forms--file-buffer) (set-buffer forms--file-buffer)
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(if write-file-filter
(save-excursion
(run-hooks 'write-file-filter)))
(save-buffer args) (save-buffer args)
(if read-file-filter (if read-file-filter
(run-hooks 'read-file-filter)) (save-excursion
(run-hooks 'read-file-filter)))
(set-buffer-modified-p nil)))) (set-buffer-modified-p nil))))
t) t)