annotate lisp/forms.el @ 1686:10650dfc82d0

* Makefile.in (install, install.sysv, install.xenix, install.aix): Install the info files in ${infodir}. Install the executable under both `emacs' and `emacs-VERSION'. * Makefile.in: Doc fix. * Makefile.in (exec_prefix): New variable, as per latest version of coding standards. (bindir, libdir): Use it, instead of `prefix'. (lib-src/Makefile): Edit value of exec_prefix into lib-src/Makefile. * Makefile.in (mandir): Make the default value for this depend on $(prefix). * Makefile.in (datadir, statedir, libdir): Make these all default to ${prefix}/lib. (lispdir, locallisppath, etcdir, lockdir, archlibdir): Adjusted to compensate. * Makefile.in (install, install.sysv, install.xenix, install.aix): Install the etags and ctags man pages too. * Makefile.in (distclean): Don't delete backup files; that's the job of extraclean. (extraclean): Like distclean, but deletes backup and autosave files. Make path specification conform to GNU coding standards. * configure (long_usage): Remove all traces of old arguments from usage messages, and document the options we do accept in more detail: -with-x... and --srcdir. (options, boolean_opts): Deleted; we don't have enough options to make this worthwhile. (prefix, bindir, lisppath, datadir, libdir, lockdir): Deleted, along with the code which supported them; these should be set as arguments to the top-level make. (config_h_opts): Since this no longer doubles as a list of option names, make them upper case; this simplifies the code which uses them to build the sed command to edit src/config.h. Change the code which sets them. (cc, g, O): Don't allow the user to set these using options; they should be specified using `CC=' and `CFLAGS=' arguments to the top-level make. Just choose reasonable default values for them, and edit them into Makefile.in's default CC and CONFIG_CFLAGS values. (gnu_malloc, rel_alloc): Don't allow the user to set these using options; use them whenever the configuration files say they're possible. Simplify the argument processing loop. Don't accept abbreviations for option names; these might conflict with other configuration options in the future. Add some support for the `--srcdir' option. Check for the sources in . and .. if `--srcdir' is omitted. If the directories we will compile in don't exist yet, create them under the current directory. Note that the rest of the build process doesn't really support this. Edit only the top Makefile. That should edit the others. Edit into the makefile: `version', from lisp/version.el, `configname' and `srcdir' from the configuration arguments, `CC' and `CONFIG_CFLAGS' as guessed from the presence or absence of GCC in the user's path, and LOADLIBES as gleaned from the system description files. Simplify the report generated; it doesn't need to include any description of paths now. Make `config.status' exec configure instead of just calling it, so there's no harm in overwriting `config.status'. * Makefile.in (version, configname): New variables, used to choose the default values for datadir and libdir. Path variables rearranged into two clearer groups: - In the first group are the variables specified by the GNU coding standards (prefix, bindir, datadir, statedir, libdir, mandir, manext, infodir, and srcdir). - In the second are the variables actually used for Emacs's paths (lispdir, locallisppath, lisppath, buildlisppath, etcdir, lockdir, archlibdir), which depend on the first category. datadir and libdir default to directories under ${prefix}/lib/emacs instead of ${prefix}/emacs, by popular demand. etcdir and lispdir default to subdirectories of datadir. archlibdir defaults to libdir. The new installation tree is a bit deeper than it used to be, so use the new make-path program in lib-src to build them all. Always build a new src/paths.h.tmp and then move-if-change it to src/paths.h, to avoid unnecessary rebuilds while responding to the right changes. Remove all mention of arch-lib. Run utility commands from lib-src, and let the executables be copied into archlibdir when Emacs is installed. Add targets for src/Makefile, lib-src/Makefile, and oldXMenu/Makefile, editing the values of the path variables into them. Let lib-src do its own installation. (datadir): Default to putting data files under ${prefix}/lib/emacs/${version}, not /usr/local/emacs. (emacsdir): Variable deleted; it would only be confusing to use. (lispdir, etcdir): Default to ${datadir}/lisp. (mkdir): Use make-path for this. (lockdir): Do this in mkdir. (Makefile): New target.

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

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

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

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

  (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 ((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)))
;;;
;;;	;;  (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
	    " 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 (&optional 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 (&optional 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
  (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)
  (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
    (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
      (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 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")

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

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