comparison lisp/forms.el @ 307:7fede845e304

*** empty log message ***

306:785babb5bb6f

;;; Forms Mode - A GNU Emacs Major Mode		; @(#)@ forms	1.2.2
;;; Created 1989 - Johan Vromans <[e-mail]>
;;; 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

;;; 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

;;;
;;;	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

;;;	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.

;;; 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.

;;; 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.")

  "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.")

;;;

  "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

	(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

;;; 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 (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

  ;;
  (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)))))

  ;;
  (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)))))

		       (- 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)

    ;; 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

    (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")

		    (goto-char there)
		    (throw 'done t))))
	    (setq i (1+ i))))
	nil
      (goto-char (aref forms--markers 0)))))

307:7fede845e304

;;; forms.el -- Forms Mode - A GNU Emacs Major Mode
;;; SCCS Status     : @(#)@ forms	1.2.7
;;; Author          : Johan Vromans
;;; Created On      : 1989
;;; Last Modified By: Johan Vromans
;;; Last Modified On: Mon Jul  1 14:13:20 1991
;;; Update Count    : 15
;;; Status          : OK

;;; 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

;;; 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.
;;;

;;; HISTORY 
;;; 1-Jul-1991		Johan Vromans	
;;;    Normalized error messages.
;;; 30-Jun-1991		Johan Vromans	
;;;    Add support for forms-modified-record-filter.
;;;    Allow the filter functions to be the name of a function.
;;;    Fix: parse--format used forms--dynamic-text destructively.
;;;    Internally optimized the forms-format-list.
;;;    Added support for debugging.
;;;    Stripped duplicate documentation.
;;;   
;;; 29-Jun-1991		Johan Vromans	
;;;    Add support for functions and lisp symbols in forms-format-list.
;;;    Add function forms-enumerate.

(provide 'forms-mode)

;;; Visit a file using a form.
;;;
;;; === Naming conventions

;;;
;;;	forms-format-list           [list]   formatting instructions.
;;;
;;; The forms-format-list should be a list, each element containing
;;;
;;;  - 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.
;;;
;;;  - a function call, e.g. (insert "text"). This function call is 
;;;    dynamically evaluated and should return a string. It should *NOT*
;;;    have side-effects on the forms being constructed.
;;;    The current fields are available to the function in the variable
;;;    forms-fields, they should *NOT* be modified.
;;;
;;;  - a lisp symbol, that must evaluate to one of the above.
;;;
;;; Optional variables which may be set in the control file:
;;;
;;;	forms-field-sep				[string, default TAB]
;;;			The field separator used to separate the

;;;	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			[symbol, no default]
;;;			If defined: this should be the name of a 
;;;			function that is called when a new
;;;			record is created. It can be used to fill in
;;;			the new record with default fields, for example.
;;;			Instead of the name of the function, it may
;;;			be the function itself.
;;;
;;;	forms-modified-record-filter		[symbol, no default]
;;;			If defined: this should be the name of a 
;;;			function that is called when a record has
;;;			been modified. It is called after the fields
;;;			are parsed. It can be used to register
;;;			modification dates, for example.
;;;			Instead of the name of the function, it may
;;;			be the function itself.
;;;
;;; 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.

;;; 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 built 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 built 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.

;;; 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.7"
  "Version of forms-mode implementation")

(defvar forms-forms-scrolls t
  "If non-null: redefine scroll-up/down to be used with forms-mode.")

  "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
  "List of formatting specifications.")

(defvar forms-number-of-fields nil
  "Number of fields per record.")

;;;

  "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.")

(defvar forms--modified-record-filter nil
  "Internal - set if a modified record filter has been defined.")

(defvar forms--dynamic-text nil
  "Internal - holds dynamic text to insert between fields.")

(defvar forms-fields nil
  "List with fields of the current forms. First field has number 1.")

;;;
;;; forms-mode
;;;
;;; This is not a simple major mode, as usual. Therefore, forms-mode

	(make-local-variable 'forms--format)
	(forms--make-format)
	(make-local-variable 'forms--parser)
	(forms--make-parser)

	;; check if record filters are defined
	(make-local-variable 'forms--new-record-filter)
	(setq forms--new-record-filter 
	      (cond
	       ((fboundp 'forms-new-record-filter)
		(symbol-function 'forms-new-record-filter))
	       ((and (boundp 'forms-new-record-filter)
		     (fboundp forms-new-record-filter))
		forms-new-record-filter)))
	(fmakunbound 'forms-new-record-filter)
	(make-local-variable 'forms--modified-record-filter)
	(setq forms--modified-record-filter 
	      (cond
	       ((fboundp 'forms-modified-record-filter)
		(symbol-function 'forms-modified-record-filter))
	       ((and (boundp 'forms-modified-record-filter)
		     (fboundp forms-modified-record-filter))
		forms-modified-record-filter)))
	(fmakunbound 'forms-modified-record-filter)

	;; dynamic text support
	(make-local-variable 'forms--dynamic-text)
	(make-local-variable 'forms-fields)

	;; prepare this buffer for further processing
	(setq buffer-read-only nil)

	;; prevent accidental overwrite of the control file and autosave

;;; Sets forms--number-of-markers and forms--markers.

(defun forms--process-format-list ()
  "Validate forms-format-list and set some global variables."

  (forms--debug "forms-forms-list before 1st pass:\n"
		'forms-format-list)

  ;; 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
	(this-item 0)			; element in list
	(field-num 0))			; highest field number 

    (setq forms-format-list nil)	; gonna rebuild

    (while the-list

      (let ((el (car-safe the-list))
	    (rem (cdr-safe the-list)))

	;; if it is a symbol, eval it first
	(if (and (symbolp el)
		 (boundp el))
	    (setq el (eval el)))

	(cond

	 ;; try string ...
	 ((stringp el))			; string is OK
	  
	 ;; try numeric ...
	 ((numberp el) 

	  (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)))

	 ;; try function
	 ((listp el)
	  (or (fboundp (car-safe el))
	      (error 
	       "Forms error: not a function: %s"
	       (prin1-to-string (car-safe el)))))

	 ;; else
	 (t
	  (error "Invalid element in 'forms-format-list': %s"
		 (prin1-to-string el))))

	;; advance to next element of the list
	(setq the-list rem)
	(setq forms-format-list
	      (append forms-format-list (list el) nil)))))

  (forms--debug "forms-forms-list after 1st pass:\n"
		'forms-format-list)

  ;; concat adjacent strings
  (setq forms-format-list (forms--concat-adjacent forms-format-list))

  (forms--debug "forms-forms-list after 2nd pass:\n"
		'forms-format-list
		'forms--number-of-markers)

  (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)
;;;   (setq forms--dynamic-text nil)
;;;   ;;  "text: "
;;;   (insert "text: ")
;;;   ;;  6
;;;   (aset forms--markers 0 (point-marker))
;;;   (insert (elt arg 5))
;;;   ;;  "\nmore text: "
;;;   (insert "\nmore text: ")
;;;   ;;  (tocol 40)
;;;   (let ((the-dyntext (tocol 40)))
;;;     (insert the-dyntext)
;;;     (setq forms--dynamic-text (append forms--dynamic-text
;;;					  (list the-dyntext))))
;;;   ;;  9
;;;   (aset forms--markers 1 (point-marker))
;;;   (insert (elt arg 8))
;;;
;;;   ... )
;;; 

(defun forms--make-format ()
  "Generate format function for forms"
  (setq forms--format (forms--format-maker forms-format-list))
  (forms--debug 'forms--format))

(defun forms--format-maker (the-format-list)
  "Returns the parser function for forms"
  (let ((the-marker 0))
    (` (lambda (arg)
	 (setq forms--dynamic-text nil)
	 (,@ (apply 'append
		    (mapcar 'forms--make-format-elt 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))))
	((listp el)
	 (prog1
	     (` ((let ((the-dyntext (, el)))
		   (insert the-dyntext)
		   (setq forms--dynamic-text (append forms--dynamic-text
						     (list the-dyntext)))))
		)))
	))


(defun forms--concat-adjacent (the-list)
  "Concatenate adjacent strings in the-list and return the resulting list"
  (if (consp the-list)

;;;   (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)))
;;;
;;;	;;  (tocol 40)
;;;	(let ((the-dyntext (car-safe forms--dynamic-text)))
;;;	  (if (not (looking-at (regexp-quote the-dyntext)))
;;;	      (error "Parse error: not looking at \"%s\"" the-dyntext))
;;;	  (forward-char (length the-dyntext))
;;;	  (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))
;;;     ... 
;;;     ;; 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))
  (forms--debug 'forms--parser))

(defun forms--parser-maker (the-format-list)
  "Returns the parser function for forms"
  (let ((the-field nil)
	(seen-text nil)
	the--format-list)
    ;; add a terminator sentinel
    (setq the--format-list (append 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)))))))
   ((listp el)
    (prog1
	(if the-field
	    (` ((let ((here (point))
		      (the-dyntext (car-safe forms--dynamic-text)))
		  (if (not (search-forward the-dyntext nil t nil))
		      (error "Parse error: cannot find \"%s\"" the-dyntext))
		  (aset the-recordv (, (1- the-field))
			(buffer-substring here
					  (- (point) (length the-dyntext))))
		  (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))))
	  (` ((let ((the-dyntext (car-safe forms--dynamic-text)))
		(if (not (looking-at (regexp-quote the-dyntext)))
		    (error "Parse error: not looking at \"%s\"" the-dyntext))
		(forward-char (length the-dyntext))
		(setq forms--dynamic-text (cdr-safe forms--dynamic-text))))))
      (setq seen-text t)
      (setq the-field nil)))
   ))
;;;

(defun forms--set-minor-mode ()
  (setq minor-mode-alist
	(if forms-read-only

  ;;
  (if (fboundp 'forms--scroll-down)
      nil
    (fset 'forms--scroll-down (symbol-function 'scroll-down))
    (fset 'scroll-down
	  '(lambda (&optional arg) 
	     (interactive "P")
	     (if (and forms--mode-setup
		      forms-forms-scroll)
		 (forms-prev-record arg)
	       (forms--scroll-down arg)))))

  ;;
  (if (fboundp 'forms--scroll-up)
      nil
    (fset 'forms--scroll-up   (symbol-function 'scroll-up))
    (fset 'scroll-up
	  '(lambda (&optional arg) 
	     (interactive "P")
	     (if (and forms--mode-setup
		      forms-forms-scroll)
		 (forms-next-record arg)
	       (forms--scroll-up arg)))))

		       (- forms-number-of-fields 
			  (length forms--the-record-list))
		       "")))))

  ;; call the formatter function
  (setq forms-fields (append (list nil) forms--the-record-list nil))
  (funcall forms--format forms--the-record-list)

  ;; prepare
  (goto-char (point-min))
  (set-buffer-modified-p nil)

    ;; build the vector
    (setq the-recordv (vconcat forms--the-record-list))

    ;; parse the form and update the vector
    (let ((forms--dynamic-text forms--dynamic-text))
      (funcall forms--parser))

    (if forms--modified-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 (vconcat [nil] the-recordv)))
	  (setq the-fields (funcall forms--modified-record-filter the-fields))
	  (cdr (append the-fields nil)))

      ;; 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

    (if (equal ro forms-read-only)
	nil
      (forms-mode))))

;; Sample:
;; (defun my-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)
;; (setq forms-new-record-filter 'my-new-record-filter)

(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, or forms-new-record-filter
 contains the name of a function, it is called to
 fill (some of) the fields with default values."
 ; The above doc is not true, but for documentary purposes only

  (interactive "P")

		    (goto-char there)
		    (throw 'done t))))
	    (setq i (1+ i))))
	nil
      (goto-char (aref forms--markers 0)))))

;;;
;;; Special service
;;;
(defun forms-enumerate (the-fields)
  "Take a quoted list of symbols, and set their values to the numbers
1, 2 and so on. Returns the higest number.

Usage: (setq forms-number-of-fields
             (forms-enumerate
              '(field1 field2 field2 ...)))"

  (let ((the-index 0))
    (while the-fields
      (setq the-index (1+ the-index))
      (let ((el (car-safe the-fields)))
	(setq the-fields (cdr-safe the-fields))
	(set el the-index)))
    the-index))

;;;
;;; Debugging
;;;
(defvar forms--debug nil
  "*Enables forms-mode debugging if not nil.")

(defun forms--debug (&rest args)
  "Internal - debugging routine"
  (if forms--debug
      (let ((ret nil))
	(while args
	  (let ((el (car-safe args)))
	    (setq args (cdr-safe args))
	    (if (stringp el)
		(setq ret (concat ret el))
	      (setq ret (concat ret (prin1-to-string el) " = "))
	      (if (boundp el)
		  (let ((vel (eval el)))
		    (setq ret (concat ret (prin1-to-string vel) "\n")))
		(setq ret (concat ret "<unbound>" "\n")))
	      (if (fboundp el)
		  (setq ret (concat ret (prin1-to-string (symbol-function el)) 
				    "\n"))))))
	(save-excursion
	  (set-buffer (get-buffer-create "*forms-mode debug*"))
	  (goto-char (point-max))
	  (insert ret)))))

;;; Local Variables:
;;; eval: (headers)
;;; eval: (setq comment-start ";;; ")
;;; End: