forms.el 67.4 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2
;;; forms.el --- Forms mode: edit a file as a form to fill in

3
;; Copyright (C) 1991, 1994, 1995, 1996, 1997, 2003 Free Software Foundation, Inc.
4

Richard M. Stallman's avatar
Richard M. Stallman committed
5
;; Author: Johan Vromans <jvromans@squirrel.nl>
6 7 8 9 10 11 12 13 14 15 16 17

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

19
;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
20 21 22
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
23 24

;;; Commentary:
Brian Preble's avatar
Brian Preble committed
25

Erik Naggum's avatar
Erik Naggum committed
26 27 28 29 30 31 32 33
;; Visit a file using a form.
;;
;; === Naming conventions
;;
;; The names of all variables and functions start with 'forms-'.
;; Names which start with 'forms--' are intended for internal use, and
;; should *NOT* be used from the outside.
;;
34
;; All variables are buffer-local, to enable multiple forms visits
Erik Naggum's avatar
Erik Naggum committed
35
;; simultaneously.
36
;; Variable `forms--mode-setup' is local to *ALL* buffers, for it
Erik Naggum's avatar
Erik Naggum committed
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
;; 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 separator (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.
;;
57
;; Forms mode is invoked using M-x `forms-find-file' control-file.
Erik Naggum's avatar
Erik Naggum committed
58 59 60
;; Alternatively `forms-find-file-other-window' can be used.
;;
;; You may also visit the control file, and switch to forms mode by hand
61
;; with M-x `forms-mode'.
Erik Naggum's avatar
Erik Naggum committed
62
;;
63
;; Automatic mode switching is supported if you specify
Erik Naggum's avatar
Erik Naggum committed
64
;; "-*- forms -*-" in the first line of the control file.
65
;;
Erik Naggum's avatar
Erik Naggum committed
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
;; 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.
;;
;; `forms-format-list' should be a list, each element containing
;;
;;   - a string, e.g. "hello".  The string is inserted in the forms
;;	"as is".
82
;;
Erik Naggum's avatar
Erik Naggum committed
83 84 85
;;   - an integer, denoting a field number.
;;	The contents of this field are inserted at this point.
;;     Fields are numbered starting with number one.
86
;;
Erik Naggum's avatar
Erik Naggum committed
87 88 89 90 91
;;   - 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.
92
;;
Erik Naggum's avatar
Erik Naggum committed
93 94 95 96 97 98 99 100 101 102 103 104
;;   - 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]
;;			Non-nil means that the data file is visited
;;			read-only (view mode) as opposed to edit mode.
;;			If no write access to the data file is
105
;;			possible, view mode is enforced.
Erik Naggum's avatar
Erik Naggum committed
106
;;
107 108 109 110
;;	forms-check-number-of-fields            [bool, default t]
;;			If non-nil, a warning will be issued whenever
;;			a record is found that does not have the number
;;			of fields specified by `forms-number-of-fields'.
Erik Naggum's avatar
Erik Naggum committed
111 112
;;
;;	forms-multi-line			[string, default "^K"]
113
;;			If non-null, the records of the data file may
Erik Naggum's avatar
Erik Naggum committed
114 115
;;			contain fields that can span multiple lines in
;;			the form.
116
;;			This variable denotes the separator string
Erik Naggum's avatar
Erik Naggum committed
117
;;			to be used for this purpose.  Upon display, all
118
;;			occurrences of this string are translated
Erik Naggum's avatar
Erik Naggum committed
119
;;			to newlines.  Upon storage they are translated
120
;;			back to the separator string.
Erik Naggum's avatar
Erik Naggum committed
121 122 123 124 125 126 127
;;
;;	forms-forms-scroll			[bool, default nil]
;;			Non-nil means: rebind locally the commands that
;;			perform `scroll-up' or `scroll-down' to use
;;			`forms-next-field' resp. `forms-prev-field'.
;;
;;	forms-forms-jump			[bool, default nil]
128 129 130 131
;;			Non-nil means: rebind locally the commands
;;			`beginning-of-buffer' and `end-of-buffer' to
;;			perform, respectively, `forms-first-record' and
;;			`forms-last-record' instead.
132 133
;;
;;	forms-insert-after			[bool, default nil]
134 135 136 137 138
;;			Non-nil means: insertions of new records go after
;;			current record, also initial position is at the
;;			last record.  The default is to insert before the
;;			current record and the initial position is at the
;;			first record.
Erik Naggum's avatar
Erik Naggum committed
139 140
;;
;;	forms-read-file-filter			[symbol, default nil]
141
;;			If not nil: this should be the name of a
Erik Naggum's avatar
Erik Naggum committed
142 143 144 145 146 147
;;			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]
148
;;			If not nil: this should be the name of a
Erik Naggum's avatar
Erik Naggum committed
149 150 151 152 153
;;			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.
;;
;;	forms-new-record-filter			[symbol, default nil]
154
;;			If not nil: this should be the name of a
Erik Naggum's avatar
Erik Naggum committed
155 156 157 158 159
;;			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.
;;
;;	forms-modified-record-filter		[symbol, default nil]
160
;;			If not nil: this should be the name of a
Erik Naggum's avatar
Erik Naggum committed
161 162 163 164 165 166 167 168 169 170 171 172 173
;;			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.
;;
;;	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.
;;			As of emacs 19.29, the `intangible' text property
;;			is used to prevent moving into read-only fields.
174 175
;;			This variable defaults to t if running Emacs 19 or
;;			later with text properties.
Erik Naggum's avatar
Erik Naggum committed
176 177 178 179 180
;;			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
181
;;			read-only text on the screen.  If used, this
Erik Naggum's avatar
Erik Naggum committed
182 183 184 185 186 187 188 189 190 191 192 193 194
;;			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.
;;
;; 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
195
;; `forms--file-buffer' which normally will not be shown.
Erik Naggum's avatar
Erik Naggum committed
196 197 198 199 200 201
;; Great malfunctioning may be expected if this file/buffer is modified
;; outside of this package while it is being visited!
;;
;; 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'.
202
;; A format routine `forms--format' is built upon startup to format
Erik Naggum's avatar
Erik Naggum committed
203 204 205 206 207 208 209 210 211 212 213 214 215
;; the records according to `forms-format-list'.
;;
;; When a form is changed the record is updated as soon as this form
;; 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 original 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
;; the records.
;;
;; Two exit functions exist: `forms-exit' and `forms-exit-no-save'.
;; `forms-exit' saves the data to the file, if modified.
216
;; `forms-exit-no-save' does not.  However, if `forms-exit-no-save'
Erik Naggum's avatar
Erik Naggum committed
217 218 219 220 221 222 223 224 225 226 227 228 229
;; is executed and the file buffer has been modified, Emacs will ask
;; questions anyway.
;;
;; Other functions provided by forms mode 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
;;
230
;; As a documented side-effect: jumping to the last record in the
Erik Naggum's avatar
Erik Naggum committed
231 232 233
;; file (using forms-last-record) will adjust forms--total-records if
;; needed.
;;
234 235
;; The forms buffer can be in one of two modes: edit mode or view
;; mode.  View mode is a read-only mode, whereby you cannot modify the
Erik Naggum's avatar
Erik Naggum committed
236 237 238
;; contents of the buffer.
;;
;; Edit mode commands:
239
;;
Erik Naggum's avatar
Erik Naggum committed
240 241 242 243 244 245 246 247 248 249 250 251 252 253
;; 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
;; \C-c \C-r	 forms-search-backward
;; \C-c \C-s	 forms-search-forward
;; \C-c \C-x	 forms-exit
254
;;
Erik Naggum's avatar
Erik Naggum committed
255
;; Read-only mode commands:
256
;;
Erik Naggum's avatar
Erik Naggum committed
257 258 259
;; SPC 	 forms-next-record
;; DEL	 forms-prev-record
;; ?	 describe-mode
260
;; \C-q  forms-toggle-read-only
Erik Naggum's avatar
Erik Naggum committed
261 262 263 264 265 266
;; l	 forms-jump-record
;; n	 forms-next-record
;; p	 forms-prev-record
;; r	 forms-search-backward
;; s	 forms-search-forward
;; x	 forms-exit
267
;;
Erik Naggum's avatar
Erik Naggum committed
268 269
;; Of course, it is also possible to use the \C-c prefix to obtain the
;; same command keys as in edit mode.
270 271 272
;;
;; The following bindings are available, independent of the mode:
;;
Erik Naggum's avatar
Erik Naggum committed
273 274 275 276 277
;; [next]	  forms-next-record
;; [prior]	  forms-prev-record
;; [begin]	  forms-first-record
;; [end]	  forms-last-record
;; [S-TAB]	  forms-prev-field
278
;; [backtab]	  forms-prev-field
Erik Naggum's avatar
Erik Naggum committed
279 280 281 282
;;
;; For convenience, TAB is always bound to `forms-next-field', so you
;; don't need the C-c prefix for this command.
;;
283
;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump'),
Erik Naggum's avatar
Erik Naggum committed
284 285 286 287 288
;; the bindings of standard functions `scroll-up', `scroll-down',
;; `beginning-of-buffer' and `end-of-buffer' can be locally replaced with
;; forms mode functions next/prev record and first/last
;; record.
;;
289
;; `write-file-functions' is defined to save the actual data file
Erik Naggum's avatar
Erik Naggum committed
290 291
;; instead of the buffer data, `revert-file-hook' is defined to
;; revert a forms to original.
292 293 294

;;; Code:

Richard M. Stallman's avatar
Richard M. Stallman committed
295 296 297 298
(defgroup forms nil
  "Edit a file as a form to fill in."
  :group 'data)

299
;;; Global variables and constants:
Brian Preble's avatar
Brian Preble committed
300

301 302 303
(provide 'forms)			;;; official
(provide 'forms-mode)			;;; for compatibility

304
(defconst forms-version (substring "$Revision: 2.46 $" 11 -2)
Richard M. Stallman's avatar
Richard M. Stallman committed
305 306
  "The version number of forms-mode (as string).  The complete RCS id is:

307
  $Id: forms.el,v 2.46 2003/05/23 12:48:06 rms Exp $")
Brian Preble's avatar
Brian Preble committed
308

Richard M. Stallman's avatar
Richard M. Stallman committed
309
(defcustom forms-mode-hooks nil
Dave Love's avatar
Dave Love committed
310
  "Hook run upon entering Forms mode."
Richard M. Stallman's avatar
Richard M. Stallman committed
311
  :group 'forms
Dave Love's avatar
Dave Love committed
312
  :type 'hook)
313

314
;;; Mandatory variables - must be set by evaluating the control file.
Brian Preble's avatar
Brian Preble committed
315 316

(defvar forms-file nil
317
  "Name of the file holding the data.")
Brian Preble's avatar
Brian Preble committed
318 319

(defvar forms-format-list nil
320
  "List of formatting specifications.")
Brian Preble's avatar
Brian Preble committed
321 322 323

(defvar forms-number-of-fields nil
  "Number of fields per record.")
324

325
;;; Optional variables with default values.
Brian Preble's avatar
Brian Preble committed
326

Richard M. Stallman's avatar
Richard M. Stallman committed
327 328 329 330
(defcustom forms-check-number-of-fields t
  "*If non-nil, warn about records with wrong number of fields."
  :group 'forms
  :type 'boolean)
331

Brian Preble's avatar
Brian Preble committed
332
(defvar forms-field-sep "\t"
333
  "Field separator character (default TAB).")
Brian Preble's avatar
Brian Preble committed
334

335 336
(defvar forms-read-only nil
  "Non-nil means: visit the file in view (read-only) mode.
Richard M. Stallman's avatar
Richard M. Stallman committed
337
This is set automatically if the file permissions don't let you write it.")
Brian Preble's avatar
Brian Preble committed
338

Richard M. Stallman's avatar
Richard M. Stallman committed
339 340
(defvar forms-multi-line "\C-k" "\
If not nil: use this character to separate multi-line fields (default C-k).")
Brian Preble's avatar
Brian Preble committed
341

Richard M. Stallman's avatar
Richard M. Stallman committed
342
(defcustom forms-forms-scroll nil
Richard M. Stallman's avatar
Richard M. Stallman committed
343
  "*Non-nil means replace scroll-up/down commands in Forms mode.
Richard M. Stallman's avatar
Richard M. Stallman committed
344 345 346
The replacement commands performs forms-next/prev-record."
  :group 'forms
  :type 'boolean)
Brian Preble's avatar
Brian Preble committed
347

Richard M. Stallman's avatar
Richard M. Stallman committed
348
(defcustom forms-forms-jump nil
Richard M. Stallman's avatar
Richard M. Stallman committed
349
  "*Non-nil means redefine beginning/end-of-buffer in Forms mode.
Richard M. Stallman's avatar
Richard M. Stallman committed
350 351 352
The replacement commands performs forms-first/last-record."
  :group 'forms
  :type 'boolean)
353

354 355 356 357 358 359 360
(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.
Richard M. Stallman's avatar
Richard M. Stallman committed
361
This can be used to undo the effects of `form-read-file-hook'.")
362

363 364 365 366 367 368 369 370
(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.
371
This variable is for use by the filter routines only.
372 373
The contents may NOT be modified.")

Richard M. Stallman's avatar
Richard M. Stallman committed
374 375 376 377 378
(defcustom forms-use-text-properties t
  "*Non-nil means: use text properties.
Defaults to t if this Emacs is capable of handling text properties."
  :group 'forms
  :type 'boolean)
379

Richard M. Stallman's avatar
Richard M. Stallman committed
380
(defcustom forms-insert-after nil
381
  "*Non-nil means: inserts of new records go after current record.
Richard M. Stallman's avatar
Richard M. Stallman committed
382 383 384 385 386 387 388 389 390 391 392 393 394
Also, initial position is at last record."
  :group 'forms
  :type 'boolean)

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

(defcustom forms-rw-face 'region
  "The face (a symbol) that is used to display read-write text on the screen."
  :group 'forms
  :type 'face)
395

Brian Preble's avatar
Brian Preble committed
396 397 398 399 400 401 402 403 404 405 406
;;; 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
407
(defvar forms-mode-map nil
Brian Preble's avatar
Brian Preble committed
408
   "Keymap for form buffer.")
Richard M. Stallman's avatar
Richard M. Stallman committed
409 410 411 412
(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
413 414 415 416

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

417 418
(defvar forms--dyntexts nil
  "Dynamic texts (resulting from function calls) on the screen.")
Brian Preble's avatar
Brian Preble committed
419

420
(defvar forms--the-record-list nil
Brian Preble's avatar
Brian Preble committed
421 422 423
   "List of strings of the current record, as parsed from the file.")

(defvar forms--search-regexp nil
424
  "Last regexp used by forms-search functions.")
Brian Preble's avatar
Brian Preble committed
425 426 427 428 429 430 431 432

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

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

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

436
(defvar forms--dynamic-text nil
437
  "Array that holds dynamic texts to insert between fields.")
438

439 440
(defvar forms--elements nil
  "Array with the order in which the fields are displayed.")
441

442 443
(defvar forms--ro-face nil
  "Face used to represent read-only data on the screen.")
444

445 446
(defvar forms--rw-face nil
  "Face used to represent read-write data on the screen.")
447

448
;;;###autoload
Brian Preble's avatar
Brian Preble committed
449 450 451
(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
452 453
Commands:                        Equivalent keys in read-only mode:
 TAB            forms-next-field          TAB
454
 C-c TAB        forms-next-field
455 456 457 458 459 460 461 462 463 464 465 466
 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
 C-c C-r        forms-search-reverse       r
 C-c C-s        forms-search-forward       s
 C-c C-x        forms-exit                 x
Richard M. Stallman's avatar
Richard M. Stallman committed
467 468
"
  (interactive)
Brian Preble's avatar
Brian Preble committed
469

470 471 472 473 474 475 476 477 478 479
  ;; 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
480 481 482 483
  ;; Primary set-up: evaluate buffer and check if the mandatory
  ;; variables have been set.
  (if (or primary (not forms--mode-setup))
      (progn
484
	;;(message "forms: setting up...")
Brian Preble's avatar
Brian Preble committed
485 486
	(kill-all-local-variables)

487
	;; Make mandatory variables.
Brian Preble's avatar
Brian Preble committed
488 489 490 491
	(make-local-variable 'forms-file)
	(make-local-variable 'forms-number-of-fields)
	(make-local-variable 'forms-format-list)

492
	;; Make optional variables.
Brian Preble's avatar
Brian Preble committed
493 494 495 496 497
	(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)
498
	(make-local-variable 'forms-insert-after)
499
	(make-local-variable 'forms-use-text-properties)
500 501 502 503

	;; 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
504 505
	(make-local-variable 'forms-new-record-filter)
	(make-local-variable 'forms-modified-record-filter)
506 507

	;; Make sure no filters exist.
508 509
	(setq forms-read-file-filter nil)
	(setq forms-write-file-filter nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
510 511
	(setq forms-new-record-filter nil)
	(setq forms-modified-record-filter nil)
512

513
	;; If running Emacs 19 under X, setup faces to show read-only and
514 515 516 517 518
	;; 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
519 520

	;; eval the buffer, should set variables
521
	;;(message "forms: processing control file...")
522 523
	;; If enable-local-eval is not set to t the user is asked first.
	(if (or (eq enable-local-eval t)
524
		(yes-or-no-p
525 526 527 528
		 (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
529

530
	;; Check if the mandatory variables make sense.
Brian Preble's avatar
Brian Preble committed
531
	(or forms-file
532
	    (error (concat "Forms control file error: "
533
			   "`forms-file' has not been set")))
534 535 536

	;; 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
537 538
	(or (stringp forms-field-sep)
	    (error (concat "Forms control file error: "
539
			   "`forms-field-sep' is not a string")))
540 541 542 543 544

	(if forms-number-of-fields
	    (or (and (numberp forms-number-of-fields)
		     (> forms-number-of-fields 0))
		(error (concat "Forms control file error: "
545
			       "`forms-number-of-fields' must be a number > 0")))
546 547
	  (or (null forms-format-list)
	      (error (concat "Forms control file error: "
548
			     "`forms-number-of-fields' has not been set"))))
549 550 551 552

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

Brian Preble's avatar
Brian Preble committed
553 554 555 556
	(if forms-multi-line
	    (if (and (stringp forms-multi-line)
		     (eq (length forms-multi-line) 1))
		(if (string= forms-multi-line forms-field-sep)
557
		    (error (concat "Forms control file error: "
558
				   "`forms-multi-line' is equal to 'forms-field-sep'")))
Richard M. Stallman's avatar
Richard M. Stallman committed
559
	      (error (concat "Forms control file error: "
560
			     "`forms-multi-line' must be nil or a one-character string"))))
561 562
	(or (fboundp 'set-text-properties)
	    (setq forms-use-text-properties nil))
563

564 565
	;; Validate and process forms-format-list.
	;;(message "forms: pre-processing format list...")
566
	(make-local-variable 'forms--elements)
Brian Preble's avatar
Brian Preble committed
567 568
	(forms--process-format-list)

569 570
	;; Build the formatter and parser.
	;;(message "forms: building formatter...")
Brian Preble's avatar
Brian Preble committed
571
	(make-local-variable 'forms--format)
572 573 574
	(make-local-variable 'forms--markers)
	(make-local-variable 'forms--dyntexts)
	;;(message "forms: building parser...")
Brian Preble's avatar
Brian Preble committed
575 576 577
	(forms--make-format)
	(make-local-variable 'forms--parser)
	(forms--make-parser)
578
	;;(message "forms: building parser... done.")
Brian Preble's avatar
Brian Preble committed
579

580
	;; Check if record filters are defined.
Richard M. Stallman's avatar
Richard M. Stallman committed
581 582 583
	(if (and forms-new-record-filter
		 (not (fboundp forms-new-record-filter)))
	    (error (concat "Forms control file error: "
584
			   "`forms-new-record-filter' is not a function")))
Richard M. Stallman's avatar
Richard M. Stallman committed
585 586 587 588

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

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

594 595
	;; Dynamic text support.
	(make-local-variable 'forms--dynamic-text)
Brian Preble's avatar
Brian Preble committed
596

Karl Heuer's avatar
Karl Heuer committed
597
	;; Prevent accidental overwrite of the control file and auto-save.
598
	(set-visited-file-name nil)
Brian Preble's avatar
Brian Preble committed
599

600 601 602 603 604 605 606
	;; Prepare this buffer for further processing.
	(setq buffer-read-only nil)
	(erase-buffer)

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

607 608 609
  ;; initialization done
  (setq forms--mode-setup t)

610 611 612 613 614 615 616 617 618 619 620
  ;; 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
621

622
  ;; Make more local variables.
Brian Preble's avatar
Brian Preble committed
623 624 625 626
  (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)
627
  (make-local-variable 'forms--search-regexp)
Brian Preble's avatar
Brian Preble committed
628

Richard M. Stallman's avatar
Richard M. Stallman committed
629 630 631 632
  ; 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
633 634
  (if forms-mode-map			; already defined
      nil
635
    ;;(message "forms: building keymap...")
Richard M. Stallman's avatar
Richard M. Stallman committed
636
    (forms--mode-commands)
637 638
    ;;(message "forms: building keymap... done.")
    )
Brian Preble's avatar
Brian Preble committed
639

640 641 642 643
  ;; set the major mode indicator
  (setq major-mode 'forms-mode)
  (setq mode-name "Forms")

Brian Preble's avatar
Brian Preble committed
644 645 646
  ;; find the data file
  (setq forms--file-buffer (find-file-noselect forms-file))

647 648 649 650 651 652
  ;; 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)
653 654 655 656
	  (let ((inhibit-read-only t)
		(file-modified (buffer-modified-p)))
	    (run-hooks 'read-file-filter)
	    (if (not file-modified) (set-buffer-modified-p nil)))
657 658
	  (if write-file-filter
	      (progn
659 660
		(make-local-variable 'write-file-functions)
		(setq write-file-functions (list write-file-filter)))))
661 662 663
      (if write-file-filter
	  (save-excursion
	    (set-buffer forms--file-buffer)
664 665
	    (make-local-variable 'write-file-functions)
	    (setq write-file-functions (list write-file-filter))))))
666

Brian Preble's avatar
Brian Preble committed
667 668 669 670
  ;; count the number of records, and set see if it may be modified
  (let (ro)
    (setq forms--total-records
	  (save-excursion
671 672 673 674 675 676 677 678 679
	    (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
680 681 682
    (if ro
	(setq forms-read-only t)))

683
  ;;(message "forms: proceeding setup...")
684 685 686 687 688 689 690

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

691
  ;;(message "forms: proceeding setup (keymaps)...")
Brian Preble's avatar
Brian Preble committed
692
  (forms--set-keymaps)
693
  ;;(message "forms: proceeding setup (commands)...")
694
  (forms--change-commands)
Brian Preble's avatar
Brian Preble committed
695

696
  ;;(message "forms: proceeding setup (buffer)...")
Brian Preble's avatar
Brian Preble committed
697 698
  (set-buffer-modified-p nil)

699 700 701
  (if (= forms--total-records 0)
      ;;(message "forms: proceeding setup (new file)...")
      (progn
702
	(insert
703 704
	 "GNU Emacs Forms Mode version " forms-version "\n\n"
	 (if (file-exists-p forms-file)
705 706
	     (concat "No records available in file `" forms-file "'\n\n")
	   (format "Creating new file `%s'\nwith %d field%s per record\n\n"
707 708 709 710 711 712 713 714 715 716 717 718
		   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
719

720 721 722 723
    (if forms-insert-after
	(forms-last-record)
      (forms-first-record))
    )
724

Brian Preble's avatar
Brian Preble committed
725
  ;; user customising
726
  ;;(message "forms: proceeding setup (user hooks)...")
Brian Preble's avatar
Brian Preble committed
727
  (run-hooks 'forms-mode-hooks)
728
  ;;(message "forms: setting up... done.")
Brian Preble's avatar
Brian Preble committed
729 730 731

  ;; be helpful
  (forms--help)
732
)
733

Brian Preble's avatar
Brian Preble committed
734
(defun forms--process-format-list ()
735 736 737 738
  ;; 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
739
  ;; of the fields on the display. This array is used by
740 741
  ;; `forms--parser-using-text-properties' to extract the fields data
  ;; from the form on the screen.
742
  ;; Upon completion, `forms-format-list' is guaranteed correct, so
743 744 745 746
  ;; `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
747
  (or forms-format-list
Richard M. Stallman's avatar
Richard M. Stallman committed
748
      (error (concat "Forms control file error: "
749
		     "`forms-format-list' has not been set")))
750
  ;; It must be a list.
Brian Preble's avatar
Brian Preble committed
751
  (or (listp forms-format-list)
Richard M. Stallman's avatar
Richard M. Stallman committed
752
      (error (concat "Forms control file error: "
753
		     "`forms-format-list' is not a list")))
Brian Preble's avatar
Brian Preble committed
754

755 756 757
  ;; 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
758 759

  (let ((the-list forms-format-list)	; the list of format elements
760
	(this-item 0)			; element in list
761
	(prev-item nil)
762
	(field-num 0))			; highest field number
Brian Preble's avatar
Brian Preble committed
763

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

Brian Preble's avatar
Brian Preble committed
766 767 768 769 770
    (while the-list

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

771
	;; If it is a symbol, eval it first.
772 773 774 775
	(if (and (symbolp el)
		 (boundp el))
	    (setq el (eval el)))

Brian Preble's avatar
Brian Preble committed
776 777
	(cond

778 779 780 781 782 783 784 785 786 787
	 ;; 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 ...
788
	 ((numberp el)
Brian Preble's avatar
Brian Preble committed
789

790
	  ;; Validate range.
Brian Preble's avatar
Brian Preble committed
791 792
	  (if (or (<= el 0)
		  (> el forms-number-of-fields))
Richard M. Stallman's avatar
Richard M. Stallman committed
793 794 795
	      (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
796

797
	  ;; Store forms order.
798
	  (if (>= field-num (length forms--elements))
799 800 801 802 803 804
	      (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
805
		    (append forms-format-list (list prev-item) nil)))
806 807 808
	  (setq prev-item el))

	 ;; Try function ...
809
	 ((listp el)
810 811

	  ;; Validate.
812
	  (or (fboundp (car-safe el))
Richard M. Stallman's avatar
Richard M. Stallman committed
813
	      (error (concat "Forms format error: "
814
			     "%S is not a function")
815
		     (car-safe el)))
816 817 818 819 820 821

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

Brian Preble's avatar
Brian Preble committed
823 824
	 ;; else
	 (t
Richard M. Stallman's avatar
Richard M. Stallman committed
825
	  (error (concat "Forms format error: "
826 827
			 "invalid element %S")
		 el)))
Brian Preble's avatar
Brian Preble committed
828

829 830
	;; Advance to next element of the list.
	(setq the-list rem)))
Brian Preble's avatar
Brian Preble committed
831

832 833 834 835 836 837
    ;; 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.
838
	  ;; This prevents parsing problems.
839 840 841 842 843 844 845
	  ;; 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))
846

847 848
;; Special treatment for read-only segments.
;;
849 850
;; If text is inserted between two read-only segments, there seems to
;; be no way to give the newly inserted text the RW face.
851
;; To solve this, read-only segments get the `insert-in-front-hooks'
852 853 854 855
;; property set with a function that temporarily switches the
;; properties of the first character of the segment to the RW face, so
;; the new text gets the right face. The `post-command-hook' is
;; used to restore the original properties.
856 857

(defvar forms--iif-start nil
858
  "Record start of modification command.")
859
(defvar forms--iif-properties nil
860 861
  "Original properties of the character being overridden.")

862 863
(defun forms--iif-hook (begin end)
  "`insert-in-front-hooks' function for read-only segments."
864

865 866
  ;; Note start location.  By making it a marker that points one
  ;; character beyond the actual location, it is guaranteed to move
867 868 869
  ;; correctly if text is inserted.
  (or forms--iif-start
      (setq forms--iif-start (copy-marker (1+ (point)))))
870

871 872 873 874 875 876
  ;; 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.
877
	(setq forms--iif-properties
878
	      (text-properties-at (1- forms--iif-start)))
879

880 881
	;; Replace them.
	(let ((inhibit-read-only t))
882
	  (set-text-properties
883 884
	   (1- forms--iif-start) forms--iif-start
	   (list 'face forms--rw-face 'front-sticky '(face))))
885

886 887 888
	;; Enable `post-command-hook' to restore the properties.
	(setq post-command-hook
	      (append (list 'forms--iif-post-command-hook) post-command-hook)))
889

890 891
    ;; No action needed.  Clear marker.
    (setq forms--iif-start nil)))
892

893 894
(defun forms--iif-post-command-hook ()
  "`post-command-hook' function for read-only segments."
895 896 897

  ;; Disable `post-command-hook'.
  (setq post-command-hook
898
	(delq 'forms--iif-hook-post-command-hook post-command-hook))
899 900

  ;; Restore properties.
901
  (if forms--iif-start
902
      (let ((inhibit-read-only t))
903
	(set-text-properties
904 905
	 (1- forms--iif-start) forms--iif-start
	 forms--iif-properties)))
906 907

  ;; Cleanup.
908
  (setq forms--iif-start nil))
909 910 911

(defvar forms--marker)
(defvar forms--dyntext)
Brian Preble's avatar
Brian Preble committed
912 913

(defun forms--make-format ()
914 915 916 917 918 919 920 921 922
  "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))
923
    (setq
924
     forms--format
925
     (if forms-use-text-properties
Gerd Moellmann's avatar
Gerd Moellmann committed
926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942
	 `(lambda (arg)
	    (let ((inhibit-read-only t))
	      ,@(apply 'append
		       (mapcar 'forms--make-format-elt-using-text-properties
			       forms-format-list))
	      ;; Prevent insertion before the first text.
	      ,@(if (numberp (car forms-format-list))
		    nil
		  '((add-text-properties (point-min) (1+ (point-min))
					 '(front-sticky (read-only intangible)))))
	      ;; Prevent insertion after the last text.
	      (remove-text-properties (1- (point)) (point)
				      '(rear-nonsticky)))
	    (setq forms--iif-start nil))
       `(lambda (arg)
	  ,@(apply 'append
		   (mapcar 'forms--make-format-elt forms-format-list)))))
943 944 945 946 947

    ;; 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)))
948
  (forms--debug 'forms--format))
Brian Preble's avatar
Brian Preble committed
949

950 951 952 953 954 955 956 957 958
(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))
  ;;
959
  ;;     ;; A string, e.g. "text: ".
960
  ;;     (set-text-properties
961
  ;;      (point)
962
  ;;      (progn (insert "text: ") (point))
963 964 965 966
  ;;      (list 'face forms--ro-face
  ;;		'read-only 1
  ;;		'insert-in-front-hooks 'forms--iif-hook
  ;;		'rear-nonsticky '(read-only face insert-in-front-hooks)))
967
  ;;
968
  ;;     ;; A field, e.g. 6.
969 970 971 972
  ;;     (let ((here (point)))
  ;;       (aset forms--markers 0 (point-marker))
  ;;       (insert (elt arg 5))
  ;;       (or (= (point) here)
973
  ;; 	  (set-text-properties
974
  ;; 	   here (point)
975 976
  ;; 	   (list 'face forms--rw-face
  ;;		 'front-sticky '(face))))
977
  ;;