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:
parent
1a2b7f51aa
commit
38bd9da2df
155
lisp/forms.el
155
lisp/forms.el
@ -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)
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user