-;;; forms.el -- Forms mode: edit a file as a form to fill in.
-;;; Copyright (C) 1991, 1993 Free Software Foundation, Inc.
+;;; forms.el --- Forms mode: edit a file as a form to fill in
-;; Author: Johan Vromans <jv@nl.net>
-;; Version: $Revision: 2.9 $
+;; Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+;; Author: Johan Vromans <jvromans@squirrel.nl>
;; This file is part of GNU Emacs.
;;; Forms mode means visiting a data file which is supposed to consist
;;; of records each containing a number of fields. The records are
;;; separated by a newline, the fields are separated by a user-defined
-;;; field separater (default: TAB).
+;;; field separator (default: TAB).
;;; When shown, a record is transferred to an Emacs buffer and
;;; presented using a user-defined form. One record is shown at a
;;; time.
;;; will be buried, for it is never accessed directly.
;;;
;;; Forms mode is invoked using M-x forms-find-file control-file .
-;;; Alternativily `forms-find-file-other-window' can be used.
+;;; 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 .
;;; If no write access to the data file is
;;; possible, view mode is enforced.
;;;
+;;; forms-check-number-of-fields [bool, default t]
+;;; If non-nil, a warning will be issued whenever
+;;; a record is found that does not have the number
+;;; of fields specified by `forms-number-of-fields'.
+;;;
;;; forms-multi-line [string, default "^K"]
;;; 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
;;; to be used for this purpose. Upon display, all
-;;; occurrencies of this character are translated
+;;; occurrences of this character are translated
;;; to newlines. Upon storage they are translated
;;; back to the separator character.
;;;
;;; modified (using text-property `read-only').
;;; Also, the read-write fields are shown using 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.
;;; The default face to show read-write fields is
;;; is left. The contents of the form are parsed using information
;;; obtained from `forms-format-list', and the fields which are
;;; deduced from the form are modified. Fields not shown on the forms
-;;; retain their origional values. The newly formed record then
+;;; retain their original values. The newly formed record then
;;; replaces the contents of the old record in `forms--file-buffer'.
;;; A parse routine `forms--parser' is built upon startup to parse
;;; the records.
;;; \C-c \C-l forms-jump-record
;;; \C-c \C-n forms-next-record
;;; \C-c \C-p forms-prev-record
-;;; \C-c \C-s forms-search
+;;; \C-c \C-r forms-search-backward
+;;; \C-c \C-s forms-search-forward
;;; \C-c \C-x forms-exit
;;;
;;; Read-only mode commands:
;;; l forms-jump-record
;;; n forms-next-record
;;; p forms-prev-record
-;;; s forms-search
+;;; r forms-search-backward
+;;; s forms-search-forward
;;; x forms-exit
;;;
;;; Of course, it is also possible to use the \C-c prefix to obtain the
(provide 'forms) ;;; official
(provide 'forms-mode) ;;; for compatibility
-(defconst forms-version (substring "$Revision: 2.9 $" 11 -2)
+(defconst forms-version (substring "$Revision: 2.23 $" 11 -2)
"The version number of forms-mode (as string). The complete RCS id is:
- $Id: forms.el,v 2.9 1994/07/26 19:47:39 rms Exp rms $")
+ $Id: forms.el,v 2.23 1995/11/16 20:04:57 jvromans Exp kwzh $")
(defvar forms-mode-hooks nil
"Hook functions to be run upon entering Forms mode.")
\f
;;; Optional variables with default values.
+(defvar forms-check-number-of-fields t
+ "*If non-nil, warn about records with wrong number of fields.")
+
(defvar forms-field-sep "\t"
"Field separator character (default TAB).")
"List of strings of the current record, as parsed from the file.")
(defvar forms--search-regexp nil
- "Last regexp used by forms-search.")
+ "Last regexp used by forms-search functions.")
(defvar forms--format nil
"Formatting routine.")
\\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-s forms-search s
+ \\C-c \\C-r forms-search-reverse r
+ \\C-c \\C-s forms-search-forward s
\\C-c \\C-x forms-exit x
"
(interactive)
(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)
+ (let ((inhibit-read-only t)
+ (file-modified (buffer-modified-p)))
+ (run-hooks 'read-file-filter)
+ (if (not file-modified) (set-buffer-modified-p nil)))
(if write-file-filter
(progn
(make-variable-buffer-local 'local-write-file-hooks)
(save-excursion
(set-buffer forms--file-buffer)
(make-variable-buffer-local 'local-write-file-hooks)
- (setq local-write-file-hooks write-file-filter)))))
+ (setq local-write-file-hooks (list write-file-filter))))))
;; count the number of records, and set see if it may be modified
(let (ro)
;; of the fields on the display. This array is used by
;; `forms--parser-using-text-properties' to extract the fields data
;; from the form on the screen.
- ;; Upon completion, `forms-format-list' is garanteed correct, so
+ ;; Upon completion, `forms-format-list' is guaranteed correct, so
;; `forms--make-format' and `forms--make-parser' do not need to perform
;; any checks.
(,@ (if (numberp (car forms-format-list))
nil
'((add-text-properties (point-min) (1+ (point-min))
- '(front-sticky (read-only))))))
+ '(front-sticky (read-only intangible))))))
;; Prevent insertion after the last text.
(remove-text-properties (1- (point)) (point)
'(rear-nonsticky)))
(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))))))
+ 'rear-nonsticky '(face read-only insert-in-front-hooks
+ intangible))))))
((numberp el)
(` ((let ((here (point)))
(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))))))
+ 'rear-nonsticky '(read-only face insert-in-front-hooks
+ intangible))))))
;; end of cond
))
(if (setq there
(next-single-property-change here 'read-only))
(aset forms--recordv (aref forms--elements i)
- (buffer-substring here there))
+ (buffer-substring-no-properties here there))
(aset forms--recordv (aref forms--elements i)
- (buffer-substring here (point-max)))))
+ (buffer-substring-no-properties here (point-max)))))
(setq i (1+ i)))))
(defun forms--make-parser-elt (el)
;; (setq here (point))
;; (if (not (search-forward "\nmore text: " nil t nil))
;; (error "Parse error: cannot find \"\\nmore text: \""))
- ;; (aset forms--recordv 5 (buffer-substring here (- (point) 12)))
+ ;; (aset forms--recordv 5 (buffer-substring-no-properties here (- (point) 12)))
;;
;; ;; (tocol 40)
;; (let ((forms--dyntext (car-safe forms--dynamic-text)))
;; (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))
;; ...
;; ;; final flush (due to terminator sentinel, see below)
- ;; (aset forms--recordv 7 (buffer-substring (point) (point-max)))
+ ;; (aset forms--recordv 7 (buffer-substring-no-properties (point) (point-max)))
(cond
((stringp el)
(if (not (search-forward (, el) nil t nil))
(error "Parse error: cannot find \"%s\"" (, el)))
(aset forms--recordv (, (1- forms--field))
- (buffer-substring here
+ (buffer-substring-no-properties here
(- (point) (, (length el)))))))
(` ((if (not (looking-at (, (regexp-quote el))))
(error "Parse error: not looking at \"%s\"" (, el)))
((null el)
(if forms--field
(` ((aset forms--recordv (, (1- forms--field))
- (buffer-substring (point) (point-max)))))))
+ (buffer-substring-no-properties (point) (point-max)))))))
((listp el)
(prog1
(if forms--field
(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 here
+ (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)))
(define-key forms-mode-map "\C-l" 'forms-jump-record)
(define-key forms-mode-map "\C-n" 'forms-next-record)
(define-key forms-mode-map "\C-p" 'forms-prev-record)
- (define-key forms-mode-map "\C-s" 'forms-search)
+ (define-key forms-mode-map "\C-r" 'forms-search-backward)
+ (define-key forms-mode-map "\C-s" 'forms-search-forward)
(define-key forms-mode-map "\C-x" 'forms-exit)
(define-key forms-mode-map "<" 'forms-first-record)
(define-key forms-mode-map ">" 'forms-last-record)
- (define-key forms-mode-map "?" 'describe-mode)
(define-key forms-mode-map "\C-?" 'forms-prev-record)
;; `forms-mode-ro-map' replaces the local map when in read-only mode.
(define-key forms-mode-ro-map "l" 'forms-jump-record)
(define-key forms-mode-ro-map "n" 'forms-next-record)
(define-key forms-mode-ro-map "p" 'forms-prev-record)
- (define-key forms-mode-ro-map "s" 'forms-search)
+ (define-key forms-mode-ro-map "r" 'forms-search-backward)
+ (define-key forms-mode-ro-map "s" 'forms-search-forward)
(define-key forms-mode-ro-map "x" 'forms-exit)
(define-key forms-mode-ro-map "<" 'forms-first-record)
(define-key forms-mode-ro-map ">" 'forms-last-record)
(define-key forms-mode-ro-map "?" 'describe-mode)
(define-key forms-mode-ro-map " " 'forms-next-record)
(forms--mode-commands1 forms-mode-ro-map)
+ (forms--mode-menu-ro forms-mode-ro-map)
;; This is the normal, local map.
(setq forms-mode-edit-map (make-keymap))
(define-key forms-mode-edit-map "\t" 'forms-next-field)
(define-key forms-mode-edit-map "\C-c" forms-mode-map)
(forms--mode-commands1 forms-mode-edit-map)
+ (forms--mode-menu-edit forms-mode-edit-map)
)
-(defun forms--mode-commands1 (map)
+(defun forms--mode-menu-ro (map)
+;;; Menu initialisation
+; (define-key map [menu-bar] (make-sparse-keymap))
+ (define-key map [menu-bar forms]
+ (cons "Forms" (make-sparse-keymap "Forms")))
+ (define-key map [menu-bar forms menu-forms-exit]
+ '("Exit" . forms-exit))
+ (define-key map [menu-bar forms menu-forms-sep1]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-save]
+ '("Save Data" . forms-save-buffer))
+ (define-key map [menu-bar forms menu-forms-print]
+ '("Print Data" . forms-print))
+ (define-key map [menu-bar forms menu-forms-describe]
+ '("Describe Mode" . describe-mode))
+ (define-key map [menu-bar forms menu-forms-toggle-ro]
+ '("Toggle View/Edit" . forms-toggle-read-only))
+ (define-key map [menu-bar forms menu-forms-jump-record]
+ '("Jump" . forms-jump-record))
+ (define-key map [menu-bar forms menu-forms-search-backward]
+ '("Search Backward" . forms-search-backward))
+ (define-key map [menu-bar forms menu-forms-search-forward]
+ '("Search Forward" . forms-search-forward))
+ (define-key map [menu-bar forms menu-forms-delete-record]
+ '("Delete" . forms-delete-record))
+ (define-key map [menu-bar forms menu-forms-insert-record]
+ '("Insert" . forms-insert-record))
+ (define-key map [menu-bar forms menu-forms-sep2]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-last-record]
+ '("Last Record" . forms-last-record))
+ (define-key map [menu-bar forms menu-forms-first-record]
+ '("First Record" . forms-first-record))
+ (define-key map [menu-bar forms menu-forms-prev-record]
+ '("Previous Record" . forms-prev-record))
+ (define-key map [menu-bar forms menu-forms-next-record]
+ '("Next Record" . forms-next-record))
+ (define-key map [menu-bar forms menu-forms-sep3]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-prev-field]
+ '("Previous Field" . forms-prev-field))
+ (define-key map [menu-bar forms menu-forms-next-field]
+ '("Next Field" . forms-next-field))
+ (put 'forms-insert-record 'menu-enable '(not forms-read-only))
+ (put 'forms-delete-record 'menu-enable '(not forms-read-only))
+)
+(defun forms--mode-menu-edit (map)
+;;; Menu initialisation
+; (define-key map [menu-bar] (make-sparse-keymap))
+ (define-key map [menu-bar forms]
+ (cons "Forms" (make-sparse-keymap "Forms")))
+ (define-key map [menu-bar forms menu-forms-edit--exit]
+ '("Exit" . forms-exit))
+ (define-key map [menu-bar forms menu-forms-edit-sep1]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-edit-save]
+ '("Save Data" . forms-save-buffer))
+ (define-key map [menu-bar forms menu-forms-edit-print]
+ '("Print Data" . forms-print))
+ (define-key map [menu-bar forms menu-forms-edit-describe]
+ '("Describe Mode" . describe-mode))
+ (define-key map [menu-bar forms menu-forms-edit-toggle-ro]
+ '("Toggle View/Edit" . forms-toggle-read-only))
+ (define-key map [menu-bar forms menu-forms-edit-jump-record]
+ '("Jump" . forms-jump-record))
+ (define-key map [menu-bar forms menu-forms-edit-search-backward]
+ '("Search Backward" . forms-search-backward))
+ (define-key map [menu-bar forms menu-forms-edit-search-forward]
+ '("Search Forward" . forms-search-forward))
+ (define-key map [menu-bar forms menu-forms-edit-delete-record]
+ '("Delete" . forms-delete-record))
+ (define-key map [menu-bar forms menu-forms-edit-insert-record]
+ '("Insert" . forms-insert-record))
+ (define-key map [menu-bar forms menu-forms-edit-sep2]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-edit-last-record]
+ '("Last Record" . forms-last-record))
+ (define-key map [menu-bar forms menu-forms-edit-first-record]
+ '("First Record" . forms-first-record))
+ (define-key map [menu-bar forms menu-forms-edit-prev-record]
+ '("Previous Record" . forms-prev-record))
+ (define-key map [menu-bar forms menu-forms-edit-next-record]
+ '("Next Record" . forms-next-record))
+ (define-key map [menu-bar forms menu-forms-edit-sep3]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-edit-prev-field]
+ '("Previous Field" . forms-prev-field))
+ (define-key map [menu-bar forms menu-forms-edit-next-field]
+ '("Next Field" . forms-next-field))
+ (put 'forms-insert-record 'menu-enable '(not forms-read-only))
+ (put 'forms-delete-record 'menu-enable '(not forms-read-only))
+)
+
+(defun forms--mode-commands1 (map)
"Helper routine to define keys."
(define-key map [TAB] 'forms-next-field)
(define-key map [S-tab] 'forms-prev-field)
(let ((here (point)))
(prog2
(end-of-line)
- (buffer-substring here (point))
+ (buffer-substring-no-properties here (point))
(goto-char here))))
(defun forms--show-record (the-record)
;; Verify the number of fields, extend forms--the-record-list if needed.
(if (= (length forms--the-record-list) forms-number-of-fields)
nil
- (beep)
- (message "Warning: this record has %d fields instead of %d"
- (length forms--the-record-list) forms-number-of-fields)
+ (if (null forms-check-number-of-fields)
+ nil
+ (beep)
+ (message "Warning: this record has %d fields instead of %d"
+ (length forms--the-record-list) forms-number-of-fields))
(if (< (length forms--the-record-list) forms-number-of-fields)
(setq forms--the-record-list
(append forms--the-record-list
(defun forms-toggle-read-only (arg)
"Toggles read-only mode of a forms mode buffer.
With an argument, enables read-only mode if the argument is positive.
-Otherwise enables edit mode if the visited file is writeable."
+Otherwise enables edit mode if the visited file is writable."
(interactive "P")
(forms-jump-record forms--current-record)))
(message ""))
-(defun forms-search (regexp)
- "Search REGEXP in file buffer."
+(defun forms-search-forward (regexp)
+ "Search forward for record containing REGEXP."
(interactive
- (list (read-string (concat "Search for"
+ (list (read-string (concat "Search forward for"
(if forms--search-regexp
(concat " ("
forms--search-regexp
(re-search-forward regexp nil t))))
(setq forms--search-regexp regexp))
+(defun forms-search-backward (regexp)
+ "Search backward for record containing REGEXP."
+ (interactive
+ (list (read-string (concat "Search backward for"
+ (if forms--search-regexp
+ (concat " ("
+ forms--search-regexp
+ ")"))
+ ": "))))
+ (if (equal "" regexp)
+ (setq regexp forms--search-regexp))
+ (forms--checkmod)
+
+ (let (the-line the-record here
+ (fld-sep forms-field-sep))
+ (if (save-excursion
+ (set-buffer forms--file-buffer)
+ (setq here (point))
+ (beginning-of-line)
+ (if (null (re-search-backward regexp nil t))
+ (progn
+ (goto-char here)
+ (message (concat "\"" regexp "\" not found."))
+ nil)
+ (setq the-record (forms--get-record))
+ (setq the-line (1+ (count-lines (point-min) (point))))))
+ (progn
+ (setq forms--current-record the-line)
+ (forms--show-record the-record)
+ (re-search-forward regexp nil t))))
+ (setq forms--search-regexp regexp))
+
(defun forms-save-buffer (&optional args)
"Forms mode replacement for save-buffer.
It saves the data buffer instead of the forms buffer.
(let ((i 0)
(here (point))
there
- (cnt 0))
+ (cnt 0)
+ (inhibit-point-motion-hooks t))
(if (zerop arg)
(setq cnt 1)
(let ((i (length forms--markers))
(here (point))
there
- (cnt 0))
+ (cnt 0)
+ (inhibit-point-motion-hooks t))
(if (zerop arg)
(setq cnt 1)
(throw 'done t))))))
nil
(goto-char (aref forms--markers (1- (length forms--markers)))))))
+
+(defun forms-print ()
+ "Send the records to the printer with 'print-buffer', one record per page."
+ (interactive)
+ (let ((inhibit-read-only t)
+ (save-record forms--current-record)
+ (nb-record 1)
+ (record nil))
+ (while (<= nb-record forms--total-records)
+ (forms-jump-record nb-record)
+ (setq record (buffer-string))
+ (save-excursion
+ (set-buffer (get-buffer-create "*forms-print*"))
+ (goto-char (buffer-end 1))
+ (insert record)
+ (setq buffer-read-only nil)
+ (if (< nb-record forms--total-records)
+ (insert "\n\f\n")))
+ (setq nb-record (1+ nb-record)))
+ (save-excursion
+ (set-buffer "*forms-print*")
+ (print-buffer)
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer)))
+ (forms-jump-record save-record)))
+
;;;
;;; Special service
;;;
(defun forms-enumerate (the-fields)
"Take a quoted list of symbols, and set their values to sequential numbers.
The first symbol gets number 1, the second 2 and so on.
-It returns the higest number.
+It returns the highest number.
Usage: (setq forms-number-of-fields
(forms-enumerate
HCoop / bpt / emacs.git / blobdiff