]> code.delx.au - gnu-emacs/blobdiff - lisp/forms.el
(texinfo-make-menu): Make region-end a marker.
[gnu-emacs] / lisp / forms.el
index ccca6d396d0de15ab5b51fca9533e17176b136c9..df683ae13639aa936ea8aedee5c27ed60b9bb0be 100644 (file)
 \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.29 $" 11 -2)
+(defconst forms-version (substring "$Revision: 2.36 $" 11 -2)
   "The version number of forms-mode (as string).  The complete RCS id is:
 
-  $Id: forms.el,v 2.29 1996/03/01 21:13:01 jvromans Exp kwzh $")
+  $Id: forms.el,v 2.36 1998/10/06 23:19:46 kwzh Exp rms $")
 
-(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.
@@ -341,7 +353,7 @@ 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.")
+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.")
@@ -354,19 +366,27 @@ This can be used to undo the effects of form-read-file-hook.")
 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.
 
@@ -426,19 +446,19 @@ Also, initial position is at last record.")
 
 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)
 
@@ -505,22 +525,22 @@ Commands:                        Equivalent keys in read-only mode:
        ;; Check if the mandatory variables make sense.
        (or forms-file
            (error (concat "Forms control file error: " 
-                          "'forms-file' has not been set")))
+                          "`forms-file' has not been set")))
 
        ;; 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")))
+                          "`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")))
+                              "`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"))))
+                            "`forms-number-of-fields' has not been set"))))
 
        (or forms-format-list
            (forms--intuit-from-file))
@@ -530,9 +550,9 @@ Commands:                        Equivalent keys in read-only mode:
                     (eq (length forms-multi-line) 1))
                (if (string= forms-multi-line forms-field-sep)
                    (error (concat "Forms control file error: " 
-                                  "'forms-multi-line' is equal to 'forms-field-sep'")))
+                                  "`forms-multi-line' is equal to 'forms-field-sep'")))
              (error (concat "Forms control file error: "
-                            "'forms-multi-line' must be nil or a one-character string"))))
+                            "`forms-multi-line' must be nil or a one-character string"))))
        (or (fboundp 'set-text-properties)
            (setq forms-use-text-properties nil))
            
@@ -556,12 +576,12 @@ Commands:                        Equivalent keys in read-only mode:
        (if (and forms-new-record-filter
                 (not (fboundp forms-new-record-filter)))
            (error (concat "Forms control file error: "
-                          "'forms-new-record-filter' is not a function")))
+                          "`forms-new-record-filter' is not a function")))
 
        (if (and forms-modified-record-filter
                 (not (fboundp forms-modified-record-filter)))
            (error (concat "Forms control file error: "
-                          "'forms-modified-record-filter' is not a function")))
+                          "`forms-modified-record-filter' is not a function")))
 
        ;; The filters acces the contents of the forms using `forms-fields'.
        (make-local-variable 'forms-fields)
@@ -569,7 +589,7 @@ Commands:                        Equivalent keys in read-only mode:
        ;; 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.
@@ -721,11 +741,11 @@ Commands:                        Equivalent keys in read-only mode:
   ;; Verify that `forms-format-list' is not nil.
   (or forms-format-list
       (error (concat "Forms control file error: "
-                    "'forms-format-list' has not been set")))
+                    "`forms-format-list' has not been set")))
   ;; It must be a list.
   (or (listp forms-format-list)
       (error (concat "Forms control file error: "
-                    "'forms-format-list' is not a list")))
+                    "`forms-format-list' is not a list")))
 
   ;; Assume every field is painted once.
   ;; `forms--elements' will grow if needed.
@@ -786,7 +806,7 @@ Commands:                        Equivalent keys in read-only mode:
          ;; Validate.
          (or (fboundp (car-safe el))
              (error (concat "Forms format error: "
-                            "not a function %S")
+                            "%S is not a function")
                     (car-safe el)))
 
          ;; Shift.
@@ -1148,12 +1168,12 @@ Commands:                        Equivalent keys in read-only mode:
        (if forms--field
            (` ((setq here (point))
                (if (not (search-forward (, el) nil t nil))
-                   (error "Parse error: cannot find \"%s\"" (, el)))
+                   (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)))
+                 (error "Parse error: not looking at `%s'" (, el)))
              (forward-char (, (length el))))))
       (setq forms--seen-text t)
       (setq forms--field nil)))
@@ -1173,13 +1193,13 @@ Commands:                        Equivalent keys in read-only mode:
            (` ((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))
+                     (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))
+                   (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)
@@ -1525,7 +1545,8 @@ Commands:                        Equivalent keys in read-only mode:
   (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."
@@ -1833,21 +1854,25 @@ after the current record."
 
   (let (the-line the-record here
                 (fld-sep forms-field-sep))
-    (if (save-excursion
-         (set-buffer forms--file-buffer)
-         (setq here (point))
-         (end-of-line)
-         (if (null (re-search-forward regexp nil t))
-             (progn
-               (goto-char here)
-               (message "\"%s\" not found" regexp)
-               nil)
+    (save-excursion
+      (set-buffer forms--file-buffer)
+      (end-of-line)
+      (setq here (point))
+      (if (or (re-search-forward regexp nil t)
+             (and (> here (point-min))
+                  (progn
+                    (goto-char (point-min))
+                    (re-search-forward regexp here t))))
+         (progn
            (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 the-line (1+ (count-lines (point-min) (point))))
+           (if (< (point) here)
+               (message "Wrapped")))
+       (goto-char here)
+       (error "Search failed: %s" regexp)))
+    (setq forms--current-record the-line)
+    (forms--show-record the-record))
+  (re-search-forward regexp nil t)
   (setq forms--search-regexp regexp))
 
 (defun forms-search-backward (regexp)
@@ -1865,21 +1890,25 @@ after the current record."
 
   (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 "\"%s\" not found" regexp)
-               nil)
+    (save-excursion
+      (set-buffer forms--file-buffer)
+      (beginning-of-line)
+      (setq here (point))
+      (if (or (re-search-backward regexp nil t)
+             (and (< (point) (point-max))
+                  (progn
+                    (goto-char (point-max))
+                    (re-search-backward regexp here t))))
+         (progn
            (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 the-line (1+ (count-lines (point-min) (point))))
+           (if (> (point) here)
+               (message "Wrapped")))
+       (goto-char here)
+       (error "Search failed: %s" regexp)))
+    (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)
@@ -1894,9 +1923,10 @@ after writing out the data."
     (save-excursion
       (set-buffer forms--file-buffer)
       (let ((inhibit-read-only t))
-      (if write-file-filter 
-         (save-excursion 
-             (run-hooks 'write-file-filter))) 
+       ;; Write file hooks are run via local-write-file-hooks.
+       ;; (if write-file-filter 
+       ;;  (save-excursion 
+       ;;   (run-hooks 'write-file-filter))) 
        (save-buffer args)
        (if read-file-filter
           (save-excursion
@@ -1972,6 +2002,7 @@ after writing out the data."
   (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)
@@ -1982,7 +2013,7 @@ after writing out the data."
        (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