forms.el 65.4 KB
Newer Older
1
;;; forms.el -- Forms mode: edit a file as a form to fill in.
2
;;; Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
3

4
;; Author: Johan Vromans <jv@nl.net>
5 6 7 8 9 10 11 12 13 14 15 16

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
Brian Preble's avatar
Brian Preble committed
17

18 19 20 21 22
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:
Brian Preble's avatar
Brian Preble committed
23 24 25 26 27

;;; Visit a file using a form.
;;;
;;; === Naming conventions
;;;
28 29
;;; The names of all variables and functions start with 'forms-'.
;;; Names which start with 'forms--' are intended for internal use, and
Brian Preble's avatar
Brian Preble committed
30 31 32 33
;;; should *NOT* be used from the outside.
;;;
;;; All variables are buffer-local, to enable multiple forms visits 
;;; simultaneously.
34
;;; Variable `forms--mode-setup' is local to *ALL* buffers, for it 
Brian Preble's avatar
Brian Preble committed
35 36 37 38 39
;;; 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
40
;;; of records each containing a number of fields.  The records are
Brian Preble's avatar
Brian Preble committed
41 42
;;; separated by a newline, the fields are separated by a user-defined
;;; field separater (default: TAB).
43
;;; When shown, a record is transferred to an Emacs buffer and
44
;;; presented using a user-defined form.  One record is shown at a
Brian Preble's avatar
Brian Preble committed
45 46
;;; time.
;;;
47
;;; Forms mode is a composite mode.  It involves two files, and two
Brian Preble's avatar
Brian Preble committed
48 49
;;; buffers.
;;; The first file, called the control file, defines the name of the
50
;;; data file and the forms format.  This file buffer will be used to
Brian Preble's avatar
Brian Preble committed
51
;;; present the forms.
52
;;; The second file holds the actual data.  The buffer of this file
Brian Preble's avatar
Brian Preble committed
53 54
;;; will be buried, for it is never accessed directly.
;;;
55 56
;;; Forms mode is invoked using M-x forms-find-file control-file .
;;; Alternativily `forms-find-file-other-window' can be used.
Brian Preble's avatar
Brian Preble committed
57 58 59 60
;;;
;;; You may also visit the control file, and switch to forms mode by hand
;;; with M-x forms-mode .
;;;
61 62
;;; Automatic mode switching is supported if you specify 
;;; "-*- forms -*-" in the first line of the control file.
Brian Preble's avatar
Brian Preble committed
63
;;; 
64 65
;;; The control file is visited, evaluated using `eval-current-buffer',
;;; and should set at least the following variables:
Brian Preble's avatar
Brian Preble committed
66
;;;
67 68
;;;	forms-file				[string]
;;;			The name of the data file.
Brian Preble's avatar
Brian Preble committed
69
;;;
70
;;;	forms-number-of-fields			[integer]
Brian Preble's avatar
Brian Preble committed
71 72
;;;			The number of fields in each record.
;;;
73 74
;;;	forms-format-list			[list]
;;;			Formatting instructions.
Brian Preble's avatar
Brian Preble committed
75
;;;
76
;;; `forms-format-list' should be a list, each element containing
Brian Preble's avatar
Brian Preble committed
77
;;;
78 79 80 81 82 83 84 85 86 87 88 89 90 91
;;;   - a string, e.g. "hello".  The string is inserted in the forms
;;;	"as is".
;;;   
;;;   - an integer, denoting a field number.
;;;	The contents of this field are inserted at this point.
;;;     Fields are numbered starting with 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.
92
;;;
Brian Preble's avatar
Brian Preble committed
93 94 95 96
;;; Optional variables which may be set in the control file:
;;;
;;;	forms-field-sep				[string, default TAB]
;;;			The field separator used to separate the
97
;;;			fields in the data file.  It may be a string.
Brian Preble's avatar
Brian Preble committed
98 99
;;;
;;;	forms-read-only				[bool, default nil]
100 101
;;;			Non-nil means that the data file is visited
;;;			read-only (view mode) as opposed to edit mode.
Brian Preble's avatar
Brian Preble committed
102
;;;			If no write access to the data file is
103
;;;			possible, view mode is enforced. 
Brian Preble's avatar
Brian Preble committed
104 105 106
;;;
;;;	forms-multi-line			[string, default "^K"]
;;;			If non-null the records of the data file may
107
;;;			contain fields that can span multiple lines in
Brian Preble's avatar
Brian Preble committed
108
;;;			the form.
109
;;;			This variable denotes the separator character
110
;;;			to be used for this purpose.  Upon display, all
Brian Preble's avatar
Brian Preble committed
111
;;;			occurrencies of this character are translated
112
;;;			to newlines.  Upon storage they are translated
113
;;;			back to the separator character.
Brian Preble's avatar
Brian Preble committed
114
;;;
Richard M. Stallman's avatar
Richard M. Stallman committed
115
;;;	forms-forms-scroll			[bool, default nil]
116 117 118
;;;			Non-nil means: rebind locally the commands that
;;;			perform `scroll-up' or `scroll-down' to use
;;;			`forms-next-field' resp. `forms-prev-field'.
Brian Preble's avatar
Brian Preble committed
119
;;;
Richard M. Stallman's avatar
Richard M. Stallman committed
120
;;;	forms-forms-jump			[bool, default nil]
121 122 123
;;;			Non-nil means: rebind locally the commands that
;;;			perform `beginning-of-buffer' or `end-of-buffer'
;;;			to perform `forms-first-field' resp. `forms-last-field'.
Brian Preble's avatar
Brian Preble committed
124
;;;
125 126 127 128 129 130 131 132 133 134 135 136 137
;;;	forms-read-file-filter			[symbol, default nil]
;;;			If not nil: this should be the name of a 
;;;			function that is called after the forms data file
;;;			has been read.  It can be used to transform
;;;			the contents of the file into a format more suitable
;;;			for forms-mode processing.
;;;
;;;	forms-write-file-filter			[symbol, default nil]
;;;			If not nil: this should be the name of a 
;;;			function that is called before the forms data file
;;;			is written (saved) to disk.  It can be used to undo
;;;			the effects of `forms-read-file-filter', if any.
;;;
Richard M. Stallman's avatar
Richard M. Stallman committed
138 139
;;;	forms-new-record-filter			[symbol, default nil]
;;;			If not nil: this should be the name of a 
140
;;;			function that is called when a new
141
;;;			record is created.  It can be used to fill in
Brian Preble's avatar
Brian Preble committed
142
;;;			the new record with default fields, for example.
143
;;;
Richard M. Stallman's avatar
Richard M. Stallman committed
144 145
;;;	forms-modified-record-filter		[symbol, default nil]
;;;			If not nil: this should be the name of a 
146
;;;			function that is called when a record has
147 148
;;;			been modified.  It is called after the fields
;;;			are parsed.  It can be used to register
149
;;;			modification dates, for example.
Brian Preble's avatar
Brian Preble committed
150
;;;
151 152 153 154 155 156
;;;	forms-use-text-properties		[bool, see text for default]
;;;			This variable controls if forms mode should use
;;;			text properties to protect the form text from being
;;;			modified (using text-property `read-only').
;;;			Also, the read-write fields are shown using a
;;;			distinct face, if possible.
157 158
;;;			As of emacs 19.29, the `intangible' text property
;;;			is used to prevent moving into read-only fields.
159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
;;;			This variable defaults to t if running Emacs 19
;;;			with text properties.
;;;			The default face to show read-write fields is
;;;			copied from face `region'.
;;;
;;;	forms-ro-face 				[symbol, default 'default]
;;;			This is the face that is used to show
;;;			read-only text on the screen.If used, this
;;;			variable should be set to a symbol that is a
;;;			valid face.
;;;			E.g.
;;;			  (make-face 'my-face)
;;;			  (setq forms-ro-face 'my-face)
;;;
;;;	forms-rw-face				[symbol, default 'region]
;;;			This is the face that is used to show
;;;			read-write text on the screen.
;;;
Brian Preble's avatar
Brian Preble committed
177 178
;;; After evaluating the control file, its buffer is cleared and used
;;; for further processing.
179 180
;;; The data file (as designated by `forms-file') is visited in a buffer
;;; `forms--file-buffer' which will not normally be shown.
Brian Preble's avatar
Brian Preble committed
181
;;; Great malfunctioning may be expected if this file/buffer is modified
182
;;; outside of this package while it is being visited!
Brian Preble's avatar
Brian Preble committed
183
;;;
184 185 186 187 188
;;; Normal operation is to transfer one line (record) from the data file,
;;; split it into fields (into `forms--the-record-list'), and display it
;;; using the specs in `forms-format-list'.
;;; A format routine `forms--format' is built upon startup to format 
;;; the records according to `forms-format-list'.
Brian Preble's avatar
Brian Preble committed
189 190
;;;
;;; When a form is changed the record is updated as soon as this form
191 192 193 194 195 196
;;; is left.  The contents of the form are parsed using information
;;; obtained from `forms-format-list', and the fields which are
;;; deduced from the form are modified.  Fields not shown on the forms
;;; retain their origional values.  The newly formed record then
;;; replaces the contents of the old record in `forms--file-buffer'.
;;; A parse routine `forms--parser' is built upon startup to parse
Brian Preble's avatar
Brian Preble committed
197 198
;;; the records.
;;;
199 200 201 202 203
;;; Two exit functions exist: `forms-exit' and `forms-exit-no-save'.
;;; `forms-exit' saves the data to the file, if modified.
;;; `forms-exit-no-save` does not.  However, if `forms-exit-no-save'
;;; is executed and the file buffer has been modified, Emacs will ask
;;; questions anyway.
Brian Preble's avatar
Brian Preble committed
204
;;;
205
;;; Other functions provided by forms mode are:
Brian Preble's avatar
Brian Preble committed
206 207 208 209 210 211 212 213 214 215 216 217 218
;;;
;;;	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.
;;;
Richard M. Stallman's avatar
Richard M. Stallman committed
219 220 221
;;; The forms buffer can be in on eof two modes: edit mode or view
;;; mode.  View mode is a read-only mode, you cannot modify the
;;; contents of the buffer.
Brian Preble's avatar
Brian Preble committed
222
;;;
Richard M. Stallman's avatar
Richard M. Stallman committed
223 224 225 226 227 228 229 230 231 232 233 234 235
;;; Edit mode commands:
;;; 
;;; TAB		 forms-next-field
;;; \C-c TAB	 forms-next-field
;;; \C-c <	 forms-first-record
;;; \C-c >	 forms-last-record
;;; \C-c ?	 describe-mode
;;; \C-c \C-k	 forms-delete-record
;;; \C-c \C-q	 forms-toggle-read-only
;;; \C-c \C-o	 forms-insert-record
;;; \C-c \C-l	 forms-jump-record
;;; \C-c \C-n	 forms-next-record
;;; \C-c \C-p	 forms-prev-record
236 237
;;; \C-c \C-r	 forms-search-backward
;;; \C-c \C-s	 forms-search-forward
Richard M. Stallman's avatar
Richard M. Stallman committed
238 239 240 241 242 243 244 245 246 247 248
;;; \C-c \C-x	 forms-exit
;;; 
;;; Read-only mode commands:
;;; 
;;; SPC 	 forms-next-record
;;; DEL	 forms-prev-record
;;; ?	 describe-mode
;;; \C-q forms-toggle-read-only
;;; l	 forms-jump-record
;;; n	 forms-next-record
;;; p	 forms-prev-record
249 250
;;; r	 forms-search-backward
;;; s	 forms-search-forward
Richard M. Stallman's avatar
Richard M. Stallman committed
251 252 253 254 255 256 257 258 259 260 261 262 263
;;; x	 forms-exit
;;; 
;;; Of course, it is also possible to use the \C-c prefix to obtain the
;;; same command keys as in edit mode.
;;; 
;;; The following bindings are available, independent of the mode: 
;;; 
;;; [next]	  forms-next-record
;;; [prior]	  forms-prev-record
;;; [begin]	  forms-first-record
;;; [end]	  forms-last-record
;;; [S-TAB]	  forms-prev-field
;;; [backtab] forms-prev-field
Brian Preble's avatar
Brian Preble committed
264
;;;
265 266 267 268 269
;;; For convenience, TAB is always bound to `forms-next-field', so you
;;; don't need the C-c prefix for this command.
;;;
;;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump')
;;; the bindings of standard functions `scroll-up', `scroll-down',
Richard M. Stallman's avatar
Richard M. Stallman committed
270
;;; `beginning-of-buffer' and `end-of-buffer' can be locally replaced with
271
;;; forms mode functions next/prev record and first/last
272
;;; record.
Brian Preble's avatar
Brian Preble committed
273
;;;
274 275
;;; `local-write-file hook' is defined to save the actual data file
;;; instead of the buffer data, `revert-file-hook' is defined to
276
;;; revert a forms to original.
277 278 279

;;; Code:

280
;;; Global variables and constants:
Brian Preble's avatar
Brian Preble committed
281

282 283 284
(provide 'forms)			;;; official
(provide 'forms-mode)			;;; for compatibility

285
(defconst forms-version (substring "$Revision: 2.14 $" 11 -2)
Richard M. Stallman's avatar
Richard M. Stallman committed
286 287
  "The version number of forms-mode (as string).  The complete RCS id is:

288
  $Id: forms.el,v 2.14 1995/04/16 14:02:14 jv Exp $")
Brian Preble's avatar
Brian Preble committed
289 290

(defvar forms-mode-hooks nil
291 292
  "Hook functions to be run upon entering Forms mode.")

293
;;; Mandatory variables - must be set by evaluating the control file.
Brian Preble's avatar
Brian Preble committed
294 295

(defvar forms-file nil
296
  "Name of the file holding the data.")
Brian Preble's avatar
Brian Preble committed
297 298

(defvar forms-format-list nil
299
  "List of formatting specifications.")
Brian Preble's avatar
Brian Preble committed
300 301 302

(defvar forms-number-of-fields nil
  "Number of fields per record.")
303

304
;;; Optional variables with default values.
Brian Preble's avatar
Brian Preble committed
305 306

(defvar forms-field-sep "\t"
307
  "Field separator character (default TAB).")
Brian Preble's avatar
Brian Preble committed
308 309

(defvar forms-read-only nil
310
  "Non-nil means: visit the file in view (read-only) mode.
Richard M. Stallman's avatar
Richard M. Stallman committed
311
\(Defaults to the write access on the data file).")
Brian Preble's avatar
Brian Preble committed
312 313

(defvar forms-multi-line "\C-k"
314
  "If not nil: use this character to separate multi-line fields (default C-k).")
Brian Preble's avatar
Brian Preble committed
315

Richard M. Stallman's avatar
Richard M. Stallman committed
316
(defvar forms-forms-scroll nil
Richard M. Stallman's avatar
Richard M. Stallman committed
317 318
  "*Non-nil means replace scroll-up/down commands in Forms mode.
The replacement commands performs forms-next/prev-record.")
Brian Preble's avatar
Brian Preble committed
319

Richard M. Stallman's avatar
Richard M. Stallman committed
320
(defvar forms-forms-jump nil
Richard M. Stallman's avatar
Richard M. Stallman committed
321 322
  "*Non-nil means redefine beginning/end-of-buffer in Forms mode.
The replacement commands performs forms-first/last-record.")
323

324 325 326 327 328 329 330 331 332
(defvar forms-read-file-filter nil
  "The name of a function that is called after reading the data file.
This can be used to change the contents of the file to something more
suitable for forms processing.")

(defvar forms-write-file-filter nil
  "The name of a function that is called before writing the data file.
This can be used to undo the effects of form-read-file-hook.")

333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352
(defvar forms-new-record-filter nil
  "The name of a function that is called when a new record is created.")

(defvar forms-modified-record-filter nil
  "The name of a function that is called when a record has been modified.")

(defvar forms-fields nil
  "List with fields of the current forms.  First field has number 1.
This variable is for use by the filter routines only. 
The contents may NOT be modified.")

(defvar forms-use-text-properties (fboundp 'set-text-properties)
  "*Non-nil means: use emacs-19 text properties.
Defaults to t if this emacs is capable of handling text properties.")

(defvar forms-ro-face 'default
  "The face (a symbol) that is used to display read-only text on the screen.")

(defvar forms-rw-face 'region
  "The face (a symbol) that is used to display read-write text on the screen.")
353

Brian Preble's avatar
Brian Preble committed
354 355 356 357 358 359 360 361 362 363 364
;;; 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.")

Richard M. Stallman's avatar
Richard M. Stallman committed
365
(defvar forms-mode-map nil
Brian Preble's avatar
Brian Preble committed
366
   "Keymap for form buffer.")
Richard M. Stallman's avatar
Richard M. Stallman committed
367 368 369 370
(defvar forms-mode-ro-map nil
   "Keymap for form buffer in view mode.")
(defvar forms-mode-edit-map nil
   "Keymap for form buffer in edit mode.")
Brian Preble's avatar
Brian Preble committed
371 372 373 374

(defvar forms--markers nil
  "Field markers in the screen.")

375 376
(defvar forms--dyntexts nil
  "Dynamic texts (resulting from function calls) on the screen.")
Brian Preble's avatar
Brian Preble committed
377 378 379 380 381

(defvar forms--the-record-list nil 
   "List of strings of the current record, as parsed from the file.")

(defvar forms--search-regexp nil
382
  "Last regexp used by forms-search functions.")
Brian Preble's avatar
Brian Preble committed
383 384 385 386 387 388 389 390

(defvar forms--format nil
  "Formatting routine.")

(defvar forms--parser nil
  "Forms parser routine.")

(defvar forms--mode-setup nil
391
  "To keep track of forms-mode being set-up.")
Brian Preble's avatar
Brian Preble committed
392 393
(make-variable-buffer-local 'forms--mode-setup)

394
(defvar forms--dynamic-text nil
395
  "Array that holds dynamic texts to insert between fields.")
396

397 398
(defvar forms--elements nil
  "Array with the order in which the fields are displayed.")
399

400 401
(defvar forms--ro-face nil
  "Face used to represent read-only data on the screen.")
402

403 404
(defvar forms--rw-face nil
  "Face used to represent read-write data on the screen.")
405

406
;;;###autoload 
Brian Preble's avatar
Brian Preble committed
407 408 409
(defun forms-mode (&optional primary)
  "Major mode to visit files in a field-structured manner using a form.

Richard M. Stallman's avatar
Richard M. Stallman committed
410 411 412 413 414 415 416 417 418 419 420 421
Commands:                        Equivalent keys in read-only mode:
 TAB            forms-next-field          TAB
 \\C-c TAB       forms-next-field          
 \\C-c <         forms-first-record         <
 \\C-c >         forms-last-record          >
 \\C-c ?         describe-mode              ?
 \\C-c \\C-k      forms-delete-record
 \\C-c \\C-q      forms-toggle-read-only     q
 \\C-c \\C-o      forms-insert-record
 \\C-c \\C-l      forms-jump-record          l
 \\C-c \\C-n      forms-next-record          n
 \\C-c \\C-p      forms-prev-record          p
422 423
 \\C-c \\C-r      forms-search-reverse       r
 \\C-c \\C-s      forms-search-forward       s
Richard M. Stallman's avatar
Richard M. Stallman committed
424 425 426
 \\C-c \\C-x      forms-exit                 x
"
  (interactive)
Brian Preble's avatar
Brian Preble committed
427

428 429 430 431 432 433 434 435 436 437
  ;; 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 have deliberately
  ;; placed all calls in this function.

Brian Preble's avatar
Brian Preble committed
438 439 440 441
  ;; Primary set-up: evaluate buffer and check if the mandatory
  ;; variables have been set.
  (if (or primary (not forms--mode-setup))
      (progn
442
	;;(message "forms: setting up...")
Brian Preble's avatar
Brian Preble committed
443 444
	(kill-all-local-variables)

445
	;; Make mandatory variables.
Brian Preble's avatar
Brian Preble committed
446 447 448 449
	(make-local-variable 'forms-file)
	(make-local-variable 'forms-number-of-fields)
	(make-local-variable 'forms-format-list)

450
	;; Make optional variables.
Brian Preble's avatar
Brian Preble committed
451 452 453 454 455
	(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)
456
	(make-local-variable 'forms-use-text-properties)
457 458 459 460

	;; Filter functions.
	(make-local-variable 'forms-read-file-filter)
	(make-local-variable 'forms-write-file-filter)
Richard M. Stallman's avatar
Richard M. Stallman committed
461 462
	(make-local-variable 'forms-new-record-filter)
	(make-local-variable 'forms-modified-record-filter)
463 464

	;; Make sure no filters exist.
465 466
	(setq forms-read-file-filter nil)
	(setq forms-write-file-filter nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
467 468
	(setq forms-new-record-filter nil)
	(setq forms-modified-record-filter nil)
469 470 471 472 473 474 475

	;; If running Emacs 19 under X, setup faces to show read-only and 
	;; read-write fields.
	(if (fboundp 'make-face)
	    (progn
	      (make-local-variable 'forms-ro-face)
	      (make-local-variable 'forms-rw-face)))
Brian Preble's avatar
Brian Preble committed
476 477

	;; eval the buffer, should set variables
478
	;;(message "forms: processing control file...")
479 480 481 482 483 484 485
	;; If enable-local-eval is not set to t the user is asked first.
	(if (or (eq enable-local-eval t)
		(yes-or-no-p 
		 (concat "Evaluate lisp code in buffer "
			 (buffer-name) " to display forms ")))
	    (eval-current-buffer)
	  (error "`enable-local-eval' inhibits buffer evaluation"))
Brian Preble's avatar
Brian Preble committed
486

487
	;; Check if the mandatory variables make sense.
Brian Preble's avatar
Brian Preble committed
488
	(or forms-file
Richard M. Stallman's avatar
Richard M. Stallman committed
489 490
	    (error (concat "Forms control file error: " 
			   "'forms-file' has not been set")))
491 492 493

	;; Check forms-field-sep first, since it can be needed to
	;; construct a default format list.
Richard M. Stallman's avatar
Richard M. Stallman committed
494 495 496
	(or (stringp forms-field-sep)
	    (error (concat "Forms control file error: "
			   "'forms-field-sep' is not a string")))
497 498 499 500 501 502 503 504 505 506 507 508 509

	(if forms-number-of-fields
	    (or (and (numberp forms-number-of-fields)
		     (> forms-number-of-fields 0))
		(error (concat "Forms control file error: "
			       "'forms-number-of-fields' must be a number > 0")))
	  (or (null forms-format-list)
	      (error (concat "Forms control file error: "
			     "'forms-number-of-fields' has not been set"))))

	(or forms-format-list
	    (forms--intuit-from-file))

Brian Preble's avatar
Brian Preble committed
510 511 512 513
	(if forms-multi-line
	    (if (and (stringp forms-multi-line)
		     (eq (length forms-multi-line) 1))
		(if (string= forms-multi-line forms-field-sep)
Richard M. Stallman's avatar
Richard M. Stallman committed
514 515 516 517
		    (error (concat "Forms control file error: " 
				   "'forms-multi-line' is equal to 'forms-field-sep'")))
	      (error (concat "Forms control file error: "
			     "'forms-multi-line' must be nil or a one-character string"))))
518 519
	(or (fboundp 'set-text-properties)
	    (setq forms-use-text-properties nil))
Brian Preble's avatar
Brian Preble committed
520
	    
521 522
	;; Validate and process forms-format-list.
	;;(message "forms: pre-processing format list...")
Brian Preble's avatar
Brian Preble committed
523 524
	(forms--process-format-list)

525 526
	;; Build the formatter and parser.
	;;(message "forms: building formatter...")
Brian Preble's avatar
Brian Preble committed
527
	(make-local-variable 'forms--format)
528 529 530 531
	(make-local-variable 'forms--markers)
	(make-local-variable 'forms--dyntexts)
	(make-local-variable 'forms--elements)
	;;(message "forms: building parser...")
Brian Preble's avatar
Brian Preble committed
532 533 534
	(forms--make-format)
	(make-local-variable 'forms--parser)
	(forms--make-parser)
535
	;;(message "forms: building parser... done.")
Brian Preble's avatar
Brian Preble committed
536

537
	;; Check if record filters are defined.
Richard M. Stallman's avatar
Richard M. Stallman committed
538 539 540 541 542 543 544 545 546
	(if (and forms-new-record-filter
		 (not (fboundp forms-new-record-filter)))
	    (error (concat "Forms control file error: "
			   "'forms-new-record-filter' is not a function")))

	(if (and forms-modified-record-filter
		 (not (fboundp forms-modified-record-filter)))
	    (error (concat "Forms control file error: "
			   "'forms-modified-record-filter' is not a function")))
547

548
	;; The filters acces the contents of the forms using `forms-fields'.
549
	(make-local-variable 'forms-fields)
Brian Preble's avatar
Brian Preble committed
550

551 552
	;; Dynamic text support.
	(make-local-variable 'forms--dynamic-text)
Brian Preble's avatar
Brian Preble committed
553

554
	;; Prevent accidental overwrite of the control file and autosave.
555
	(set-visited-file-name nil)
Brian Preble's avatar
Brian Preble committed
556

557 558 559 560 561 562 563
	;; Prepare this buffer for further processing.
	(setq buffer-read-only nil)
	(erase-buffer)

	;;(message "forms: setting up... done.")
	))

564 565 566
  ;; initialization done
  (setq forms--mode-setup t)

567 568 569 570 571 572 573 574 575 576 577
  ;; Copy desired faces to the actual variables used by the forms formatter.
  (if (fboundp 'make-face)
      (progn
	(make-local-variable 'forms--ro-face)
	(make-local-variable 'forms--rw-face)
	(if forms-read-only
	    (progn
	      (setq forms--ro-face forms-ro-face)
	      (setq forms--rw-face forms-ro-face))
	  (setq forms--ro-face forms-ro-face)
	  (setq forms--rw-face forms-rw-face))))
Brian Preble's avatar
Brian Preble committed
578

579
  ;; Make more local variables.
Brian Preble's avatar
Brian Preble committed
580 581 582 583
  (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)
584
  (make-local-variable 'forms--search-regexp)
Brian Preble's avatar
Brian Preble committed
585

Richard M. Stallman's avatar
Richard M. Stallman committed
586 587 588 589
  ; The keymaps are global, so multiple forms mode buffers can share them.
  ;(make-local-variable 'forms-mode-map)
  ;(make-local-variable 'forms-mode-ro-map)
  ;(make-local-variable 'forms-mode-edit-map)
Brian Preble's avatar
Brian Preble committed
590 591
  (if forms-mode-map			; already defined
      nil
592
    ;;(message "forms: building keymap...")
Richard M. Stallman's avatar
Richard M. Stallman committed
593
    (forms--mode-commands)
594 595
    ;;(message "forms: building keymap... done.")
    )
Brian Preble's avatar
Brian Preble committed
596

597 598 599 600
  ;; set the major mode indicator
  (setq major-mode 'forms-mode)
  (setq mode-name "Forms")

Brian Preble's avatar
Brian Preble committed
601 602 603
  ;; find the data file
  (setq forms--file-buffer (find-file-noselect forms-file))

604 605 606 607 608 609
  ;; Pre-transform.
  (let ((read-file-filter forms-read-file-filter)
	(write-file-filter forms-write-file-filter))
    (if read-file-filter
	(save-excursion
	  (set-buffer forms--file-buffer)
610 611 612 613
	  (let ((inhibit-read-only t)
		(file-modified (buffer-modified-p)))
	    (run-hooks 'read-file-filter)
	    (if (not file-modified) (set-buffer-modified-p nil)))
614 615 616 617 618 619 620 621 622 623
	  (if write-file-filter
	      (progn
		(make-variable-buffer-local 'local-write-file-hooks)
		(setq local-write-file-hooks (list write-file-filter)))))
      (if write-file-filter
	  (save-excursion
	    (set-buffer forms--file-buffer)
	    (make-variable-buffer-local 'local-write-file-hooks)
	    (setq local-write-file-hooks write-file-filter)))))

Brian Preble's avatar
Brian Preble committed
624 625 626 627
  ;; count the number of records, and set see if it may be modified
  (let (ro)
    (setq forms--total-records
	  (save-excursion
628 629 630 631 632 633 634 635 636
	    (prog1
		(progn
		  ;;(message "forms: counting records...")
		  (set-buffer forms--file-buffer)
		  (bury-buffer (current-buffer))
		  (setq ro buffer-read-only)
		  (count-lines (point-min) (point-max)))
	      ;;(message "forms: counting records... done.")
	      )))
Brian Preble's avatar
Brian Preble committed
637 638 639
    (if ro
	(setq forms-read-only t)))

640
  ;;(message "forms: proceeding setup...")
641 642 643 644 645 646 647

  ;; Since we aren't really implementing a minor mode, we hack the modeline
  ;; directly to get the text " View " into forms-read-only form buffers.  For
  ;; that reason, this variable must be buffer only.
  (make-local-variable 'minor-mode-alist)
  (setq minor-mode-alist (list (list 'forms-read-only " View")))

648
  ;;(message "forms: proceeding setup (keymaps)...")
Brian Preble's avatar
Brian Preble committed
649
  (forms--set-keymaps)
650
  ;;(message "forms: proceeding setup (commands)...")
651
  (forms--change-commands)
Brian Preble's avatar
Brian Preble committed
652

653
  ;;(message "forms: proceeding setup (buffer)...")
Brian Preble's avatar
Brian Preble committed
654 655
  (set-buffer-modified-p nil)

656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676
  (if (= forms--total-records 0)
      ;;(message "forms: proceeding setup (new file)...")
      (progn
	(insert 
	 "GNU Emacs Forms Mode version " forms-version "\n\n"
	 (if (file-exists-p forms-file)
	     (concat "No records available in file \"" forms-file "\".\n\n")
	   (format "Creating new file \"%s\"\nwith %d field%s per record.\n\n"
		   forms-file forms-number-of-fields
		   (if (= 1 forms-number-of-fields) "" "s")))
	 "Use " (substitute-command-keys "\\[forms-insert-record]")
	 " to create new records.\n")
	(setq forms--current-record 1)
	(setq buffer-read-only t)
	(set-buffer-modified-p nil))

    ;; setup the first (or current) record to show
    (if (< forms--current-record 1)
	(setq forms--current-record 1))
    (forms-jump-record forms--current-record)
    )
Brian Preble's avatar
Brian Preble committed
677 678

  ;; user customising
679
  ;;(message "forms: proceeding setup (user hooks)...")
Brian Preble's avatar
Brian Preble committed
680
  (run-hooks 'forms-mode-hooks)
681
  ;;(message "forms: setting up... done.")
Brian Preble's avatar
Brian Preble committed
682 683 684

  ;; be helpful
  (forms--help)
685
)
686

Brian Preble's avatar
Brian Preble committed
687
(defun forms--process-format-list ()
688 689 690 691 692 693 694 695 696 697 698 699
  ;; Validate `forms-format-list' and set some global variables.
  ;; Symbols in the list are evaluated, and consecutive strings are
  ;; concatenated.
  ;; Array `forms--elements' is constructed that contains the order
  ;; of the fields on the display. This array is used by 
  ;; `forms--parser-using-text-properties' to extract the fields data
  ;; from the form on the screen.
  ;; Upon completion, `forms-format-list' is garanteed correct, so
  ;; `forms--make-format' and `forms--make-parser' do not need to perform
  ;; any checks.

  ;; Verify that `forms-format-list' is not nil.
Brian Preble's avatar
Brian Preble committed
700
  (or forms-format-list
Richard M. Stallman's avatar
Richard M. Stallman committed
701 702
      (error (concat "Forms control file error: "
		     "'forms-format-list' has not been set")))
703
  ;; It must be a list.
Brian Preble's avatar
Brian Preble committed
704
  (or (listp forms-format-list)
Richard M. Stallman's avatar
Richard M. Stallman committed
705 706
      (error (concat "Forms control file error: "
		     "'forms-format-list' is not a list")))
Brian Preble's avatar
Brian Preble committed
707

708 709 710
  ;; Assume every field is painted once.
  ;; `forms--elements' will grow if needed.
  (setq forms--elements (make-vector forms-number-of-fields nil))
Brian Preble's avatar
Brian Preble committed
711 712

  (let ((the-list forms-format-list)	; the list of format elements
713
	(this-item 0)			; element in list
714
	(prev-item nil)
Brian Preble's avatar
Brian Preble committed
715 716
	(field-num 0))			; highest field number 

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

Brian Preble's avatar
Brian Preble committed
719 720 721 722 723
    (while the-list

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

724
	;; If it is a symbol, eval it first.
725 726 727 728
	(if (and (symbolp el)
		 (boundp el))
	    (setq el (eval el)))

Brian Preble's avatar
Brian Preble committed
729 730
	(cond

731 732 733 734 735 736 737 738 739 740
	 ;; Try string ...
	 ((stringp el)
	  (if (stringp prev-item)	; try to concatenate strings
	      (setq prev-item (concat prev-item el))
	    (if prev-item
		(setq forms-format-list
		      (append forms-format-list (list prev-item) nil)))
	    (setq prev-item el)))

	 ;; Try numeric ...
741
	 ((numberp el) 
Brian Preble's avatar
Brian Preble committed
742

743
	  ;; Validate range.
Brian Preble's avatar
Brian Preble committed
744 745
	  (if (or (<= el 0)
		  (> el forms-number-of-fields))
Richard M. Stallman's avatar
Richard M. Stallman committed
746 747 748
	      (error (concat "Forms format error: "
			     "field number %d out of range 1..%d")
		     el forms-number-of-fields))
Brian Preble's avatar
Brian Preble committed
749

750 751 752 753 754 755 756 757
	  ;; Store forms order.
	  (if (> field-num (length forms--elements))
	      (setq forms--elements (vconcat forms--elements (1- el)))
	    (aset forms--elements field-num (1- el)))
	  (setq field-num (1+ field-num))

	  (if prev-item
	      (setq forms-format-list
758
		    (append forms-format-list (list prev-item) nil)))
759 760 761
	  (setq prev-item el))

	 ;; Try function ...
762
	 ((listp el)
763 764

	  ;; Validate.
765
	  (or (fboundp (car-safe el))
Richard M. Stallman's avatar
Richard M. Stallman committed
766 767 768
	      (error (concat "Forms format error: "
			     "not a function "
			     (prin1-to-string (car-safe el)))))
769 770 771 772 773 774

	  ;; Shift.
	  (if prev-item
	      (setq forms-format-list
		    (append forms-format-list (list prev-item) nil)))
	  (setq prev-item el))
775

Brian Preble's avatar
Brian Preble committed
776 777
	 ;; else
	 (t
Richard M. Stallman's avatar
Richard M. Stallman committed
778 779 780
	  (error (concat "Forms format error: "
			 "invalid element "
			 (prin1-to-string el)))))
Brian Preble's avatar
Brian Preble committed
781

782 783
	;; Advance to next element of the list.
	(setq the-list rem)))
Brian Preble's avatar
Brian Preble committed
784

785 786 787 788 789 790
    ;; Append last item.
    (if prev-item
	(progn
	  (setq forms-format-list
		(append forms-format-list (list prev-item) nil))
	  ;; Append a newline if the last item is a field.
791
	  ;; This prevents parsing problems.
792 793 794 795 796 797 798
	  ;; Also it makes it possible to insert an empty last field.
	  (if (numberp prev-item)
	      (setq forms-format-list
		    (append forms-format-list (list "\n") nil))))))

  (forms--debug 'forms-format-list
		'forms--elements))
799

800 801
;; Special treatment for read-only segments.
;;
802
;; If text is inserted between two read-only segments, it inherits the
803
;; read-only properties.  This is not what we want.
804 805 806
;; To solve this, read-only segments get the `insert-in-front-hooks'
;; property set with a function that temporarily switches the properties
;; of the first character of the segment to read-write, so the new
807
;; text gets the right properties.
808 809 810
;; The `post-command-hook' is used to restore the original properties.

(defvar forms--iif-start nil
811
  "Record start of modification command.")
812
(defvar forms--iif-properties nil
813 814
  "Original properties of the character being overridden.")

815 816
(defun forms--iif-hook (begin end)
  "`insert-in-front-hooks' function for read-only segments."
817

818 819 820 821 822
  ;; Note start location.  By making it a marker that points one 
  ;; character beyond the actual location, it is guaranteed to move 
  ;; correctly if text is inserted.
  (or forms--iif-start
      (setq forms--iif-start (copy-marker (1+ (point)))))
823

824 825 826 827 828 829 830 831
  ;; Check if there is special treatment required.
  (if (or (<= forms--iif-start 2)
	  (get-text-property (- forms--iif-start 2)
			     'read-only))
      (progn
	;; Fetch current properties.
	(setq forms--iif-properties 
	      (text-properties-at (1- forms--iif-start)))
832

833 834 835 836 837
	;; Replace them.
	(let ((inhibit-read-only t))
	  (set-text-properties 
	   (1- forms--iif-start) forms--iif-start
	   (list 'face forms--rw-face 'front-sticky '(face))))
838

839 840 841
	;; Enable `post-command-hook' to restore the properties.
	(setq post-command-hook
	      (append (list 'forms--iif-post-command-hook) post-command-hook)))
842

843 844
    ;; No action needed.  Clear marker.
    (setq forms--iif-start nil)))
845

846 847
(defun forms--iif-post-command-hook ()
  "`post-command-hook' function for read-only segments."
848 849 850

  ;; Disable `post-command-hook'.
  (setq post-command-hook
851
	(delq 'forms--iif-hook-post-command-hook post-command-hook))
852 853

  ;; Restore properties.
854
  (if forms--iif-start
855 856
      (let ((inhibit-read-only t))
	(set-text-properties 
857 858
	 (1- forms--iif-start) forms--iif-start
	 forms--iif-properties)))
859 860

  ;; Cleanup.
861
  (setq forms--iif-start nil))
862 863 864

(defvar forms--marker)
(defvar forms--dyntext)
Brian Preble's avatar
Brian Preble committed
865 866

(defun forms--make-format ()
867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882
  "Generate `forms--format' using the information in `forms-format-list'."

  ;; The real work is done using a mapcar of `forms--make-format-elt' on
  ;; `forms-format-list'.
  ;; This function sets up the necessary environment, and decides
  ;; which function to mapcar.

  (let ((forms--marker 0)
	(forms--dyntext 0))
    (setq 
     forms--format
     (if forms-use-text-properties 
	 (` (lambda (arg)
	      (let ((inhibit-read-only t))
		(,@ (apply 'append
			   (mapcar 'forms--make-format-elt-using-text-properties
883 884 885 886 887
				   forms-format-list)))
		;; Prevent insertion before the first text.
		(,@ (if (numberp (car forms-format-list))
			nil
		      '((add-text-properties (point-min) (1+ (point-min))
888
					     '(front-sticky (read-only intangible))))))
889 890 891 892
		;; Prevent insertion after the last text.
		(remove-text-properties (1- (point)) (point)
					'(rear-nonsticky)))
	      (setq forms--iif-start nil)))
893 894 895 896 897 898 899 900
       (` (lambda (arg)
	    (,@ (apply 'append
		       (mapcar 'forms--make-format-elt forms-format-list)))))))

    ;; We have tallied the number of markers and dynamic texts,
    ;; so we can allocate the arrays now.
    (setq forms--markers (make-vector forms--marker nil))
    (setq forms--dyntexts (make-vector forms--dyntext nil)))
901
  (forms--debug 'forms--format))
Brian Preble's avatar
Brian Preble committed
902

903 904 905 906 907 908 909 910 911
(defun forms--make-format-elt-using-text-properties (el)
  "Helper routine to generate format function."

  ;; The format routine `forms--format' will look like
  ;;
  ;; ;; preamble
  ;; (lambda (arg)
  ;;   (let ((inhibit-read-only t))
  ;;
912
  ;;     ;; A string, e.g. "text: ".
913 914 915
  ;;     (set-text-properties 
  ;;      (point)
  ;;      (progn (insert "text: ") (point)) 
916 917 918 919
  ;;      (list 'face forms--ro-face
  ;;		'read-only 1
  ;;		'insert-in-front-hooks 'forms--iif-hook
  ;;		'rear-nonsticky '(read-only face insert-in-front-hooks)))
920
  ;;
921
  ;;     ;; A field, e.g. 6.
922 923 924 925 926 927
  ;;     (let ((here (point)))
  ;;       (aset forms--markers 0 (point-marker))
  ;;       (insert (elt arg 5))
  ;;       (or (= (point) here)
  ;; 	  (set-text-properties 
  ;; 	   here (point)
928 929
  ;; 	   (list 'face forms--rw-face
  ;;		 'front-sticky '(face))))
930
  ;;
931
  ;;     ;; Another string, e.g. "\nmore text: ".
932 933 934 935
  ;;     (set-text-properties
  ;;      (point)
  ;;      (progn (insert "\nmore text: ") (point))
  ;;      (list 'face forms--ro-face
936 937 938
  ;;		'read-only 2
  ;;		'insert-in-front-hooks 'forms--iif-hook
  ;;		'rear-nonsticky '(read-only face insert-in-front-hooks)))
939
  ;;
940
  ;;     ;; A function, e.g. (tocol 40).
941 942 943 944 945 946
  ;;     (set-text-properties
  ;;      (point)
  ;;      (progn
  ;;        (insert (aset forms--dyntexts 0 (tocol 40)))
  ;;        (point))
  ;;      (list 'face forms--ro-face
947 948 949 950 951 952 953 954 955 956
  ;;		'read-only 2
  ;;		'insert-in-front-hooks 'forms--iif-hook
  ;;		'rear-nonsticky '(read-only face insert-in-front-hooks)))
  ;;
  ;;	 ;; Prevent insertion before the first text.
  ;;	 (add-text-properties (point-min) (1+ (point-min))
  ;;			      '(front-sticky (read-only))))))
  ;;	 ;; Prevent insertion after the last text.
  ;;	 (remove-text-properties (1- (point)) (point)
  ;;	 			 '(rear-nonsticky)))
957 958
  ;;
  ;;     ;; wrap up
959
  ;;     (setq forms--iif-start nil)
960 961 962 963 964 965 966 967 968 969 970
  ;;     ))

  (cond
   ((stringp el)
    
    (` ((set-text-properties 
	 (point)			; start at point
	 (progn				; until after insertion
	   (insert (, el))
	   (point))
	 (list 'face forms--ro-face	; read-only appearance
971
	       'read-only (,@ (list (1+ forms--marker)))
972
	       'intangible t
973
	       'insert-in-front-hooks '(forms--iif-hook)
974 975
	       'rear-nonsticky '(face read-only insert-in-front-hooks
				 intangible))))))
976
    
977 978 979 980 981 982 983 984 985 986
   ((numberp el)
    (` ((let ((here (point)))
	  (aset forms--markers 
		(, (prog1 forms--marker
		     (setq forms--marker (1+ forms--marker))))
		(point-marker))
	  (insert (elt arg (, (1- el))))
	  (or (= (point) here)
	      (set-text-properties 
	       here (point)
987 988
	       (list 'face forms--rw-face
		     'front-sticky '(face))))))))
989 990 991 992 993 994 995 996 997 998 999

   ((listp el)
    (` ((set-text-properties
	 (point)
	 (progn
	   (insert (aset forms--dyntexts 
			 (, (prog1 forms--dyntext
			      (setq forms--dyntext (1+ forms--dyntext))))
			 (, el)))
	   (point))
	 (list 'face forms--ro-face
1000
	       'read-only (,@ (list (1+ forms--marker)))
1001
	       'intangible t
1002
	       'insert-in-front-hooks '(forms--iif-hook)
1003 1004
	       'rear-nonsticky '(read-only face insert-in-front-hooks
				 intangible))))))
1005 1006 1007

   ;; end of cond
   ))
Brian Preble's avatar
Brian Preble committed
1008 1009

(defun forms--make-format-elt (el)
1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026
  "Helper routine to generate format function."

  ;; If we're not using text properties, the format routine
  ;; `forms--format' will look like
  ;;
  ;; (lambda (arg)
  ;;   ;; a string, e.g. "text: "
  ;;   (insert "text: ")
  ;;   ;; a field, e.g. 6
  ;;   (aset forms--markers 0 (point-marker))
  ;;   (insert (elt arg 5))
  ;;   ;; another string, e.g. "\nmore text: "
  ;;   (insert "\nmore text: ")
  ;;   ;; a function, e.g. (tocol 40)
  ;;   (insert (aset forms--dyntexts 0 (tocol 40)))
  ;;   ... )

1027 1028 1029 1030 1031
  (cond 
   ((stringp el)
    (` ((insert (, el)))))
   ((numberp el)
    (prog1
1032
	(` ((aset forms--markers (, forms--marker) (point-marker))
1033
	    (insert (elt arg (, (1- el))))))
1034
      (setq forms--marker (1+ forms--marker))))
1035 1036
   ((listp el)
    (prog1
1037 1038
	(` ((insert (aset forms--dyntexts (, forms--dyntext) (, el)))))
      (setq forms--dyntext (1+ forms--dyntext))))))