;; The second file holds the actual data. The buffer of this file
;; will be buried, for it is never accessed directly.
;;
-;; Forms mode is invoked using M-x forms-find-file control-file .
+;; Forms mode is invoked using M-x `forms-find-file' control-file.
;; Alternatively `forms-find-file-other-window' can be used.
;;
;; You may also visit the control file, and switch to forms mode by hand
-;; with M-x forms-mode .
+;; with M-x `forms-mode'.
;;
;; Automatic mode switching is supported if you specify
;; "-*- forms -*-" in the first line of the control file.
;; of fields specified by `forms-number-of-fields'.
;;
;; forms-multi-line [string, default "^K"]
-;; If non-null the records of the data file may
+;; If non-null, the records of the data file may
;; contain fields that can span multiple lines in
;; the form.
-;; This variable denotes the separator character
+;; This variable denotes the separator string
;; to be used for this purpose. Upon display, all
-;; occurrences of this character are translated
+;; occurrences of this string are translated
;; to newlines. Upon storage they are translated
-;; back to the separator character.
+;; back to the separator string.
;;
;; forms-forms-scroll [bool, default nil]
;; Non-nil means: rebind locally the commands that
;; `forms-next-field' resp. `forms-prev-field'.
;;
;; forms-forms-jump [bool, default nil]
-;; Non-nil means: rebind locally the commands that
+;; Non-nil means: rebind locally the commands
+;; `beginning-of-buffer' and `end-of-buffer' to
+;; perform, respectively, `forms-first-record' and
+;; `forms-last-record' instead.
;;
;; forms-insert-after [bool, default nil]
-;; Non-nil means: inserts of new records go after
-;; current record, also initial position is at last
-;; record.
+;; Non-nil means: insertions of new records go after
+;; current record, also initial position is at the
+;; last record. The default is to insert before the
+;; current record and the initial position is at the
+;; first record.
;;
;; forms-read-file-filter [symbol, default nil]
;; If not nil: this should be the name of a
;; distinct face, if possible.
;; As of emacs 19.29, the `intangible' text property
;; is used to prevent moving into read-only fields.
-;; This variable defaults to t if running Emacs 19
-;; with text properties.
+;; This variable defaults to t if running Emacs 19 or
+;; later with text properties.
;; The default face to show read-write fields is
;; copied from face `region'.
;;
;; forms-ro-face [symbol, default 'default]
;; This is the face that is used to show
-;; read-only text on the screen.If used, this
+;; read-only text on the screen. If used, this
;; variable should be set to a symbol that is a
;; valid face.
;; E.g.
;; After evaluating the control file, its buffer is cleared and used
;; for further processing.
;; The data file (as designated by `forms-file') is visited in a buffer
-;; `forms--file-buffer' which will not normally be shown.
+;; `forms--file-buffer' which normally will not be shown.
;; Great malfunctioning may be expected if this file/buffer is modified
;; outside of this package while it is being visited!
;;
;;
;; Two exit functions exist: `forms-exit' and `forms-exit-no-save'.
;; `forms-exit' saves the data to the file, if modified.
-;; `forms-exit-no-save` does not. However, if `forms-exit-no-save'
+;; `forms-exit-no-save' does not. However, if `forms-exit-no-save'
;; is executed and the file buffer has been modified, Emacs will ask
;; questions anyway.
;;
;; switching edit <-> view mode v.v.
;; jumping from field to field
;;
-;; As an documented side-effect: jumping to the last record in the
+;; As a documented side-effect: jumping to the last record in the
;; file (using forms-last-record) will adjust forms--total-records if
;; needed.
;;
-;; The forms buffer can be in on eof two modes: edit mode or view
-;; mode. View mode is a read-only mode, you cannot modify the
+;; The forms buffer can be in one of two modes: edit mode or view
+;; mode. View mode is a read-only mode, whereby you cannot modify the
;; contents of the buffer.
;;
;; Edit mode commands:
;; SPC forms-next-record
;; DEL forms-prev-record
;; ? describe-mode
-;; \C-q forms-toggle-read-only
+;; \C-q forms-toggle-read-only
;; l forms-jump-record
;; n forms-next-record
;; p forms-prev-record
;; [begin] forms-first-record
;; [end] forms-last-record
;; [S-TAB] forms-prev-field
-;; [backtab] forms-prev-field
+;; [backtab] forms-prev-field
;;
;; For convenience, TAB is always bound to `forms-next-field', so you
;; don't need the C-c prefix for this command.
;;
-;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump')
+;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump'),
;; the bindings of standard functions `scroll-up', `scroll-down',
;; `beginning-of-buffer' and `end-of-buffer' can be locally replaced with
;; forms mode functions next/prev record and first/last
;; record.
;;
-;; `local-write-file hook' is defined to save the actual data file
+;; `local-write-file-hooks' is defined to save the actual data file
;; instead of the buffer data, `revert-file-hook' is defined to
;; revert a forms to original.
\f
;;; Code:
+(defgroup forms nil
+ "Edit a file as a form to fill in."
+ :group 'data)
+
;;; Global variables and constants:
(provide 'forms) ;;; official
(provide 'forms-mode) ;;; for compatibility
-(defconst forms-version (substring "$Revision: 2.30 $" 11 -2)
+(defconst forms-version (substring "$Revision: 2.39 $" 11 -2)
"The version number of forms-mode (as string). The complete RCS id is:
- $Id: forms.el,v 2.30 1997/06/10 18:32:33 kwzh Exp rms $")
+ $Id: forms.el,v 2.39 1999/05/31 08:34:19 eliz Exp $")
-(defvar forms-mode-hooks nil
- "Hook functions to be run upon entering Forms mode.")
+(defcustom forms-mode-hooks nil
+ "Hook functions to be run upon entering Forms mode."
+ :group 'forms
+ :type 'function)
\f
;;; Mandatory variables - must be set by evaluating the control file.
\f
;;; Optional variables with default values.
-(defvar forms-check-number-of-fields t
- "*If non-nil, warn about records with wrong number of fields.")
+(defcustom forms-check-number-of-fields t
+ "*If non-nil, warn about records with wrong number of fields."
+ :group 'forms
+ :type 'boolean)
(defvar forms-field-sep "\t"
"Field separator character (default TAB).")
(defvar forms-read-only nil
"Non-nil means: visit the file in view (read-only) mode.
-\(Defaults to the write access on the data file).")
+This is set automatically if the file permissions don't let you write it.")
-(defvar forms-multi-line "\C-k"
- "If not nil: use this character to separate multi-line fields (default C-k).")
+(defvar forms-multi-line "\C-k" "\
+If not nil: use this character to separate multi-line fields (default C-k).")
-(defvar forms-forms-scroll nil
+(defcustom forms-forms-scroll nil
"*Non-nil means replace scroll-up/down commands in Forms mode.
-The replacement commands performs forms-next/prev-record.")
+The replacement commands performs forms-next/prev-record."
+ :group 'forms
+ :type 'boolean)
-(defvar forms-forms-jump nil
+(defcustom forms-forms-jump nil
"*Non-nil means redefine beginning/end-of-buffer in Forms mode.
-The replacement commands performs forms-first/last-record.")
+The replacement commands performs forms-first/last-record."
+ :group 'forms
+ :type 'boolean)
(defvar forms-read-file-filter nil
"The name of a function that is called after reading the data file.
(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.")
+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.")
This variable is for use by the filter routines only.
The contents may NOT be modified.")
-(defvar forms-use-text-properties (fboundp 'set-text-properties)
- "*Non-nil means: use emacs-19 text properties.
-Defaults to t if this emacs is capable of handling text properties.")
+(defcustom forms-use-text-properties t
+ "*Non-nil means: use text properties.
+Defaults to t if this Emacs is capable of handling text properties."
+ :group 'forms
+ :type 'boolean)
-(defvar forms-insert-after nil
+(defcustom forms-insert-after nil
"*Non-nil means: inserts of new records go after current record.
-Also, initial position is at last record.")
-
-(defvar forms-ro-face 'default
- "The face (a symbol) that is used to display read-only text on the screen.")
-
-(defvar forms-rw-face 'region
- "The face (a symbol) that is used to display read-write text on the screen.")
+Also, initial position is at last record."
+ :group 'forms
+ :type 'boolean)
+
+(defcustom forms-ro-face 'default
+ "The face (a symbol) that is used to display read-only text on the screen."
+ :group 'forms
+ :type 'face)
+
+(defcustom forms-rw-face 'region
+ "The face (a symbol) that is used to display read-write text on the screen."
+ :group 'forms
+ :type 'face)
\f
;;; Internal variables.
Commands: Equivalent keys in read-only mode:
TAB forms-next-field TAB
- \\C-c TAB forms-next-field
- \\C-c < forms-first-record <
- \\C-c > forms-last-record >
- \\C-c ? describe-mode ?
- \\C-c \\C-k forms-delete-record
- \\C-c \\C-q forms-toggle-read-only q
- \\C-c \\C-o forms-insert-record
- \\C-c \\C-l forms-jump-record l
- \\C-c \\C-n forms-next-record n
- \\C-c \\C-p forms-prev-record p
- \\C-c \\C-r forms-search-reverse r
- \\C-c \\C-s forms-search-forward s
- \\C-c \\C-x forms-exit x
+ C-c TAB forms-next-field
+ C-c < forms-first-record <
+ C-c > forms-last-record >
+ C-c ? describe-mode ?
+ C-c C-k forms-delete-record
+ C-c C-q forms-toggle-read-only q
+ C-c C-o forms-insert-record
+ C-c C-l forms-jump-record l
+ C-c C-n forms-next-record n
+ C-c C-p forms-prev-record p
+ C-c C-r forms-search-reverse r
+ C-c C-s forms-search-forward s
+ C-c C-x forms-exit x
"
(interactive)
;; Dynamic text support.
(make-local-variable 'forms--dynamic-text)
- ;; Prevent accidental overwrite of the control file and autosave.
+ ;; Prevent accidental overwrite of the control file and auto-save.
(set-visited-file-name nil)
;; Prepare this buffer for further processing.
(if (< forms--current-record 1)
(setq forms--current-record 1))
(forms-jump-record forms--current-record)
- )
- (if forms-insert-after
- (forms-last-record)
- (forms-first-record))
+ (if forms-insert-after
+ (forms-last-record)
+ (forms-first-record))
+ )
;; user customising
;;(message "forms: proceeding setup (user hooks)...")
(setq
forms--format
(if forms-use-text-properties
- (` (lambda (arg)
- (let ((inhibit-read-only t))
- (,@ (apply 'append
- (mapcar 'forms--make-format-elt-using-text-properties
- forms-format-list)))
- ;; Prevent insertion before the first text.
- (,@ (if (numberp (car forms-format-list))
- nil
- '((add-text-properties (point-min) (1+ (point-min))
- '(front-sticky (read-only intangible))))))
- ;; Prevent insertion after the last text.
- (remove-text-properties (1- (point)) (point)
- '(rear-nonsticky)))
- (setq forms--iif-start nil)))
- (` (lambda (arg)
- (,@ (apply 'append
- (mapcar 'forms--make-format-elt forms-format-list)))))))
+ `(lambda (arg)
+ (let ((inhibit-read-only t))
+ ,@(apply 'append
+ (mapcar 'forms--make-format-elt-using-text-properties
+ forms-format-list))
+ ;; Prevent insertion before the first text.
+ ,@(if (numberp (car forms-format-list))
+ nil
+ '((add-text-properties (point-min) (1+ (point-min))
+ '(front-sticky (read-only intangible)))))
+ ;; Prevent insertion after the last text.
+ (remove-text-properties (1- (point)) (point)
+ '(rear-nonsticky)))
+ (setq forms--iif-start nil))
+ `(lambda (arg)
+ ,@(apply 'append
+ (mapcar 'forms--make-format-elt forms-format-list)))))
;; We have tallied the number of markers and dynamic texts,
;; so we can allocate the arrays now.
(cond
((stringp el)
- (` ((set-text-properties
- (point) ; start at point
- (progn ; until after insertion
- (insert (, el))
- (point))
- (list 'face forms--ro-face ; read-only appearance
- 'read-only (,@ (list (1+ forms--marker)))
- 'intangible t
- 'insert-in-front-hooks '(forms--iif-hook)
- 'rear-nonsticky '(face read-only insert-in-front-hooks
- intangible))))))
+ `((set-text-properties
+ (point) ; start at point
+ (progn ; until after insertion
+ (insert ,el)
+ (point))
+ (list 'face forms--ro-face ; read-only appearance
+ 'read-only ,@(list (1+ forms--marker))
+ 'intangible ,@(list (1+ forms--marker))
+ 'insert-in-front-hooks '(forms--iif-hook)
+ 'rear-nonsticky '(face read-only insert-in-front-hooks
+ intangible)))))
((numberp el)
- (` ((let ((here (point)))
- (aset forms--markers
- (, (prog1 forms--marker
- (setq forms--marker (1+ forms--marker))))
- (point-marker))
- (insert (elt arg (, (1- el))))
- (or (= (point) here)
- (set-text-properties
- here (point)
- (list 'face forms--rw-face
- 'front-sticky '(face))))))))
+ `((let ((here (point)))
+ (aset forms--markers
+ ,(prog1 forms--marker
+ (setq forms--marker (1+ forms--marker)))
+ (point-marker))
+ (insert (elt arg ,(1- el)))
+ (or (= (point) here)
+ (set-text-properties
+ here (point)
+ (list 'face forms--rw-face
+ 'front-sticky '(face)))))))
((listp el)
- (` ((set-text-properties
- (point)
- (progn
- (insert (aset forms--dyntexts
- (, (prog1 forms--dyntext
- (setq forms--dyntext (1+ forms--dyntext))))
- (, el)))
- (point))
- (list 'face forms--ro-face
- 'read-only (,@ (list (1+ forms--marker)))
- 'intangible t
- 'insert-in-front-hooks '(forms--iif-hook)
- 'rear-nonsticky '(read-only face insert-in-front-hooks
- intangible))))))
+ `((set-text-properties
+ (point)
+ (progn
+ (insert (aset forms--dyntexts
+ ,(prog1 forms--dyntext
+ (setq forms--dyntext (1+ forms--dyntext)))
+ ,el))
+ (point))
+ (list 'face forms--ro-face
+ 'read-only ,@(list (1+ forms--marker))
+ 'intangible ,@(list (1+ forms--marker))
+ 'insert-in-front-hooks '(forms--iif-hook)
+ 'rear-nonsticky '(read-only face insert-in-front-hooks
+ intangible)))))
;; end of cond
))
(cond
((stringp el)
- (` ((insert (, el)))))
+ `((insert ,el)))
((numberp el)
(prog1
- (` ((aset forms--markers (, forms--marker) (point-marker))
- (insert (elt arg (, (1- el))))))
+ `((aset forms--markers ,forms--marker (point-marker))
+ (insert (elt arg ,(1- el))))
(setq forms--marker (1+ forms--marker))))
((listp el)
(prog1
- (` ((insert (aset forms--dyntexts (, forms--dyntext) (, el)))))
+ `((insert (aset forms--dyntexts ,forms--dyntext ,el)))
(setq forms--dyntext (1+ forms--dyntext))))))
\f
(defvar forms--field)
;; Note: we add a nil element to the list passed to `mapcar',
;; see `forms--make-parser-elt' for details.
- (` (lambda nil
- (let (here)
- (goto-char (point-min))
- (,@ (apply 'append
- (mapcar
- 'forms--make-parser-elt
- (append forms-format-list (list nil)))))))))))
+ `(lambda nil
+ (let (here)
+ (goto-char (point-min))
+ ,@(apply 'append
+ (mapcar
+ 'forms--make-parser-elt
+ (append forms-format-list (list nil)))))))))
(forms--debug 'forms--parser))
((stringp el)
(prog1
(if forms--field
- (` ((setq here (point))
- (if (not (search-forward (, el) nil t nil))
- (error "Parse error: cannot find `%s'" (, el)))
- (aset forms--recordv (, (1- forms--field))
- (buffer-substring-no-properties here
- (- (point) (, (length el)))))))
- (` ((if (not (looking-at (, (regexp-quote el))))
- (error "Parse error: not looking at `%s'" (, el)))
- (forward-char (, (length el))))))
+ `((setq here (point))
+ (if (not (search-forward ,el nil t nil))
+ (error "Parse error: cannot find `%s'" ,el))
+ (aset forms--recordv ,(1- forms--field)
+ (buffer-substring-no-properties here
+ (- (point) ,(length el)))))
+ `((if (not (looking-at ,(regexp-quote el)))
+ (error "Parse error: not looking at `%s'" ,el))
+ (forward-char ,(length el))))
(setq forms--seen-text t)
(setq forms--field nil)))
((numberp el)
nil))
((null el)
(if forms--field
- (` ((aset forms--recordv (, (1- forms--field))
- (buffer-substring-no-properties (point) (point-max)))))))
+ `((aset forms--recordv ,(1- forms--field)
+ (buffer-substring-no-properties (point) (point-max))))))
((listp el)
(prog1
(if forms--field
- (` ((let ((here (point))
- (forms--dyntext (aref forms--dyntexts (, forms--dyntext))))
- (if (not (search-forward forms--dyntext nil t nil))
- (error "Parse error: cannot find `%s'" forms--dyntext))
- (aset forms--recordv (, (1- forms--field))
- (buffer-substring-no-properties here
- (- (point) (length forms--dyntext)))))))
- (` ((let ((forms--dyntext (aref forms--dyntexts (, forms--dyntext))))
- (if (not (looking-at (regexp-quote forms--dyntext)))
- (error "Parse error: not looking at `%s'" forms--dyntext))
- (forward-char (length forms--dyntext))))))
+ `((let ((here (point))
+ (forms--dyntext (aref forms--dyntexts ,forms--dyntext)))
+ (if (not (search-forward forms--dyntext nil t nil))
+ (error "Parse error: cannot find `%s'" forms--dyntext))
+ (aset forms--recordv ,(1- forms--field)
+ (buffer-substring-no-properties here
+ (- (point) (length forms--dyntext))))))
+ `((let ((forms--dyntext (aref forms--dyntexts ,forms--dyntext)))
+ (if (not (looking-at (regexp-quote forms--dyntext)))
+ (error "Parse error: not looking at `%s'" forms--dyntext))
+ (forward-char (length forms--dyntext)))))
(setq forms--dyntext (1+ forms--dyntext))
(setq forms--seen-text t)
(setq forms--field nil)))
(set-buffer-modified-p nil)
(setq buffer-read-only forms-read-only)
(setq mode-line-process
- (concat " " forms--current-record "/" forms--total-records)))
+ (concat " " (int-to-string forms--current-record)
+ "/" (int-to-string forms--total-records))))
(defun forms--parse-form ()
"Parse contents of form into list of strings."
(interactive "p")
(forms--checkmod)
(let ((write-file-filter forms-write-file-filter)
- (read-file-filter forms-read-file-filter))
+ (read-file-filter forms-read-file-filter)
+ (cur forms--current-record))
(save-excursion
(set-buffer forms--file-buffer)
(let ((inhibit-read-only t))
;; Write file hooks are run via local-write-file-hooks.
;; (if write-file-filter
;; (save-excursion
- ;; (run-hooks 'write-file-filter)))
+ ;; (run-hooks 'write-file-filter)))
+
+ ;; If they have a write-file-filter, force the buffer to be
+ ;; saved even if it doesn't seem to be changed. First, they
+ ;; might have changed the write-file-filter; and second, if
+ ;; save-buffer does nothing, write-file-filter won't get run,
+ ;; and then read-file-filter will be mightily confused.
+ (or (null write-file-filter)
+ (set-buffer-modified-p t))
(save-buffer args)
(if read-file-filter
(save-excursion
(run-hooks 'read-file-filter)))
- (set-buffer-modified-p nil))))
+ (set-buffer-modified-p nil)))
+ ;; Make sure we end up with the same record number as we started.
+ ;; Since read-file-filter may perform arbitrary transformations on
+ ;; the data buffer contents, save-excursion is not enough.
+ (forms-jump-record cur))
t)
(defun forms--revert-buffer (&optional arg noconfirm)
(interactive)
(let ((inhibit-read-only t)
(save-record forms--current-record)
+ (total-nb-records forms--total-records)
(nb-record 1)
(record nil))
(while (<= nb-record forms--total-records)
(goto-char (buffer-end 1))
(insert record)
(setq buffer-read-only nil)
- (if (< nb-record forms--total-records)
+ (if (< nb-record total-nb-records)
(insert "\n\f\n")))
(setq nb-record (1+ nb-record)))
(save-excursion
HCoop / bpt / emacs.git / blobdiff