Initial revision

1 files changed, 1195 insertions, 0 deletions

diff --git a/lisp/forms.el b/lisp/forms.el
new file mode 100644
index 00000000000..b0598da72f4
--- /dev/null
+++ b/lisp/forms.el
@@ -0,0 +1,1195 @@
+;;; Forms Mode - A GNU Emacs Major Mode		; @(#)@ forms	1.2.2
+;;; Created 1989 - Johan Vromans <jv@mh.nl>
+;;; See the docs for a list of other contributors.
+;;;
+;;; This file is part of GNU Emacs.
+
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY.  No author or distributor
+;;; accepts responsibility to anyone for the consequences of using it
+;;; or for whether it serves any particular purpose or works at all,
+;;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;;; License for full details.
+
+;;; Everyone is granted permission to copy, modify and redistribute
+;;; GNU Emacs, but only under the conditions described in the
+;;; GNU Emacs General Public License.   A copy of this license is
+;;; supposed to have been given to you along with GNU Emacs so you
+;;; can know your rights and responsibilities. 
+;;; If you don't have this copy, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;
+
+(provide 'forms-mode)
+
+;;; Visit a file using a form.
+;;;
+;;; === Naming conventions
+;;;
+;;; The names of all variables and functions start with 'form-'.
+;;; Names which start with 'form--' are intended for internal use, and
+;;; should *NOT* be used from the outside.
+;;;
+;;; All variables are buffer-local, to enable multiple forms visits 
+;;; simultaneously.
+;;; Variable 'forms--mode-setup' is local to *ALL* buffers, for it 
+;;; controls if forms-mode has been enabled in a buffer.
+;;;
+;;; === How it works ===
+;;;
+;;; 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).
+;;; When shown, a record is transferred to an emacs buffer and
+;;; presented using a user-defined form. One record is shown at a
+;;; time.
+;;;
+;;; Forms mode is a composite mode. It involves two files, and two
+;;; buffers.
+;;; The first file, called the control file, defines the name of the
+;;; data file and the forms format. This file buffer will be used to
+;;; present the forms.
+;;; 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 "forms-find-file control-file".
+;;; Alternativily 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 .
+;;;
+;;; Automatic mode switching is supported, so you may use "find-file"
+;;; if you specify "-*- forms -*-" in the first line of the control file.
+;;; 
+;;; The control file is visited, evaluated using
+;;; eval-current-buffer, and should set at least the following
+;;; variables:
+;;;
+;;;	forms-file		    [string] the name of the data file.
+;;;
+;;;	forms-number-of-fields	    [integer]
+;;;			The number of fields in each record.
+;;;
+;;;	forms-format-list           [list]   formatting instructions.
+;;;
+;;; The forms-format-list should be a list, each element containing
+;;;
+;;;  - either a string, e.g. "hello" (which is inserted \"as is\"),
+;;;
+;;;  - an integer, denoting a field number. The contents of the field
+;;;    are inserted at this point.
+;;;    The first field has number one.
+;;;
+;;; Optional variables which may be set in the control file:
+;;;
+;;;	forms-field-sep				[string, default TAB]
+;;;			The field separator used to separate the
+;;;			fields in the data file. It may be a string.
+;;;
+;;;	forms-read-only				[bool, default nil]
+;;;			't' means that the data file is visited read-only.
+;;;			If no write access to the data file is
+;;;			possible, read-only mode is enforced. 
+;;;
+;;;	forms-multi-line			[string, default "^K"]
+;;;			If non-null the records of the data file may
+;;;			contain fields which span multiple lines in
+;;;			the form.
+;;;			This variable denoted the separator character
+;;;			to be used for this purpose. Upon display, all
+;;;			occurrencies of this character are translated
+;;;			to newlines. Upon storage they are translated
+;;;			back to the separator.
+;;;
+;;;	forms-forms-scroll			[bool, default t]
+;;;			If non-nil: redefine scroll-up/down to perform
+;;;			forms-next/prev-field if in forms mode.
+;;;
+;;;	forms-forms-jump			[bool, default t]
+;;;			If non-nil: redefine beginning/end-of-buffer
+;;;			to performs forms-first/last-field if in
+;;;			forms mode.
+;;;
+;;;	forms-new-record-filter			[function, no default]
+;;;			If defined: this function is called when a new
+;;;			record is created. It can be used to fill in
+;;;			the new record with default fields, for example.
+;;;
+;;; 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.
+;;; Great malfunctioning may be expected if this file/buffer is modified
+;;; outside of this package while it's being visited!
+;;;
+;;; A record from the data file is transferred from the data file,
+;;; split into fields (into forms--the-record-list), and displayed using
+;;; the specs in forms-format-list.
+;;; A format routine 'forms--format' is build upon startup to format 
+;;; the records.
+;;;
+;;; When a form is changed the record is updated as soon as this form
+;;; is left. The contents of the form are parsed using forms-format-list,
+;;; and the fields which are deduced from the form are modified. So,
+;;; fields not shown on the forms retain their origional values.
+;;; The newly formed record and replaces the contents of the
+;;; old record in forms--file-buffer.
+;;; A parse routine 'forms--parser' is build upon startup to parse
+;;; the records.
+;;;
+;;; Two exit functions exist: forms-exit (which saves) and forms-exit-no-save
+;;; (which doesn't). However, if forms-exit-no-save is executed and the file
+;;; buffer has been modified, emacs will ask questions.
+;;;
+;;; Other functions are:
+;;;
+;;;	paging (forward, backward) by record
+;;;	jumping (first, last, random number)
+;;;	searching
+;;;	creating and deleting records
+;;;	reverting the form (NOT the file buffer)
+;;;	switching edit <-> view mode v.v.
+;;;	jumping from field to field
+;;;
+;;; As an documented side-effect: jumping to the last record in the
+;;; file (using forms-last-record) will adjust forms--total-records if
+;;; needed.
+;;;
+;;; Commands and keymaps:
+;;;
+;;; A local keymap 'forms-mode-map' is used in the forms buffer.
+;;; As conventional, this map can be accessed with C-c prefix.
+;;; In read-only mode, the C-c prefix must be omitted.
+;;;
+;;; Default bindings:
+;;;
+;;;	\C-c	forms-mode-map
+;;;	TAB	forms-next-field
+;;;	SPC 	forms-next-record
+;;;	<	forms-first-record
+;;;	>	forms-last-record
+;;;	?	describe-mode
+;;;	d	forms-delete-record
+;;;	e	forms-edit-mode
+;;;	i	forms-insert-record
+;;;	j	forms-jump-record
+;;;	n	forms-next-record
+;;;	p	forms-prev-record
+;;;	q	forms-exit
+;;;	s	forms-search
+;;;	v	forms-view-mode
+;;;	x	forms-exit-no-save
+;;;	DEL	forms-prev-record
+;;;
+;;; Standard functions scroll-up, scroll-down, beginning-of-buffer and
+;;; end-of-buffer are wrapped with re-definitions, which map them to
+;;; next/prev record and first/last record.
+;;; Buffer-local variables forms-forms-scroll and forms-forms-jump
+;;; may be used to control these redefinitions.
+;;;
+;;; Function save-buffer is also wrapped to perform a sensible action.
+;;; A revert-file-hook is defined to revert a forms to original.
+;;;
+;;; For convenience, TAB is always bound to forms-next-field, so you
+;;; don't need the C-c prefix for this command.
+;;;
+;;; Global variables and constants
+
+(defconst forms-version "1.2.2"
+  "Version of forms-mode implementation")
+
+(defvar forms-forms-scrolls t
+  "If non-null: redefine scroll-up/down to be used with forms-mode.")
+
+(defvar forms-forms-jumps t
+  "If non-null: redefine beginning/end-of-buffer to be used with forms-mode.")
+
+(defvar forms-mode-hooks nil
+  "Hook functions to be run upon entering forms mode.")
+;;;
+;;; Mandatory variables - must be set by evaluating the control file
+
+(defvar forms-file nil
+   "Name of the file holding the data.")
+
+(defvar forms-format-list nil
+  "Formatting specifications:
+
+It should be a list, each element containing 
+
+ - either a string, e.g. "hello" (which is inserted \"as is\"),
+
+ - an integer, denoting the number of a field which contents are
+   inserted at this point.
+   The first field has number one.
+")
+
+(defvar forms-number-of-fields nil
+  "Number of fields per record.")
+
+;;;
+;;; Optional variables with default values
+
+(defvar forms-field-sep "\t"
+  "Field separator character (default TAB)")
+
+(defvar forms-read-only nil
+  "Read-only mode (defaults to the write access on the data file).")
+
+(defvar forms-multi-line "\C-k"
+  "Character to separate multi-line fields (default ^K)")
+
+(defvar forms-forms-scroll t
+  "Redefine scroll-up/down to perform forms-next/prev-record when in
+ forms mode.")
+
+(defvar forms-forms-jump t
+  "Redefine beginning/end-of-buffer to perform forms-first/last-record
+ when in forms mode.")
+
+;;;
+;;; Internal variables.
+
+(defvar forms--file-buffer nil
+  "Buffer which holds the file data")
+
+(defvar forms--total-records 0
+  "Total number of records in the data file.")
+
+(defvar forms--current-record 0
+  "Number of the record currently on the screen.")
+
+(defvar forms-mode-map nil		; yes - this one is global
+   "Keymap for form buffer.")
+
+(defvar forms--markers nil
+  "Field markers in the screen.")
+
+(defvar forms--number-of-markers 0
+  "Number of fields on screen.")
+
+(defvar forms--the-record-list nil 
+   "List of strings of the current record, as parsed from the file.")
+
+(defvar forms--search-regexp nil
+  "Last regexp used by forms-search.")
+
+(defvar forms--format nil
+  "Formatting routine.")
+
+(defvar forms--parser nil
+  "Forms parser routine.")
+
+(defvar forms--mode-setup nil
+  "Internal - keeps track of forms-mode being set-up.")
+(make-variable-buffer-local 'forms--mode-setup)
+
+(defvar forms--new-record-filter nil
+  "Internal - set if a new record filter has been defined.")
+
+;;;
+;;; forms-mode
+;;;
+;;; This is not a simple major mode, as usual. Therefore, forms-mode
+;;; takes an optional argument 'primary' which is used for the initial
+;;; set-up. Normal use would leave 'primary' to nil.
+;;;
+;;; A global buffer-local variable 'forms--mode-setup' has the same effect
+;;; but makes it possible to auto-invoke forms-mode using find-file.
+;;;
+;;; Note: although it seems logical to have (make-local-variable) executed
+;;; where the variable is first needed, I deliberately placed all calls
+;;; in the forms-mode function.
+ 
+(defun forms-mode (&optional primary)
+  "Major mode to visit files in a field-structured manner using a form.
+
+ Commands (prefix with C-c if not in read-only mode):
+ \\{forms-mode-map}"
+
+  (interactive)				; no - 'primary' is not prefix arg
+
+  ;; Primary set-up: evaluate buffer and check if the mandatory
+  ;; variables have been set.
+  (if (or primary (not forms--mode-setup))
+      (progn
+	(kill-all-local-variables)
+
+	;; make mandatory variables
+	(make-local-variable 'forms-file)
+	(make-local-variable 'forms-number-of-fields)
+	(make-local-variable 'forms-format-list)
+
+	;; make optional variables
+	(make-local-variable 'forms-field-sep)
+        (make-local-variable 'forms-read-only)
+        (make-local-variable 'forms-multi-line)
+	(make-local-variable 'forms-forms-scroll)
+	(make-local-variable 'forms-forms-jump)
+	(fmakunbound 'forms-new-record-filter)
+
+	;; eval the buffer, should set variables
+	(eval-current-buffer)
+
+	;; check if the mandatory variables make sense.
+	(or forms-file
+	    (error "'forms-file' has not been set"))
+	(or forms-number-of-fields
+	    (error "'forms-number-of-fields' has not been set"))
+	(or (> forms-number-of-fields 0)
+	    (error "'forms-number-of-fields' must be > 0")
+	(or (stringp forms-field-sep))
+	    (error "'forms-field-sep' is not a string"))
+	(if forms-multi-line
+	    (if (and (stringp forms-multi-line)
+		     (eq (length forms-multi-line) 1))
+		(if (string= forms-multi-line forms-field-sep)
+		    (error "'forms-multi-line' is equal to 'forms-field-sep'"))
+	      (error "'forms-multi-line' must be nil or a one-character string")))
+	    
+	;; validate and process forms-format-list
+	(make-local-variable 'forms--number-of-markers)
+	(make-local-variable 'forms--markers)
+	(forms--process-format-list)
+
+	;; build the formatter and parser
+	(make-local-variable 'forms--format)
+	(forms--make-format)
+	(make-local-variable 'forms--parser)
+	(forms--make-parser)
+
+	;; check if a new record filter was defined
+	(make-local-variable 'forms--new-record-filter)
+	(setq forms--new-record-filter 
+	      (and (fboundp 'forms-new-record-filter)
+		   (symbol-function 'forms-new-record-filter)))
+	(fmakunbound 'forms-new-record-filter)
+
+
+	;; prepare this buffer for further processing
+	(setq buffer-read-only nil)
+
+	;; prevent accidental overwrite of the control file and autosave
+	(setq buffer-file-name nil)
+	(auto-save-mode nil)
+
+	;; and clean it
+	(erase-buffer)))
+
+  ;; make local variables
+  (make-local-variable 'forms--file-buffer)
+  (make-local-variable 'forms--total-records)
+  (make-local-variable 'forms--current-record)
+  (make-local-variable 'forms--the-record-list)
+  (make-local-variable 'forms--search-rexexp)
+
+  ;; A bug in the current Emacs release prevents a keymap
+  ;; which is buffer-local from being used by 'describe-mode'.
+  ;; Hence we'll leave it global.
+  ;;(make-local-variable 'forms-mode-map)
+  (if forms-mode-map			; already defined
+      nil
+    (setq forms-mode-map (make-keymap))
+    (forms--mode-commands forms-mode-map)
+    (forms--change-commands))
+
+  ;; find the data file
+  (setq forms--file-buffer (find-file-noselect forms-file))
+
+  ;; count the number of records, and set see if it may be modified
+  (let (ro)
+    (setq forms--total-records
+	  (save-excursion
+	    (set-buffer forms--file-buffer)
+	    (bury-buffer (current-buffer))
+	    (setq ro buffer-read-only)
+	    (count-lines (point-min) (point-max))))
+    (if ro
+	(setq forms-read-only t)))
+
+  ;; set the major mode indicator
+  (setq major-mode 'forms-mode)
+  (setq mode-name "Forms")
+  (make-local-variable 'minor-mode-alist) ; needed?
+  (forms--set-minor-mode)
+  (forms--set-keymaps)
+
+  (set-buffer-modified-p nil)
+
+  ;; We have our own revert function - use it
+  (make-local-variable 'revert-buffer-function)
+  (setq revert-buffer-function 'forms-revert-buffer)
+
+  ;; setup the first (or current) record to show
+  (if (< forms--current-record 1)
+      (setq forms--current-record 1))
+  (forms-jump-record forms--current-record)
+
+  ;; user customising
+  (run-hooks 'forms-mode-hooks)
+
+  ;; be helpful
+  (forms--help)
+
+  ;; initialization done
+  (setq forms--mode-setup t))
+
+;;;
+;;; forms-process-format-list
+;;;
+;;; Validates forms-format-list.
+;;;
+;;; Sets forms--number-of-markers and forms--markers.
+
+(defun forms--process-format-list ()
+  "Validate forms-format-list and set some global variables."
+
+  ;; it must be non-nil
+  (or forms-format-list
+      (error "'forms-format-list' has not been set"))
+  ;; it must be a list ...
+  (or (listp forms-format-list)
+      (error "'forms-format-list' is not a list"))
+
+  (setq forms--number-of-markers 0)
+
+  (let ((the-list forms-format-list)	; the list of format elements
+	(field-num 0))			; highest field number 
+
+    (while the-list
+
+      (let ((el (car-safe the-list))
+	    (rem (cdr-safe the-list)))
+
+	(cond
+
+	 ;; try string ...
+	 ((stringp el))			; string is OK
+	  
+	 ;; try int ...
+	 ((numberp el)			; check it
+
+	  (if (or (<= el 0)
+		  (> el forms-number-of-fields))
+	      (error
+	       "forms error: field number %d out of range 1..%d"
+	       el forms-number-of-fields))
+
+	  (setq forms--number-of-markers (1+ forms--number-of-markers))
+	  (if (> el field-num)
+	      (setq field-num el)))
+
+	 ;; else
+	 (t
+	  (error "invalid element in 'forms-format-list': %s"
+		 (prin1-to-string el)))
+
+	 ;; dead code - we'll need it in the future
+	 ((consp el)			; check it
+
+	  (let ((str (car-safe el))
+		(idx (cdr-safe el)))
+
+	    (cond
+
+	     ;; car must be string
+	     ((not (stringp str))
+	      (error "forms error: car of cons %s must be string"
+		     (prin1-to-string el)))
+
+	     ;; cdr must be number, > zero
+	     ((or (not (numberp idx))
+		  (<= idx 0)
+		  (> idx forms-number-of-fields))
+	      (error
+	       "forms error: cdr of cons %s must be a number between 1 and %d"
+	       (prin1-to-string el)
+	       forms-number-of-fields)))
+
+	    ;; passed the test - handle it
+	    (setq forms--number-of-markers (1+ forms--number-of-markers))
+	    (if (> idx field-num)
+		(setq field-num idx)))))
+
+	;; advance to next element of the list
+	(setq the-list rem))))
+
+  (setq forms--markers (make-vector forms--number-of-markers nil)))
+
+
+;;;
+;;; Build the format routine from forms-format-list.
+;;;
+;;; The format routine (forms--format) will look like
+;;; 
+;;; (lambda (arg)
+;;;
+;;;   ;;  "text: "
+;;;   (insert "text: ")
+;;;   ;;  6
+;;;   (aset forms--markers 0 (point-marker))
+;;;   (insert (elt arg 5))
+;;;   ;;  "\nmore text: "
+;;;   (insert "\nmore text: ")
+;;;   ;;  9
+;;;   (aset forms--markers 1 (point-marker))
+;;;   (insert (elt arg 8))
+;;;
+;;;   ... )
+;;; 
+
+(defun forms--make-format ()
+  "Generate parser function for forms"
+  (setq forms--format (forms--format-maker forms-format-list)))
+
+(defun forms--format-maker (the-format-list)
+  "Returns the parser function for forms"
+  (let ((the-marker 0))
+    (` (lambda (arg)
+	 (,@ (apply 'append
+		    (mapcar 'forms--make-format-elt 
+			    (forms--concat-adjacent the-format-list))))))))
+
+(defun forms--make-format-elt (el)
+  (cond ((stringp el)
+	 (` ((insert (, el)))))
+	((numberp el)
+	 (prog1
+	     (` ((aset forms--markers (, the-marker) (point-marker))
+		 (insert (elt arg (, (1- el))))))
+	   (setq the-marker (1+ the-marker))))))
+
+
+(defun forms--concat-adjacent (the-list)
+  "Concatenate adjacent strings in the-list and return the resulting list"
+  (if (consp the-list)
+      (let ((the-rest (forms--concat-adjacent (cdr the-list))))
+	(if (and (stringp (car the-list)) (stringp (car the-rest)))
+	    (cons (concat (car the-list) (car the-rest))
+		  (cdr the-rest))
+	    (cons (car the-list) the-rest)))
+      the-list))
+;;;
+;;; forms--make-parser.
+;;;
+;;; Generate parse routine from forms-format-list.
+;;;
+;;; The parse routine (forms--parser) will look like (give or take
+;;; a few " " .
+;;; 
+;;; (lambda nil
+;;;   (let (here)
+;;;     (goto-char (point-min))
+;;; 
+;;;	;;  "text: "
+;;;     (if (not (looking-at "text: "))
+;;; 	    (error "parse error: cannot find \"text: \""))
+;;;     (forward-char 6)	; past "text: "
+;;; 
+;;;     ;;  6
+;;;	;;  "\nmore text: "
+;;;     (setq here (point))
+;;;     (if (not (search-forward "\nmore text: " nil t nil))
+;;; 	    (error "parse error: cannot find \"\\nmore text: \""))
+;;;     (aset the-recordv 5 (buffer-substring here (- (point) 12)))
+;;;     ...
+;;;     ... 
+;;;     ;; final flush (due to terminator sentinel, see below)
+;;;	(aset the-recordv 7 (buffer-substring (point) (point-max)))
+;;; 
+
+(defun forms--make-parser ()
+  "Generate parser function for forms"
+  (setq forms--parser (forms--parser-maker forms-format-list)))
+
+(defun forms--parser-maker (the-format-list)
+  "Returns the parser function for forms"
+  (let ((the-field nil)
+	(seen-text nil)
+	the--format-list)
+    ;; concat adjacent strings and add a terminator sentinel
+    (setq the--format-list 
+	  (append (forms--concat-adjacent the-format-list) (list nil)))
+    (` (lambda nil
+	 (let (here)
+	   (goto-char (point-min))
+	 (,@ (apply 'append
+		    (mapcar 'forms--make-parser-elt the--format-list))))))))
+
+(defun forms--make-parser-elt (el)
+  (cond ((stringp el)
+	 (prog1
+	     (if the-field
+		 (` ((setq here (point))
+		     (if (not (search-forward (, el) nil t nil))
+			 (error "Parse error: cannot find %s" (, el)))
+		     (aset the-recordv (, (1- the-field))
+			   (buffer-substring here
+					     (- (point) (, (length el)))))))
+		 (` ((if (not (looking-at (, (regexp-quote el))))
+			 (error "Parse error: not looking at %s" (, el)))
+		     (forward-char (, (length el))))))
+	   (setq seen-text t)
+	   (setq the-field nil)))
+	((numberp el)
+	 (if the-field
+	     (error "Cannot parse adjacent fields %d and %d"
+		    the-field el)
+	     (setq the-field el)
+	     nil))
+	((null el)
+	 (if the-field
+	     (` ((aset the-recordv (, (1- the-field))
+		       (buffer-substring (point) (point-max)))))))))
+;;;
+
+(defun forms--set-minor-mode ()
+  (setq minor-mode-alist
+	(if forms-read-only
+	    " View"
+	  nil)))
+
+(defun forms--set-keymaps ()
+  "Set the keymaps used in this mode."
+
+  (if forms-read-only
+      (use-local-map forms-mode-map)
+    (use-local-map (make-sparse-keymap))
+    (define-key (current-local-map) "\C-c" forms-mode-map)
+    (define-key (current-local-map) "\t"   'forms-next-field)))
+
+(defun forms--mode-commands (map)
+  "Fill map with all commands."
+  (define-key map "\t" 'forms-next-field)
+  (define-key map " " 'forms-next-record)
+  (define-key map "d" 'forms-delete-record)
+  (define-key map "e" 'forms-edit-mode)
+  (define-key map "i" 'forms-insert-record)
+  (define-key map "j" 'forms-jump-record)
+  (define-key map "n" 'forms-next-record)
+  (define-key map "p" 'forms-prev-record)
+  (define-key map "q" 'forms-exit)
+  (define-key map "s" 'forms-search)
+  (define-key map "v" 'forms-view-mode)
+  (define-key map "x" 'forms-exit-no-save)
+  (define-key map "<" 'forms-first-record)
+  (define-key map ">" 'forms-last-record)
+  (define-key map "?" 'describe-mode)
+  (define-key map "\177" 'forms-prev-record)
+ ;  (define-key map "\C-c" map)
+  (define-key map "\e" 'ESC-prefix)
+  (define-key map "\C-x" ctl-x-map)
+  (define-key map "\C-u" 'universal-argument)
+  (define-key map "\C-h" help-map)
+  )
+;;;
+;;; Changed functions
+;;;
+;;; Emacs (as of 18.55) lacks the functionality of buffer-local
+;;; funtions. Therefore we save the original meaning of some handy
+;;; functions, and replace them with a wrapper.
+
+(defun forms--change-commands ()
+  "Localize some commands."
+  ;;
+  ;; scroll-down -> forms-prev-record
+  ;;
+  (if (fboundp 'forms--scroll-down)
+      nil
+    (fset 'forms--scroll-down (symbol-function 'scroll-down))
+    (fset 'scroll-down
+	  '(lambda (arg) 
+	     (interactive "P")
+	     (if (and forms--mode-setup
+		      forms-forms-scroll)
+		 (forms-prev-record arg)
+	       (forms--scroll-down arg)))))
+  ;;
+  ;; scroll-up -> forms-next-record
+  ;;
+  (if (fboundp 'forms--scroll-up)
+      nil
+    (fset 'forms--scroll-up   (symbol-function 'scroll-up))
+    (fset 'scroll-up
+	  '(lambda (arg) 
+	     (interactive "P")
+	     (if (and forms--mode-setup
+		      forms-forms-scroll)
+		 (forms-next-record arg)
+	       (forms--scroll-up arg)))))
+  ;;
+  ;; beginning-of-buffer -> forms-first-record
+  ;;
+  (if (fboundp 'forms--beginning-of-buffer)
+      nil
+    (fset 'forms--beginning-of-buffer (symbol-function 'beginning-of-buffer))
+    (fset 'beginning-of-buffer
+	  '(lambda ()
+	     (interactive)
+	     (if (and forms--mode-setup
+		      forms-forms-jump)
+		 (forms-first-record)
+	       (forms--beginning-of-buffer)))))
+  ;;
+  ;; end-of-buffer -> forms-end-record
+  ;;
+  (if (fboundp 'forms--end-of-buffer)
+      nil
+    (fset 'forms--end-of-buffer (symbol-function 'end-of-buffer))
+    (fset 'end-of-buffer
+	  '(lambda ()
+	     (interactive)
+	     (if (and forms--mode-setup
+		      forms-forms-jump)
+		 (forms-last-record)
+	       (forms--end-of-buffer)))))
+  ;;
+  ;; save-buffer -> forms--save-buffer
+  ;;
+  (if (fboundp 'forms--save-buffer)
+      nil
+    (fset 'forms--save-buffer (symbol-function 'save-buffer))
+    (fset 'save-buffer
+	  '(lambda (&optional arg)
+	     (interactive "p")
+	     (if forms--mode-setup
+		 (progn
+		   (forms--checkmod)
+		   (save-excursion
+		     (set-buffer forms--file-buffer)
+		     (forms--save-buffer arg)))
+	       (forms--save-buffer arg)))))
+  ;;
+  )
+
+(defun forms--help ()
+  "Initial help."
+  ;; We should use
+  ;;(message (substitute-command-keys (concat
+  ;;"\\[forms-next-record]:next"
+  ;;"   \\[forms-prev-record]:prev"
+  ;;"   \\[forms-first-record]:first"
+  ;;"   \\[forms-last-record]:last"
+  ;;"   \\[describe-mode]:help"
+  ;;"   \\[forms-exit]:exit")))
+  ;; but it's too slow ....
+  (if forms-read-only
+      (message "SPC:next   DEL:prev   <:first   >:last   ?:help   q:exit")
+    (message "C-c n:next   C-c p:prev   C-c <:first   C-c >:last   C-c ?:help   C-c q:exit")))
+
+(defun forms--trans (subj arg rep)
+  "Translate in SUBJ all chars ARG into char REP. ARG and REP should
+ be single-char strings."
+  (let ((i 0)
+	(x (length subj))
+	(re (regexp-quote arg))
+	(k (string-to-char rep)))
+    (while (setq i (string-match re subj i))
+      (aset subj i k)
+      (setq i (1+ i)))))
+
+(defun forms--exit (query &optional save)
+  (let ((buf (buffer-name forms--file-buffer)))
+    (forms--checkmod)
+    (if (and save
+	     (buffer-modified-p forms--file-buffer))
+	(save-excursion
+	  (set-buffer forms--file-buffer)
+	  (save-buffer)))
+    (save-excursion
+      (set-buffer forms--file-buffer)
+      (delete-auto-save-file-if-necessary)
+      (kill-buffer (current-buffer)))
+    (if (get-buffer buf)	; not killed???
+      (if save
+	  (progn
+	    (beep)
+	    (message "Problem saving buffers?")))
+      (delete-auto-save-file-if-necessary)
+      (kill-buffer (current-buffer)))))
+
+(defun forms--get-record ()
+  "Fetch the current record from the file buffer."
+  ;;
+  ;; This function is executed in the context of the forms--file-buffer.
+  ;;
+  (or (bolp)
+      (beginning-of-line nil))
+  (let ((here (point)))
+    (prog2
+     (end-of-line)
+     (buffer-substring here (point))
+     (goto-char here))))
+
+(defun forms--show-record (the-record)
+  "Format THE-RECORD according to forms-format-list,
+ and display it in the current buffer."
+
+  ;; split the-record
+  (let (the-result
+	(start-pos 0)
+	found-pos
+	(field-sep-length (length forms-field-sep)))
+    (if forms-multi-line
+	(forms--trans the-record forms-multi-line "\n"))
+    ;; add an extra separator (makes splitting easy)
+    (setq the-record (concat the-record forms-field-sep))
+    (while (setq found-pos (string-match forms-field-sep the-record start-pos))
+      (let ((ent (substring the-record start-pos found-pos)))
+	(setq the-result
+	      (append the-result (list ent)))
+	(setq start-pos (+ field-sep-length found-pos))))
+    (setq forms--the-record-list the-result))
+
+  (setq buffer-read-only nil)
+  (erase-buffer)
+
+  ;; 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 "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
+		      (make-list 
+		       (- forms-number-of-fields 
+			  (length forms--the-record-list))
+		       "")))))
+
+  ;; call the formatter function
+  (funcall forms--format forms--the-record-list)
+
+  ;; prepare
+  (goto-char (point-min))
+  (set-buffer-modified-p nil)
+  (setq buffer-read-only forms-read-only)
+  (setq mode-line-process
+	(concat " " forms--current-record "/" forms--total-records)))
+
+(defun forms--parse-form ()
+  "Parse contents of form into list of strings."
+  ;; The contents of the form are parsed, and a new list of strings
+  ;; is constructed.
+  ;; A vector with the strings from the original record is 
+  ;; constructed, which is updated with the new contents. Therefore
+  ;; fields which were not in the form are not modified.
+  ;; Finally, the vector is transformed into a list for further processing.
+
+  (let (the-recordv)
+
+    ;; build the vector
+    (setq the-recordv (vconcat forms--the-record-list))
+
+    ;; parse the form and update the vector
+    (funcall forms--parser)
+
+    ;; transform to a list and return
+    (append the-recordv nil)))
+
+(defun forms--update ()
+  "Update current record with contents of form. As a side effect: sets
+forms--the-record-list ."
+  (if forms-read-only
+      (progn
+	(message "Read-only buffer!")
+	(beep))
+
+    (let (the-record)
+      ;; build new record
+      (setq forms--the-record-list (forms--parse-form))
+      (setq the-record
+	    (mapconcat 'identity forms--the-record-list forms-field-sep))
+
+      ;; handle multi-line fields, if allowed
+      (if forms-multi-line
+	  (forms--trans the-record "\n" forms-multi-line))
+
+      ;; a final sanity check before updating
+      (if (string-match "\n" the-record)
+	  (progn
+	    (message "Multi-line fields in this record - update refused!")
+	    (beep))
+
+	(save-excursion
+	  (set-buffer forms--file-buffer)
+	  ;; Insert something before kill-line is called. See kill-line
+	  ;; doc. Bugfix provided by Ignatios Souvatzis.
+	  (insert "*")
+	  (beginning-of-line)
+	  (kill-line nil)
+	  (insert the-record)
+	  (beginning-of-line))))))
+
+(defun forms--checkmod ()
+  "Check if this form has been modified, and call forms--update if so."
+  (if (buffer-modified-p nil)
+      (let ((here (point)))
+	(forms--update)
+	(set-buffer-modified-p nil)
+	(goto-char here))))
+
+;;;
+;;; Start and exit
+(defun forms-find-file (fn)
+  "Visit file FN in forms mode"
+  (interactive "fForms file: ")
+  (find-file-read-only fn)
+  (or forms--mode-setup (forms-mode t)))
+
+(defun forms-find-file-other-window (fn)
+  "Visit file FN in form mode in other window"
+  (interactive "fFbrowse file in other window: ")
+  (find-file-other-window fn)
+  (eval-current-buffer)
+  (or forms--mode-setup (forms-mode t)))
+
+(defun forms-exit (query)
+  "Normal exit. Modified buffers are saved."
+  (interactive "P")
+  (forms--exit query t))
+
+(defun forms-exit-no-save (query)
+  "Exit without saving buffers."
+  (interactive "P")
+  (forms--exit query nil))
+
+;;;
+;;; Navigating commands
+
+(defun forms-next-record (arg)
+  "Advance to the ARGth following record."
+  (interactive "P")
+  (forms-jump-record (+ forms--current-record (prefix-numeric-value arg)) t))
+
+(defun forms-prev-record (arg)
+  "Advance to the ARGth previous record."
+  (interactive "P")
+  (forms-jump-record (- forms--current-record (prefix-numeric-value arg)) t))
+
+(defun forms-jump-record (arg &optional relative)
+  "Jump to a random record."
+  (interactive "NRecord number: ")
+
+  ;; verify that the record number is within range
+  (if (or (> arg forms--total-records)
+	  (<= arg 0))
+    (progn
+      (beep)
+      ;; don't give the message if just paging
+      (if (not relative)
+	  (message "Record number %d out of range 1..%d"
+		   arg forms--total-records))
+      )
+
+    ;; flush
+    (forms--checkmod)
+
+    ;; calculate displacement
+    (let ((disp (- arg forms--current-record))
+	  (cur forms--current-record))
+
+      ;; forms--show-record needs it now
+      (setq forms--current-record arg)
+
+      ;; get the record and show it
+      (forms--show-record
+       (save-excursion
+	 (set-buffer forms--file-buffer)
+	 (beginning-of-line)
+
+	 ;; move, and adjust the amount if needed (shouldn't happen)
+	 (if relative
+	     (if (zerop disp)
+		 nil
+	       (setq cur (+ cur disp (- (forward-line disp)))))
+	   (setq cur (+ cur disp (- (goto-line arg)))))
+
+	 (forms--get-record)))
+
+      ;; this shouldn't happen
+      (if (/= forms--current-record cur)
+	  (progn
+	    (setq forms--current-record cur)
+	    (beep)
+	    (message "Stuck at record %d." cur))))))
+
+(defun forms-first-record ()
+  "Jump to first record."
+  (interactive)
+  (forms-jump-record 1))
+
+(defun forms-last-record ()
+  "Jump to last record. As a side effect: re-calculates the number
+ of records in the data file."
+  (interactive)
+  (let
+      ((numrec 
+	(save-excursion
+	  (set-buffer forms--file-buffer)
+	  (count-lines (point-min) (point-max)))))
+    (if (= numrec forms--total-records)
+	nil
+      (beep)
+      (setq forms--total-records numrec)
+      (message "Number of records reset to %d." forms--total-records)))
+  (forms-jump-record forms--total-records))
+
+;;;
+;;; Other commands
+(defun forms-view-mode ()
+  "Visit buffer read-only."
+  (interactive)
+  (if forms-read-only
+      nil
+    (forms--checkmod)			; sync
+    (setq forms-read-only t)
+    (forms-mode)))
+
+(defun forms-edit-mode ()
+  "Make form suitable for editing, if possible."
+  (interactive)
+  (let ((ro forms-read-only))
+    (if (save-excursion
+	  (set-buffer forms--file-buffer)
+	  buffer-read-only)
+	(progn
+	  (setq forms-read-only t)
+	  (message "No write access to \"%s\"" forms-file)
+	  (beep))
+      (setq forms-read-only nil))
+    (if (equal ro forms-read-only)
+	nil
+      (forms-mode))))
+
+;; Sample:
+;; (defun forms-new-record-filter (the-fields)
+;;   ;; numbers are relative to 1
+;;   (aset the-fields 4 (current-time-string))
+;;   (aset the-fields 6 (user-login-name))
+;;   the-list)
+
+(defun forms-insert-record (arg)
+  "Create a new record before the current one. With ARG: store the
+ record after the current one.
+ If a function forms-new-record-filter is defined, is is called to
+ fill (some of) the fields with default values."
+ ; The above doc is not true, but for documentary purposes only
+
+  (interactive "P")
+
+  (let ((ln (if arg (1+ forms--current-record) forms--current-record))
+        the-list the-record)
+
+    (forms--checkmod)
+    (if forms--new-record-filter
+	;; As a service to the user, we add a zeroth element so she
+	;; can use the same indices as in the forms definition.
+	(let ((the-fields (make-vector (1+ forms-number-of-fields) "")))
+	  (setq the-fields (funcall forms--new-record-filter the-fields))
+	  (setq the-list (cdr (append the-fields nil))))
+      (setq the-list (make-list forms-number-of-fields "")))
+
+    (setq the-record
+	  (mapconcat
+	  'identity
+	  the-list
+	  forms-field-sep))
+
+    (save-excursion
+      (set-buffer forms--file-buffer)
+      (goto-line ln)
+      (open-line 1)
+      (insert the-record)
+      (beginning-of-line))
+    
+    (setq forms--current-record ln))
+
+  (setq forms--total-records (1+ forms--total-records))
+  (forms-jump-record forms--current-record))
+
+(defun forms-delete-record (arg)
+  "Deletes a record. With ARG: don't ask."
+  (interactive "P")
+  (forms--checkmod)
+  (if (or arg
+	  (y-or-n-p "Really delete this record? "))
+      (let ((ln forms--current-record))
+	(save-excursion
+	  (set-buffer forms--file-buffer)
+	  (goto-line ln)
+	  (kill-line 1))
+	(setq forms--total-records (1- forms--total-records))
+	(if (> forms--current-record forms--total-records)
+	    (setq forms--current-record forms--total-records))
+	(forms-jump-record forms--current-record)))
+  (message ""))
+
+(defun forms-search (regexp)
+  "Search REGEXP in file buffer."
+  (interactive 
+   (list (read-string (concat "Search 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))
+	  (end-of-line)
+	  (if (null (re-search-forward 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-revert-buffer (&optional arg noconfirm)
+  "Reverts current form to un-modified."
+  (interactive "P")
+  (if (or noconfirm
+	  (yes-or-no-p "Revert form to unmodified? "))
+      (progn
+	(set-buffer-modified-p nil)
+	(forms-jump-record forms--current-record))))
+
+(defun forms-next-field (arg)
+  "Jump to ARG-th next field."
+  (interactive "p")
+
+  (let ((i 0)
+	(here (point))
+	there
+	(cnt 0))
+
+    (if (zerop arg)
+	(setq cnt 1)
+      (setq cnt (+ cnt arg)))
+
+    (if (catch 'done
+	  (while (< i forms--number-of-markers)
+	    (if (or (null (setq there (aref forms--markers i)))
+		    (<= there here))
+		nil
+	      (if (<= (setq cnt (1- cnt)) 0)
+		  (progn
+		    (goto-char there)
+		    (throw 'done t))))
+	    (setq i (1+ i))))
+	nil
+      (goto-char (aref forms--markers 0)))))