🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.emacs.sources
Article #300

GNU Emacs forms-mode version 1.2.9 (part 1 of 3)

#300
From: Johan Vromans
Date: Tue, 14 Jan 1992 14:35
926 lines
32312 bytes
This is GNU Emacs 'forms-mode', version 1.2 (patchlevel 9).

This GNU Emacs major mode implements editing a structured file (i.e. a
file with 'records' and 'fields' in it) using a forms. 
It is fully documented in the source file 'forms.el' and in the
texinfo file 'forms.texinfo'.

Although the changes since the previous version (1.2.7, July 1991) are
minor, this is a complete posting since some of the files have been
renamed to suit the conventions of the Free Software Foundation.

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is forms, a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 01/14/1992 14:34 UTC by jv@mh.nl
# Source directory /nfs/pronto/mozart/users/jv/src/elisp/forms-mode
#
# existing files will NOT be overwritten unless -c is specified
#
# This is part 1 of a multipart archive                                    
# do not concatenate these parts, unpack them in order with /bin/sh        
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#  42028 -r--r--r-- forms.el
#  28578 -r--r--r-- forms.texinfo
#    815 -r--r--r-- forms-passwd
#   2413 -r--r--r-- forms-demo
#   3625 -r--r--r-- README
#    565 -rw-r--r-- forms-data
#
if test -r _shar_seq_.tmp; then
	echo 'Must unpack archives in sequence!'
	echo Please unpack part `cat _shar_seq_.tmp` next
	exit 1
fi
# ============= forms.el ==============
if test -f 'forms.el' -a X"$1" != X"-c"; then
	echo 'x - skipping forms.el (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting forms.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'forms.el' &&
X;;; forms.el -- Forms Mode - A GNU Emacs Major Mode
X;;; SCCS Status     : @(#)@ forms	1.2.9
X;;; Author          : Johan Vromans
X;;; Created On      : 1989
X;;; Last Modified By: Johan Vromans
X;;; Last Modified On: Tue Jan 14 15:33:22 1992
X;;; Update Count    : 22
X;;; Status          : OK
X
X;;; This file is part of GNU Emacs.
X;;; GNU Emacs is distributed in the hope that it will be useful,
X;;; but WITHOUT ANY WARRANTY.  No author or distributor
X;;; accepts responsibility to anyone for the consequences of using it
X;;; or for whether it serves any particular purpose or works at all,
X;;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;;; License for full details.
X
X;;; Everyone is granted permission to copy, modify and redistribute
X;;; GNU Emacs, but only under the conditions described in the
X;;; GNU Emacs General Public License.   A copy of this license is
X;;; supposed to have been given to you along with GNU Emacs so you
X;;; can know your rights and responsibilities. 
X;;; If you don't have this copy, write to the Free Software
X;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
X;;;
X
X;; LCD Archive Entry:
X;; forms|Johan Vromans|jv@mh.nl
X;; |Major mode for working with plain-text databases in forms-oriented manner
X;; |92/01/14|1.2.9|~/modes/forms.tar.Z|
X
X
X;;; HISTORY 
X;;; 14-Jan-1992		Johan Vromans	
X;;;    Add LCD entry.
X;;; 1-Jul-1991		Johan Vromans	
X;;;    Normalized error messages.
X;;; 30-Jun-1991		Johan Vromans	
X;;;    Add support for forms-modified-record-filter.
X;;;    Allow the filter functions to be the name of a function.
X;;;    Fix: parse--format used forms--dynamic-text destructively.
X;;;    Internally optimized the forms-format-list.
X;;;    Added support for debugging.
X;;;    Stripped duplicate documentation.
X;;;   
X;;; 29-Jun-1991		Johan Vromans	
X;;;    Add support for functions and lisp symbols in forms-format-list.
X;;;    Add function forms-enumerate.
X
X(provide 'forms)			;;; official
X(provide 'forms-mode)			;;; for compatibility
X
X;;; Visit a file using a form.
X;;;
X;;; === Naming conventions
X;;;
X;;; The names of all variables and functions start with 'form-'.
X;;; Names which start with 'form--' are intended for internal use, and
X;;; should *NOT* be used from the outside.
X;;;
X;;; All variables are buffer-local, to enable multiple forms visits 
X;;; simultaneously.
X;;; Variable 'forms--mode-setup' is local to *ALL* buffers, for it 
X;;; controls if forms-mode has been enabled in a buffer.
X;;;
X;;; === How it works ===
X;;;
X;;; Forms mode means visiting a data file which is supposed to consist
X;;; of records each containing a number of fields. The records are
X;;; separated by a newline, the fields are separated by a user-defined
X;;; field separater (default: TAB).
X;;; When shown, a record is transferred to an emacs buffer and
X;;; presented using a user-defined form. One record is shown at a
X;;; time.
X;;;
X;;; Forms mode is a composite mode. It involves two files, and two
X;;; buffers.
X;;; The first file, called the control file, defines the name of the
X;;; data file and the forms format. This file buffer will be used to
X;;; present the forms.
X;;; The second file holds the actual data. The buffer of this file
X;;; will be buried, for it is never accessed directly.
X;;;
X;;; Forms mode is invoked using "forms-find-file control-file".
X;;; Alternativily forms-find-file-other-window can be used.
X;;;
X;;; You may also visit the control file, and switch to forms mode by hand
X;;; with M-x forms-mode .
X;;;
X;;; Automatic mode switching is supported, so you may use "find-file"
X;;; if you specify "-*- forms -*-" in the first line of the control file.
X;;; 
X;;; The control file is visited, evaluated using
X;;; eval-current-buffer, and should set at least the following
X;;; variables:
X;;;
X;;;	forms-file		    [string] the name of the data file.
X;;;
X;;;	forms-number-of-fields	    [integer]
X;;;			The number of fields in each record.
X;;;
X;;;	forms-format-list           [list]   formatting instructions.
X;;;
X;;; The forms-format-list should be a list, each element containing
X;;;
X;;;  - a string, e.g. "hello" (which is inserted \"as is\"),
X;;;
X;;;  - an integer, denoting a field number. The contents of the field
X;;;    are inserted at this point.
X;;;    The first field has number one.
X;;;
X;;;  - a function call, e.g. (insert "text"). This function call is 
X;;;    dynamically evaluated and should return a string. It should *NOT*
X;;;    have side-effects on the forms being constructed.
X;;;    The current fields are available to the function in the variable
X;;;    forms-fields, they should *NOT* be modified.
X;;;
X;;;  - a lisp symbol, that must evaluate to one of the above.
X;;;
X;;; Optional variables which may be set in the control file:
X;;;
X;;;	forms-field-sep				[string, default TAB]
X;;;			The field separator used to separate the
X;;;			fields in the data file. It may be a string.
X;;;
X;;;	forms-read-only				[bool, default nil]
X;;;			't' means that the data file is visited read-only.
X;;;			If no write access to the data file is
X;;;			possible, read-only mode is enforced. 
X;;;
X;;;	forms-multi-line			[string, default "^K"]
X;;;			If non-null the records of the data file may
X;;;			contain fields which span multiple lines in
X;;;			the form.
X;;;			This variable denoted the separator character
X;;;			to be used for this purpose. Upon display, all
X;;;			occurrencies of this character are translated
X;;;			to newlines. Upon storage they are translated
X;;;			back to the separator.
X;;;
X;;;	forms-forms-scroll			[bool, default t]
X;;;			If non-nil: redefine scroll-up/down to perform
X;;;			forms-next/prev-field if in forms mode.
X;;;
X;;;	forms-forms-jump			[bool, default t]
X;;;			If non-nil: redefine beginning/end-of-buffer
X;;;			to performs forms-first/last-field if in
X;;;			forms mode.
X;;;
X;;;	forms-new-record-filter			[symbol, no default]
X;;;			If defined: this should be the name of a 
X;;;			function that is called when a new
X;;;			record is created. It can be used to fill in
X;;;			the new record with default fields, for example.
X;;;			Instead of the name of the function, it may
X;;;			be the function itself.
X;;;
X;;;	forms-modified-record-filter		[symbol, no default]
X;;;			If defined: this should be the name of a 
X;;;			function that is called when a record has
X;;;			been modified. It is called after the fields
X;;;			are parsed. It can be used to register
X;;;			modification dates, for example.
X;;;			Instead of the name of the function, it may
X;;;			be the function itself.
X;;;
X;;; After evaluating the control file, its buffer is cleared and used
X;;; for further processing.
X;;; The data file (as designated by "forms-file") is visited in a buffer
X;;; (forms--file-buffer) which will not normally be shown.
X;;; Great malfunctioning may be expected if this file/buffer is modified
X;;; outside of this package while it's being visited!
X;;;
X;;; A record from the data file is transferred from the data file,
X;;; split into fields (into forms--the-record-list), and displayed using
X;;; the specs in forms-format-list.
X;;; A format routine 'forms--format' is built upon startup to format 
X;;; the records.
X;;;
X;;; When a form is changed the record is updated as soon as this form
X;;; is left. The contents of the form are parsed using forms-format-list,
X;;; and the fields which are deduced from the form are modified. So,
X;;; fields not shown on the forms retain their origional values.
X;;; The newly formed record and replaces the contents of the
X;;; old record in forms--file-buffer.
X;;; A parse routine 'forms--parser' is built upon startup to parse
X;;; the records.
X;;;
X;;; Two exit functions exist: forms-exit (which saves) and forms-exit-no-save
X;;; (which doesn't). However, if forms-exit-no-save is executed and the file
X;;; buffer has been modified, emacs will ask questions.
X;;;
X;;; Other functions are:
X;;;
X;;;	paging (forward, backward) by record
X;;;	jumping (first, last, random number)
X;;;	searching
X;;;	creating and deleting records
X;;;	reverting the form (NOT the file buffer)
X;;;	switching edit <-> view mode v.v.
X;;;	jumping from field to field
X;;;
X;;; As an documented side-effect: jumping to the last record in the
X;;; file (using forms-last-record) will adjust forms--total-records if
X;;; needed.
X;;;
X;;; Commands and keymaps:
X;;;
X;;; A local keymap 'forms-mode-map' is used in the forms buffer.
X;;; As conventional, this map can be accessed with C-c prefix.
X;;; In read-only mode, the C-c prefix must be omitted.
X;;;
X;;; Default bindings:
X;;;
X;;;	\C-c	forms-mode-map
X;;;	TAB	forms-next-field
X;;;	SPC 	forms-next-record
X;;;	<	forms-first-record
X;;;	>	forms-last-record
X;;;	?	describe-mode
X;;;	d	forms-delete-record
X;;;	e	forms-edit-mode
X;;;	i	forms-insert-record
X;;;	j	forms-jump-record
X;;;	n	forms-next-record
X;;;	p	forms-prev-record
X;;;	q	forms-exit
X;;;	s	forms-search
X;;;	v	forms-view-mode
X;;;	x	forms-exit-no-save
X;;;	DEL	forms-prev-record
X;;;
X;;; Standard functions scroll-up, scroll-down, beginning-of-buffer and
X;;; end-of-buffer are wrapped with re-definitions, which map them to
X;;; next/prev record and first/last record.
X;;; Buffer-local variables forms-forms-scroll and forms-forms-jump
X;;; may be used to control these redefinitions.
X;;;
X;;; Function save-buffer is also wrapped to perform a sensible action.
X;;; A revert-file-hook is defined to revert a forms to original.
X;;;
X;;; For convenience, TAB is always bound to forms-next-field, so you
X;;; don't need the C-c prefix for this command.
X;;;
X;;; Global variables and constants
X
X(defconst forms-version "1.2.9"
X  "Version of forms-mode implementation")
X
X(defvar forms-forms-scrolls t
X  "If non-null: redefine scroll-up/down to be used with forms-mode.")
X
X(defvar forms-forms-jumps t
X  "If non-null: redefine beginning/end-of-buffer to be used with forms-mode.")
X
X(defvar forms-mode-hooks nil
X  "Hook functions to be run upon entering forms mode.")
X;;;
X;;; Mandatory variables - must be set by evaluating the control file
X
X(defvar forms-file nil
X  "Name of the file holding the data.")
X
X(defvar forms-format-list nil
X  "List of formatting specifications.")
X
X(defvar forms-number-of-fields nil
X  "Number of fields per record.")
X
X;;;
X;;; Optional variables with default values
X
X(defvar forms-field-sep "\t"
X  "Field separator character (default TAB)")
X
X(defvar forms-read-only nil
X  "Read-only mode (defaults to the write access on the data file).")
X
X(defvar forms-multi-line "\C-k"
X  "Character to separate multi-line fields (default ^K)")
X
X(defvar forms-forms-scroll t
X  "Redefine scroll-up/down to perform forms-next/prev-record when in
X forms mode.")
X
X(defvar forms-forms-jump t
X  "Redefine beginning/end-of-buffer to perform forms-first/last-record
X when in forms mode.")
X
X;;;
X;;; Internal variables.
X
X(defvar forms--file-buffer nil
X  "Buffer which holds the file data")
X
X(defvar forms--total-records 0
X  "Total number of records in the data file.")
X
X(defvar forms--current-record 0
X  "Number of the record currently on the screen.")
X
X(defvar forms-mode-map nil		; yes - this one is global
X   "Keymap for form buffer.")
X
X(defvar forms--markers nil
X  "Field markers in the screen.")
X
X(defvar forms--number-of-markers 0
X  "Number of fields on screen.")
X
X(defvar forms--the-record-list nil 
X   "List of strings of the current record, as parsed from the file.")
X
X(defvar forms--search-regexp nil
X  "Last regexp used by forms-search.")
X
X(defvar forms--format nil
X  "Formatting routine.")
X
X(defvar forms--parser nil
X  "Forms parser routine.")
X
X(defvar forms--mode-setup nil
X  "Internal - keeps track of forms-mode being set-up.")
X(make-variable-buffer-local 'forms--mode-setup)
X
X(defvar forms--new-record-filter nil
X  "Internal - set if a new record filter has been defined.")
X
X(defvar forms--modified-record-filter nil
X  "Internal - set if a modified record filter has been defined.")
X
X(defvar forms--dynamic-text nil
X  "Internal - holds dynamic text to insert between fields.")
X
X(defvar forms-fields nil
X  "List with fields of the current forms. First field has number 1.")
X
X;;;
X;;; forms-mode
X;;;
X;;; This is not a simple major mode, as usual. Therefore, forms-mode
X;;; takes an optional argument 'primary' which is used for the initial
X;;; set-up. Normal use would leave 'primary' to nil.
X;;;
X;;; A global buffer-local variable 'forms--mode-setup' has the same effect
X;;; but makes it possible to auto-invoke forms-mode using find-file.
X;;;
X;;; Note: although it seems logical to have (make-local-variable) executed
X;;; where the variable is first needed, I deliberately placed all calls
X;;; in the forms-mode function.
X 
X(defun forms-mode (&optional primary)
X  "Major mode to visit files in a field-structured manner using a form.
X
X Commands (prefix with C-c if not in read-only mode):
X \\{forms-mode-map}"
X
X  (interactive)				; no - 'primary' is not prefix arg
X
X  ;; Primary set-up: evaluate buffer and check if the mandatory
X  ;; variables have been set.
X  (if (or primary (not forms--mode-setup))
X      (progn
X	(kill-all-local-variables)
X
X	;; make mandatory variables
X	(make-local-variable 'forms-file)
X	(make-local-variable 'forms-number-of-fields)
X	(make-local-variable 'forms-format-list)
X
X	;; make optional variables
X	(make-local-variable 'forms-field-sep)
X        (make-local-variable 'forms-read-only)
X        (make-local-variable 'forms-multi-line)
X	(make-local-variable 'forms-forms-scroll)
X	(make-local-variable 'forms-forms-jump)
X	(fmakunbound 'forms-new-record-filter)
X
X	;; eval the buffer, should set variables
X	(eval-current-buffer)
X
X	;; check if the mandatory variables make sense.
X	(or forms-file
X	    (error "'forms-file' has not been set"))
X	(or forms-number-of-fields
X	    (error "'forms-number-of-fields' has not been set"))
X	(or (> forms-number-of-fields 0)
X	    (error "'forms-number-of-fields' must be > 0")
X	(or (stringp forms-field-sep))
X	    (error "'forms-field-sep' is not a string"))
X	(if forms-multi-line
X	    (if (and (stringp forms-multi-line)
X		     (eq (length forms-multi-line) 1))
X		(if (string= forms-multi-line forms-field-sep)
X		    (error "'forms-multi-line' is equal to 'forms-field-sep'"))
X	      (error "'forms-multi-line' must be nil or a one-character string")))
X	    
X	;; validate and process forms-format-list
X	(make-local-variable 'forms--number-of-markers)
X	(make-local-variable 'forms--markers)
X	(forms--process-format-list)
X
X	;; build the formatter and parser
X	(make-local-variable 'forms--format)
X	(forms--make-format)
X	(make-local-variable 'forms--parser)
X	(forms--make-parser)
X
X	;; check if record filters are defined
X	(make-local-variable 'forms--new-record-filter)
X	(setq forms--new-record-filter 
X	      (cond
X	       ((fboundp 'forms-new-record-filter)
X		(symbol-function 'forms-new-record-filter))
X	       ((and (boundp 'forms-new-record-filter)
X		     (fboundp forms-new-record-filter))
X		forms-new-record-filter)))
X	(fmakunbound 'forms-new-record-filter)
X	(make-local-variable 'forms--modified-record-filter)
X	(setq forms--modified-record-filter 
X	      (cond
X	       ((fboundp 'forms-modified-record-filter)
X		(symbol-function 'forms-modified-record-filter))
X	       ((and (boundp 'forms-modified-record-filter)
X		     (fboundp forms-modified-record-filter))
X		forms-modified-record-filter)))
X	(fmakunbound 'forms-modified-record-filter)
X
X	;; dynamic text support
X	(make-local-variable 'forms--dynamic-text)
X	(make-local-variable 'forms-fields)
X
X	;; prepare this buffer for further processing
X	(setq buffer-read-only nil)
X
X	;; prevent accidental overwrite of the control file and autosave
X	(setq buffer-file-name nil)
X	(auto-save-mode nil)
X
X	;; and clean it
X	(erase-buffer)))
X
X  ;; make local variables
X  (make-local-variable 'forms--file-buffer)
X  (make-local-variable 'forms--total-records)
X  (make-local-variable 'forms--current-record)
X  (make-local-variable 'forms--the-record-list)
X  (make-local-variable 'forms--search-rexexp)
X
X  ;; A bug in the current Emacs release prevents a keymap
X  ;; which is buffer-local from being used by 'describe-mode'.
X  ;; Hence we'll leave it global.
X  ;;(make-local-variable 'forms-mode-map)
X  (if forms-mode-map			; already defined
X      nil
X    (setq forms-mode-map (make-keymap))
X    (forms--mode-commands forms-mode-map)
X    (forms--change-commands))
X
X  ;; find the data file
X  (setq forms--file-buffer (find-file-noselect forms-file))
X
X  ;; count the number of records, and set see if it may be modified
X  (let (ro)
X    (setq forms--total-records
X	  (save-excursion
X	    (set-buffer forms--file-buffer)
X	    (bury-buffer (current-buffer))
X	    (setq ro buffer-read-only)
X	    (count-lines (point-min) (point-max))))
X    (if ro
X	(setq forms-read-only t)))
X
X  ;; set the major mode indicator
X  (setq major-mode 'forms-mode)
X  (setq mode-name "Forms")
X  (make-local-variable 'minor-mode-alist) ; needed?
X  (forms--set-minor-mode)
X  (forms--set-keymaps)
X
X  (set-buffer-modified-p nil)
X
X  ;; We have our own revert function - use it
X  (make-local-variable 'revert-buffer-function)
X  (setq revert-buffer-function 'forms-revert-buffer)
X
X  ;; setup the first (or current) record to show
X  (if (< forms--current-record 1)
X      (setq forms--current-record 1))
X  (forms-jump-record forms--current-record)
X
X  ;; user customising
X  (run-hooks 'forms-mode-hooks)
X
X  ;; be helpful
X  (forms--help)
X
X  ;; initialization done
X  (setq forms--mode-setup t))
X
X;;;
X;;; forms-process-format-list
X;;;
X;;; Validates forms-format-list.
X;;;
X;;; Sets forms--number-of-markers and forms--markers.
X
X(defun forms--process-format-list ()
X  "Validate forms-format-list and set some global variables."
X
X  (forms--debug "forms-forms-list before 1st pass:\n"
X		'forms-format-list)
X
X  ;; it must be non-nil
X  (or forms-format-list
X      (error "'forms-format-list' has not been set"))
X  ;; it must be a list ...
X  (or (listp forms-format-list)
X      (error "'forms-format-list' is not a list"))
X
X  (setq forms--number-of-markers 0)
X
X  (let ((the-list forms-format-list)	; the list of format elements
X	(this-item 0)			; element in list
X	(field-num 0))			; highest field number 
X
X    (setq forms-format-list nil)	; gonna rebuild
X
X    (while the-list
X
X      (let ((el (car-safe the-list))
X	    (rem (cdr-safe the-list)))
X
X	;; if it is a symbol, eval it first
X	(if (and (symbolp el)
X		 (boundp el))
X	    (setq el (eval el)))
X
X	(cond
X
X	 ;; try string ...
X	 ((stringp el))			; string is OK
X	  
X	 ;; try numeric ...
X	 ((numberp el) 
X
X	  (if (or (<= el 0)
X		  (> el forms-number-of-fields))
X	      (error
X	       "Forms error: field number %d out of range 1..%d"
X	       el forms-number-of-fields))
X
X	  (setq forms--number-of-markers (1+ forms--number-of-markers))
X	  (if (> el field-num)
X	      (setq field-num el)))
X
X	 ;; try function
X	 ((listp el)
X	  (or (fboundp (car-safe el))
X	      (error 
X	       "Forms error: not a function: %s"
X	       (prin1-to-string (car-safe el)))))
X
X	 ;; else
X	 (t
X	  (error "Invalid element in 'forms-format-list': %s"
X		 (prin1-to-string el))))
X
X	;; advance to next element of the list
X	(setq the-list rem)
X	(setq forms-format-list
X	      (append forms-format-list (list el) nil)))))
X
X  (forms--debug "forms-forms-list after 1st pass:\n"
X		'forms-format-list)
X
X  ;; concat adjacent strings
X  (setq forms-format-list (forms--concat-adjacent forms-format-list))
X
X  (forms--debug "forms-forms-list after 2nd pass:\n"
X		'forms-format-list
X		'forms--number-of-markers)
X
X  (setq forms--markers (make-vector forms--number-of-markers nil)))
X
X
X;;;
X;;; Build the format routine from forms-format-list.
X;;;
X;;; The format routine (forms--format) will look like
X;;; 
X;;; (lambda (arg)
X;;;   (setq forms--dynamic-text nil)
X;;;   ;;  "text: "
X;;;   (insert "text: ")
X;;;   ;;  6
X;;;   (aset forms--markers 0 (point-marker))
X;;;   (insert (elt arg 5))
X;;;   ;;  "\nmore text: "
X;;;   (insert "\nmore text: ")
X;;;   ;;  (tocol 40)
X;;;   (let ((the-dyntext (tocol 40)))
X;;;     (insert the-dyntext)
X;;;     (setq forms--dynamic-text (append forms--dynamic-text
X;;;					  (list the-dyntext))))
X;;;   ;;  9
X;;;   (aset forms--markers 1 (point-marker))
X;;;   (insert (elt arg 8))
X;;;
X;;;   ... )
X;;; 
X
X(defun forms--make-format ()
X  "Generate format function for forms"
X  (setq forms--format (forms--format-maker forms-format-list))
X  (forms--debug 'forms--format))
X
X(defun forms--format-maker (the-format-list)
X  "Returns the parser function for forms"
X  (let ((the-marker 0))
X    (` (lambda (arg)
X	 (setq forms--dynamic-text nil)
X	 (,@ (apply 'append
X		    (mapcar 'forms--make-format-elt the-format-list)))))))
X
X(defun forms--make-format-elt (el)
X  (cond ((stringp el)
X	 (` ((insert (, el)))))
X	((numberp el)
X	 (prog1
X	     (` ((aset forms--markers (, the-marker) (point-marker))
X		 (insert (elt arg (, (1- el))))))
X	   (setq the-marker (1+ the-marker))))
X	((listp el)
X	 (prog1
X	     (` ((let ((the-dyntext (, el)))
X		   (insert the-dyntext)
X		   (setq forms--dynamic-text (append forms--dynamic-text
X						     (list the-dyntext)))))
X		)))
X	))
X
X
X(defun forms--concat-adjacent (the-list)
X  "Concatenate adjacent strings in the-list and return the resulting list"
X  (if (consp the-list)
X      (let ((the-rest (forms--concat-adjacent (cdr the-list))))
X	(if (and (stringp (car the-list)) (stringp (car the-rest)))
X	    (cons (concat (car the-list) (car the-rest))
X		  (cdr the-rest))
X	    (cons (car the-list) the-rest)))
X      the-list))
X;;;
X;;; forms--make-parser.
X;;;
X;;; Generate parse routine from forms-format-list.
X;;;
X;;; The parse routine (forms--parser) will look like (give or take
X;;; a few " " .
X;;; 
X;;; (lambda nil
X;;;   (let (here)
X;;;     (goto-char (point-min))
X;;; 
X;;;	;;  "text: "
X;;;     (if (not (looking-at "text: "))
X;;; 	    (error "Parse error: cannot find \"text: \""))
X;;;     (forward-char 6)	; past "text: "
X;;; 
X;;;     ;;  6
X;;;	;;  "\nmore text: "
X;;;     (setq here (point))
X;;;     (if (not (search-forward "\nmore text: " nil t nil))
X;;; 	    (error "Parse error: cannot find \"\\nmore text: \""))
X;;;     (aset the-recordv 5 (buffer-substring here (- (point) 12)))
X;;;
X;;;	;;  (tocol 40)
X;;;	(let ((the-dyntext (car-safe forms--dynamic-text)))
X;;;	  (if (not (looking-at (regexp-quote the-dyntext)))
X;;;	      (error "Parse error: not looking at \"%s\"" the-dyntext))
X;;;	  (forward-char (length the-dyntext))
X;;;	  (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))
X;;;     ... 
X;;;     ;; final flush (due to terminator sentinel, see below)
X;;;	(aset the-recordv 7 (buffer-substring (point) (point-max)))
X;;; 
X
X(defun forms--make-parser ()
X  "Generate parser function for forms"
X  (setq forms--parser (forms--parser-maker forms-format-list))
X  (forms--debug 'forms--parser))
X
X(defun forms--parser-maker (the-format-list)
X  "Returns the parser function for forms"
X  (let ((the-field nil)
X	(seen-text nil)
X	the--format-list)
X    ;; add a terminator sentinel
X    (setq the--format-list (append the-format-list (list nil)))
X    (` (lambda nil
X	 (let (here)
X	   (goto-char (point-min))
X	 (,@ (apply 'append
X		    (mapcar 'forms--make-parser-elt the--format-list))))))))
X
X(defun forms--make-parser-elt (el)
X  (cond
X   ((stringp el)
X    (prog1
X	(if the-field
X	    (` ((setq here (point))
X		(if (not (search-forward (, el) nil t nil))
X		    (error "Parse error: cannot find \"%s\"" (, el)))
X		(aset the-recordv (, (1- the-field))
X		      (buffer-substring here
X					(- (point) (, (length el)))))))
X	  (` ((if (not (looking-at (, (regexp-quote el))))
X		  (error "Parse error: not looking at \"%s\"" (, el)))
X	      (forward-char (, (length el))))))
X      (setq seen-text t)
X      (setq the-field nil)))
X   ((numberp el)
X    (if the-field
X	(error "Cannot parse adjacent fields %d and %d"
X	       the-field el)
X      (setq the-field el)
X      nil))
X   ((null el)
X    (if the-field
X	(` ((aset the-recordv (, (1- the-field))
X		  (buffer-substring (point) (point-max)))))))
X   ((listp el)
X    (prog1
X	(if the-field
X	    (` ((let ((here (point))
X		      (the-dyntext (car-safe forms--dynamic-text)))
X		  (if (not (search-forward the-dyntext nil t nil))
X		      (error "Parse error: cannot find \"%s\"" the-dyntext))
X		  (aset the-recordv (, (1- the-field))
X			(buffer-substring here
X					  (- (point) (length the-dyntext))))
X		  (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))))
X	  (` ((let ((the-dyntext (car-safe forms--dynamic-text)))
X		(if (not (looking-at (regexp-quote the-dyntext)))
X		    (error "Parse error: not looking at \"%s\"" the-dyntext))
X		(forward-char (length the-dyntext))
X		(setq forms--dynamic-text (cdr-safe forms--dynamic-text))))))
X      (setq seen-text t)
X      (setq the-field nil)))
X   ))
X;;;
X
X(defun forms--set-minor-mode ()
X  (setq minor-mode-alist
X	(if forms-read-only
X	    " View"
X	  nil)))
X
X(defun forms--set-keymaps ()
X  "Set the keymaps used in this mode."
X
X  (if forms-read-only
X      (use-local-map forms-mode-map)
X    (use-local-map (make-sparse-keymap))
X    (define-key (current-local-map) "\C-c" forms-mode-map)
X    (define-key (current-local-map) "\t"   'forms-next-field)))
X
X(defun forms--mode-commands (map)
X  "Fill map with all commands."
X  (define-key map "\t" 'forms-next-field)
X  (define-key map " " 'forms-next-record)
X  (define-key map "d" 'forms-delete-record)
X  (define-key map "e" 'forms-edit-mode)
X  (define-key map "i" 'forms-insert-record)
X  (define-key map "j" 'forms-jump-record)
X  (define-key map "n" 'forms-next-record)
X  (define-key map "p" 'forms-prev-record)
X  (define-key map "q" 'forms-exit)
X  (define-key map "s" 'forms-search)
X  (define-key map "v" 'forms-view-mode)
X  (define-key map "x" 'forms-exit-no-save)
X  (define-key map "<" 'forms-first-record)
X  (define-key map ">" 'forms-last-record)
X  (define-key map "?" 'describe-mode)
X  (define-key map "\177" 'forms-prev-record)
X ;  (define-key map "\C-c" map)
X  (define-key map "\e" 'ESC-prefix)
X  (define-key map "\C-x" ctl-x-map)
X  (define-key map "\C-u" 'universal-argument)
X  (define-key map "\C-h" help-map)
X  )
X;;;
X;;; Changed functions
X;;;
X;;; Emacs (as of 18.55) lacks the functionality of buffer-local
X;;; funtions. Therefore we save the original meaning of some handy
X;;; functions, and replace them with a wrapper.
X
X(defun forms--change-commands ()
X  "Localize some commands."
X  ;;
X  ;; scroll-down -> forms-prev-record
X  ;;
X  (if (fboundp 'forms--scroll-down)
X      nil
X    (fset 'forms--scroll-down (symbol-function 'scroll-down))
X    (fset 'scroll-down
X	  '(lambda (&optional arg) 
X	     (interactive "P")
X	     (if (and forms--mode-setup
X		      forms-forms-scroll)
X		 (forms-prev-record arg)
X	       (forms--scroll-down arg)))))
X  ;;
X  ;; scroll-up -> forms-next-record
X  ;;
X  (if (fboundp 'forms--scroll-up)
X      nil
X    (fset 'forms--scroll-up   (symbol-function 'scroll-up))
X    (fset 'scroll-up
X	  '(lambda (&optional arg) 
X	     (interactive "P")
X	     (if (and forms--mode-setup
X		      forms-forms-scroll)
X		 (forms-next-record arg)
X	       (forms--scroll-up arg)))))
X  ;;
X  ;; beginning-of-buffer -> forms-first-record
X  ;;
X  (if (fboundp 'forms--beginning-of-buffer)
X      nil
X    (fset 'forms--beginning-of-buffer (symbol-function 'beginning-of-buffer))
X    (fset 'beginning-of-buffer
X	  '(lambda ()
X	     (interactive)
X	     (if (and forms--mode-setup
X		      forms-forms-jump)
X		 (forms-first-record)
X	       (forms--beginning-of-buffer)))))
X  ;;
X  ;; end-of-buffer -> forms-end-record
X  ;;
X  (if (fboundp 'forms--end-of-buffer)
X      nil
X    (fset 'forms--end-of-buffer (symbol-function 'end-of-buffer))
X    (fset 'end-of-buffer
X	  '(lambda ()
X	     (interactive)
X	     (if (and forms--mode-setup
X		      forms-forms-jump)
X		 (forms-last-record)
X	       (forms--end-of-buffer)))))
X  ;;
X  ;; save-buffer -> forms--save-buffer
X  ;;
X  (if (fboundp 'forms--save-buffer)
X      nil
X    (fset 'forms--save-buffer (symbol-function 'save-buffer))
X    (fset 'save-buffer
X	  '(lambda (&optional arg)
X	     (interactive "p")
X	     (if forms--mode-setup
X		 (progn
X		   (forms--checkmod)
X		   (save-excursion
SHAR_EOF
true || echo 'restore of forms.el failed'
fi
echo 'End of forms part 1'
echo 'File forms.el is continued in part 2'
echo 2 > _shar_seq_.tmp
exit 0
-- 
Johan Vromans				       jv@mh.nl via internet backbones
Multihouse Automatisering bv		       uucp:..!{uunet,sun4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: +31 1820 62911/62500
------------------------ "Arms are made for hugging" -------------------------
Technical Details
Message-ID: <1992Jan14.143519.7618@pronto.mh.nl>
Path: arc1-ca.pugleaf.net!wupost!zaphod.mps.ohio-state.edu!qt.cs.utexas.edu!yale.edu!jvnc.net!darwin.sura.net!europa.asd.contel.com!uunet!mcsun!sun4nl!mhres!pronto!jv

Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!wupost!zaphod.mps.ohio-state.edu!qt.cs.utexas.edu!yale.edu!jvnc.net!darwin.sura.net!europa.asd.contel.com!uunet!mcsun!sun4nl!mhres!pronto!jv
From: jv@mh.nl (Johan Vromans)
Newsgroups: gnu.emacs.sources,alt.sources
Subject: GNU Emacs forms-mode version 1.2.9 (part 1 of 3)
Message-ID: <1992Jan14.143519.7618@pronto.mh.nl>
Date: 14 Jan 92 14:35:19 GMT
Sender: jv@pronto.mh.nl (Johan Vromans)
Distribution: gnu
Organization: Multihouse Automation, the Netherlands
Lines: 926
X-Md4-Signature: c73c90202bafb6e06faf82653b6c2b67