lisp/forms.el

   1 ;;; forms.el -- Forms mode: edit a file as a form to fill in.
   2 ;;; Copyright (C) 1991, 1993 Free Software Foundation, Inc.
   3
   4 ;; Author: Johan Vromans <jv@nl.net>
   5 ;; Version: $Revision: 2.3 $
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 ;;; Commentary:
  24
  25 ;;; Visit a file using a form.
  26 ;;;
  27 ;;; === Naming conventions
  28 ;;;
  29 ;;; The names of all variables and functions start with 'forms-'.
  30 ;;; Names which start with 'forms--' are intended for internal use, and
  31 ;;; should *NOT* be used from the outside.
  32 ;;;
  33 ;;; All variables are buffer-local, to enable multiple forms visits
  34 ;;; simultaneously.
  35 ;;; Variable `forms--mode-setup' is local to *ALL* buffers, for it
  36 ;;; controls if forms-mode has been enabled in a buffer.
  37 ;;;
  38 ;;; === How it works ===
  39 ;;;
  40 ;;; Forms mode means visiting a data file which is supposed to consist
  41 ;;; of records each containing a number of fields.  The records are
  42 ;;; separated by a newline, the fields are separated by a user-defined
  43 ;;; field separater (default: TAB).
  44 ;;; When shown, a record is transferred to an Emacs buffer and
  45 ;;; presented using a user-defined form.  One record is shown at a
  46 ;;; time.
  47 ;;;
  48 ;;; Forms mode is a composite mode.  It involves two files, and two
  49 ;;; buffers.
  50 ;;; The first file, called the control file, defines the name of the
  51 ;;; data file and the forms format.  This file buffer will be used to
  52 ;;; present the forms.
  53 ;;; The second file holds the actual data.  The buffer of this file
  54 ;;; will be buried, for it is never accessed directly.
  55 ;;;
  56 ;;; Forms mode is invoked using M-x forms-find-file control-file .
  57 ;;; Alternativily `forms-find-file-other-window' can be used.
  58 ;;;
  59 ;;; You may also visit the control file, and switch to forms mode by hand
  60 ;;; with M-x forms-mode .
  61 ;;;
  62 ;;; Automatic mode switching is supported if you specify
  63 ;;; "-*- forms -*-" in the first line of the control file.
  64 ;;;
  65 ;;; The control file is visited, evaluated using `eval-current-buffer',
  66 ;;; and should set at least the following variables:
  67 ;;;
  68 ;;;     forms-file                              [string]
  69 ;;;                     The name of the data file.
  70 ;;;
  71 ;;;     forms-number-of-fields                  [integer]
  72 ;;;                     The number of fields in each record.
  73 ;;;
  74 ;;;     forms-format-list                       [list]
  75 ;;;                     Formatting instructions.
  76 ;;;
  77 ;;; `forms-format-list' should be a list, each element containing
  78 ;;;
  79 ;;;   - a string, e.g. "hello".  The string is inserted in the forms
  80 ;;;     "as is".
  81 ;;;
  82 ;;;   - an integer, denoting a field number.
  83 ;;;     The contents of this field are inserted at this point.
  84 ;;;     Fields are numbered starting with number one.
  85 ;;;
  86 ;;;   - a function call, e.g. (insert "text").
  87 ;;;     This function call is dynamically evaluated and should return a
  88 ;;;     string.  It should *NOT* have side-effects on the forms being
  89 ;;;     constructed.  The current fields are available to the function
  90 ;;;     in the variable `forms-fields', they should *NOT* be modified.
  91 ;;;
  92 ;;;   - a lisp symbol, that must evaluate to one of the above.
  93 ;;;
  94 ;;; Optional variables which may be set in the control file:
  95 ;;;
  96 ;;;     forms-field-sep                         [string, default TAB]
  97 ;;;                     The field separator used to separate the
  98 ;;;                     fields in the data file.  It may be a string.
  99 ;;;
 100 ;;;     forms-read-only                         [bool, default nil]
 101 ;;;                     Non-nil means that the data file is visited
 102 ;;;                     read-only (view mode) as opposed to edit mode.
 103 ;;;                     If no write access to the data file is
 104 ;;;                     possible, view mode is enforced.
 105 ;;;
 106 ;;;     forms-multi-line                        [string, default "^K"]
 107 ;;;                     If non-null the records of the data file may
 108 ;;;                     contain fields that can span multiple lines in
 109 ;;;                     the form.
 110 ;;;                     This variable denotes the separator character
 111 ;;;                     to be used for this purpose.  Upon display, all
 112 ;;;                     occurrencies of this character are translated
 113 ;;;                     to newlines.  Upon storage they are translated
 114 ;;;                     back to the separator character.
 115 ;;;
 116 ;;;     forms-forms-scroll                      [bool, default nil]
 117 ;;;                     Non-nil means: rebind locally the commands that
 118 ;;;                     perform `scroll-up' or `scroll-down' to use
 119 ;;;                     `forms-next-field' resp. `forms-prev-field'.
 120 ;;;
 121 ;;;     forms-forms-jump                        [bool, default nil]
 122 ;;;                     Non-nil means: rebind locally the commands that
 123 ;;;                     perform `beginning-of-buffer' or `end-of-buffer'
 124 ;;;                     to perform `forms-first-field' resp. `forms-last-field'.
 125 ;;;
 126 ;;;     forms-new-record-filter                 [symbol, default nil]
 127 ;;;                     If not nil: this should be the name of a
 128 ;;;                     function that is called when a new
 129 ;;;                     record is created.  It can be used to fill in
 130 ;;;                     the new record with default fields, for example.
 131 ;;;
 132 ;;;     forms-modified-record-filter            [symbol, default nil]
 133 ;;;                     If not nil: this should be the name of a
 134 ;;;                     function that is called when a record has
 135 ;;;                     been modified.  It is called after the fields
 136 ;;;                     are parsed.  It can be used to register
 137 ;;;                     modification dates, for example.
 138 ;;;
 139 ;;;     forms-use-text-properties               [bool, see text for default]
 140 ;;;                     This variable controls if forms mode should use
 141 ;;;                     text properties to protect the form text from being
 142 ;;;                     modified (using text-property `read-only').
 143 ;;;                     Also, the read-write fields are shown using a
 144 ;;;                     distinct face, if possible.
 145 ;;;                     This variable defaults to t if running Emacs 19
 146 ;;;                     with text properties.
 147 ;;;                     The default face to show read-write fields is
 148 ;;;                     copied from face `region'.
 149 ;;;
 150 ;;;     forms-ro-face                           [symbol, default 'default]
 151 ;;;                     This is the face that is used to show
 152 ;;;                     read-only text on the screen.If used, this
 153 ;;;                     variable should be set to a symbol that is a
 154 ;;;                     valid face.
 155 ;;;                     E.g.
 156 ;;;                       (make-face 'my-face)
 157 ;;;                       (setq forms-ro-face 'my-face)
 158 ;;;
 159 ;;;     forms-rw-face                           [symbol, default 'region]
 160 ;;;                     This is the face that is used to show
 161 ;;;                     read-write text on the screen.
 162 ;;;
 163 ;;; After evaluating the control file, its buffer is cleared and used
 164 ;;; for further processing.
 165 ;;; The data file (as designated by `forms-file') is visited in a buffer
 166 ;;; `forms--file-buffer' which will not normally be shown.
 167 ;;; Great malfunctioning may be expected if this file/buffer is modified
 168 ;;; outside of this package while it is being visited!
 169 ;;;
 170 ;;; Normal operation is to transfer one line (record) from the data file,
 171 ;;; split it into fields (into `forms--the-record-list'), and display it
 172 ;;; using the specs in `forms-format-list'.
 173 ;;; A format routine `forms--format' is built upon startup to format
 174 ;;; the records according to `forms-format-list'.
 175 ;;;
 176 ;;; When a form is changed the record is updated as soon as this form
 177 ;;; is left.  The contents of the form are parsed using information
 178 ;;; obtained from `forms-format-list', and the fields which are
 179 ;;; deduced from the form are modified.  Fields not shown on the forms
 180 ;;; retain their origional values.  The newly formed record then
 181 ;;; replaces the contents of the old record in `forms--file-buffer'.
 182 ;;; A parse routine `forms--parser' is built upon startup to parse
 183 ;;; the records.
 184 ;;;
 185 ;;; Two exit functions exist: `forms-exit' and `forms-exit-no-save'.
 186 ;;; `forms-exit' saves the data to the file, if modified.
 187 ;;; `forms-exit-no-save` does not.  However, if `forms-exit-no-save'
 188 ;;; is executed and the file buffer has been modified, Emacs will ask
 189 ;;; questions anyway.
 190 ;;;
 191 ;;; Other functions provided by forms mode are:
 192 ;;;
 193 ;;;     paging (forward, backward) by record
 194 ;;;     jumping (first, last, random number)
 195 ;;;     searching
 196 ;;;     creating and deleting records
 197 ;;;     reverting the form (NOT the file buffer)
 198 ;;;     switching edit <-> view mode v.v.
 199 ;;;     jumping from field to field
 200 ;;;
 201 ;;; As an documented side-effect: jumping to the last record in the
 202 ;;; file (using forms-last-record) will adjust forms--total-records if
 203 ;;; needed.
 204 ;;;
 205 ;;; The forms buffer can be in on eof two modes: edit mode or view
 206 ;;; mode.  View mode is a read-only mode, you cannot modify the
 207 ;;; contents of the buffer.
 208 ;;;
 209 ;;; Edit mode commands:
 210 ;;;
 211 ;;; TAB          forms-next-field
 212 ;;; \C-c TAB     forms-next-field
 213 ;;; \C-c <       forms-first-record
 214 ;;; \C-c >       forms-last-record
 215 ;;; \C-c ?       describe-mode
 216 ;;; \C-c \C-k    forms-delete-record
 217 ;;; \C-c \C-q    forms-toggle-read-only
 218 ;;; \C-c \C-o    forms-insert-record
 219 ;;; \C-c \C-l    forms-jump-record
 220 ;;; \C-c \C-n    forms-next-record
 221 ;;; \C-c \C-p    forms-prev-record
 222 ;;; \C-c \C-s    forms-search
 223 ;;; \C-c \C-x    forms-exit
 224 ;;;
 225 ;;; Read-only mode commands:
 226 ;;;
 227 ;;; SPC          forms-next-record
 228 ;;; DEL  forms-prev-record
 229 ;;; ?    describe-mode
 230 ;;; \C-q forms-toggle-read-only
 231 ;;; l    forms-jump-record
 232 ;;; n    forms-next-record
 233 ;;; p    forms-prev-record
 234 ;;; s    forms-search
 235 ;;; x    forms-exit
 236 ;;;
 237 ;;; Of course, it is also possible to use the \C-c prefix to obtain the
 238 ;;; same command keys as in edit mode.
 239 ;;;
 240 ;;; The following bindings are available, independent of the mode:
 241 ;;;
 242 ;;; [next]        forms-next-record
 243 ;;; [prior]       forms-prev-record
 244 ;;; [begin]       forms-first-record
 245 ;;; [end]         forms-last-record
 246 ;;; [S-TAB]       forms-prev-field
 247 ;;; [backtab] forms-prev-field
 248 ;;;
 249 ;;; For convenience, TAB is always bound to `forms-next-field', so you
 250 ;;; don't need the C-c prefix for this command.
 251 ;;;
 252 ;;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump')
 253 ;;; the bindings of standard functions `scroll-up', `scroll-down',
 254 ;;; `beginning-of-buffer' and `end-of-buffer' can be locally replaced with
 255 ;;; forms mode functions next/prev record and first/last
 256 ;;; record.
 257 ;;;
 258 ;;; `local-write-file hook' is defined to save the actual data file
 259 ;;; instead of the buffer data, `revert-file-hook' is defined to
 260 ;;; revert a forms to original.
 261 \f
 262 ;;; Code:
 263
 264 ;;; Global variables and constants:
 265
 266 (provide 'forms)                        ;;; official
 267 (provide 'forms-mode)                   ;;; for compatibility
 268
 269 (defconst forms-version (substring "$Revision: 2.3 $" 11 -2)
 270   "The version number of forms-mode (as string).  The complete RCS id is:
 271
 272   $Id: forms.el,v 2.3 1993/10/21 00:43:51 rms Exp kwzh $")
 273
 274 (defvar forms-mode-hooks nil
 275   "Hook functions to be run upon entering Forms mode.")
 276 \f
 277 ;;; Mandatory variables - must be set by evaluating the control file.
 278
 279 (defvar forms-file nil
 280   "Name of the file holding the data.")
 281
 282 (defvar forms-format-list nil
 283   "List of formatting specifications.")
 284
 285 (defvar forms-number-of-fields nil
 286   "Number of fields per record.")
 287 \f
 288 ;;; Optional variables with default values.
 289
 290 (defvar forms-field-sep "\t"
 291   "Field separator character (default TAB).")
 292
 293 (defvar forms-read-only nil
 294   "Non-nil means: visit the file in view (read-only) mode.
 295 (Defaults to the write access on the data file).")
 296
 297 (defvar forms-multi-line "\C-k"
 298   "If not nil: use this character to separate multi-line fields (default C-k).")
 299
 300 (defvar forms-forms-scroll nil
 301   "*Non-nil means replace scroll-up/down commands in Forms mode.
 302 The replacement commands performs forms-next/prev-record.")
 303
 304 (defvar forms-forms-jump nil
 305   "*Non-nil means redefine beginning/end-of-buffer in Forms mode.
 306 The replacement commands performs forms-first/last-record.")
 307
 308 (defvar forms-new-record-filter nil
 309   "The name of a function that is called when a new record is created.")
 310
 311 (defvar forms-modified-record-filter nil
 312   "The name of a function that is called when a record has been modified.")
 313
 314 (defvar forms-fields nil
 315   "List with fields of the current forms.  First field has number 1.
 316 This variable is for use by the filter routines only.
 317 The contents may NOT be modified.")
 318
 319 (defvar forms-use-text-properties (fboundp 'set-text-properties)
 320   "*Non-nil means: use emacs-19 text properties.
 321 Defaults to t if this emacs is capable of handling text properties.")
 322
 323 (defvar forms-ro-face 'default
 324   "The face (a symbol) that is used to display read-only text on the screen.")
 325
 326 (defvar forms-rw-face 'region
 327   "The face (a symbol) that is used to display read-write text on the screen.")
 328 \f
 329 ;;; Internal variables.
 330
 331 (defvar forms--file-buffer nil
 332   "Buffer which holds the file data")
 333
 334 (defvar forms--total-records 0
 335   "Total number of records in the data file.")
 336
 337 (defvar forms--current-record 0
 338   "Number of the record currently on the screen.")
 339
 340 (defvar forms-mode-map nil
 341    "Keymap for form buffer.")
 342 (defvar forms-mode-ro-map nil
 343    "Keymap for form buffer in view mode.")
 344 (defvar forms-mode-edit-map nil
 345    "Keymap for form buffer in edit mode.")
 346
 347 (defvar forms--markers nil
 348   "Field markers in the screen.")
 349
 350 (defvar forms--dyntexts nil
 351   "Dynamic texts (resulting from function calls) on the screen.")
 352
 353 (defvar forms--the-record-list nil
 354    "List of strings of the current record, as parsed from the file.")
 355
 356 (defvar forms--search-regexp nil
 357   "Last regexp used by forms-search.")
 358
 359 (defvar forms--format nil
 360   "Formatting routine.")
 361
 362 (defvar forms--parser nil
 363   "Forms parser routine.")
 364
 365 (defvar forms--mode-setup nil
 366   "To keep track of forms-mode being set-up.")
 367 (make-variable-buffer-local 'forms--mode-setup)
 368
 369 (defvar forms--dynamic-text nil
 370   "Array that holds dynamic texts to insert between fields.")
 371
 372 (defvar forms--elements nil
 373   "Array with the order in which the fields are displayed.")
 374
 375 (defvar forms--ro-face nil
 376   "Face used to represent read-only data on the screen.")
 377
 378 (defvar forms--rw-face nil
 379   "Face used to represent read-write data on the screen.")
 380 \f
 381 ;;;###autoload
 382 (defun forms-mode (&optional primary)
 383   "Major mode to visit files in a field-structured manner using a form.
 384
 385 Commands:                        Equivalent keys in read-only mode:
 386  TAB            forms-next-field          TAB
 387  \\C-c TAB       forms-next-field
 388  \\C-c <         forms-first-record         <
 389  \\C-c >         forms-last-record          >
 390  \\C-c ?         describe-mode              ?
 391  \\C-c \\C-k      forms-delete-record
 392  \\C-c \\C-q      forms-toggle-read-only     q
 393  \\C-c \\C-o      forms-insert-record
 394  \\C-c \\C-l      forms-jump-record          l
 395  \\C-c \\C-n      forms-next-record          n
 396  \\C-c \\C-p      forms-prev-record          p
 397  \\C-c \\C-s      forms-search               s
 398  \\C-c \\C-x      forms-exit                 x
 399 "
 400   (interactive)
 401
 402   ;; This is not a simple major mode, as usual.  Therefore, forms-mode
 403   ;; takes an optional argument `primary' which is used for the
 404   ;; initial set-up.  Normal use would leave `primary' to nil.
 405   ;; A global buffer-local variable `forms--mode-setup' has the same
 406   ;; effect but makes it possible to auto-invoke forms-mode using
 407   ;; `find-file'.
 408   ;; Note: although it seems logical to have `make-local-variable'
 409   ;; executed where the variable is first needed, I have deliberately
 410   ;; placed all calls in this function.
 411
 412   ;; Primary set-up: evaluate buffer and check if the mandatory
 413   ;; variables have been set.
 414   (if (or primary (not forms--mode-setup))
 415       (progn
 416         ;;(message "forms: setting up...")
 417         (kill-all-local-variables)
 418
 419         ;; Make mandatory variables.
 420         (make-local-variable 'forms-file)
 421         (make-local-variable 'forms-number-of-fields)
 422         (make-local-variable 'forms-format-list)
 423
 424         ;; Make optional variables.
 425         (make-local-variable 'forms-field-sep)
 426         (make-local-variable 'forms-read-only)
 427         (make-local-variable 'forms-multi-line)
 428         (make-local-variable 'forms-forms-scroll)
 429         (make-local-variable 'forms-forms-jump)
 430         (make-local-variable 'forms-use-text-properties)
 431         (make-local-variable 'forms-new-record-filter)
 432         (make-local-variable 'forms-modified-record-filter)
 433
 434         ;; Make sure no filters exist.
 435         (setq forms-new-record-filter nil)
 436         (setq forms-modified-record-filter nil)
 437
 438         ;; If running Emacs 19 under X, setup faces to show read-only and
 439         ;; read-write fields.
 440         (if (fboundp 'make-face)
 441             (progn
 442               (make-local-variable 'forms-ro-face)
 443               (make-local-variable 'forms-rw-face)))
 444
 445         ;; eval the buffer, should set variables
 446         ;;(message "forms: processing control file...")
 447         (eval-current-buffer)
 448
 449         ;; check if the mandatory variables make sense.
 450         (or forms-file
 451             (error (concat "Forms control file error: "
 452                            "'forms-file' has not been set")))
 453         (or forms-number-of-fields
 454             (error (concat "Forms control file error: "
 455                            "'forms-number-of-fields' has not been set")))
 456         (or (and (numberp forms-number-of-fields)
 457                  (> forms-number-of-fields 0))
 458             (error (concat "Forms control file error: "
 459                            "'forms-number-of-fields' must be a number > 0")))
 460         (or (stringp forms-field-sep)
 461             (error (concat "Forms control file error: "
 462                            "'forms-field-sep' is not a string")))
 463         (if forms-multi-line
 464             (if (and (stringp forms-multi-line)
 465                      (eq (length forms-multi-line) 1))
 466                 (if (string= forms-multi-line forms-field-sep)
 467                     (error (concat "Forms control file error: "
 468                                    "'forms-multi-line' is equal to 'forms-field-sep'")))
 469               (error (concat "Forms control file error: "
 470                              "'forms-multi-line' must be nil or a one-character string"))))
 471         (or (fboundp 'set-text-properties)
 472             (setq forms-use-text-properties nil))
 473
 474         ;; Validate and process forms-format-list.
 475         ;;(message "forms: pre-processing format list...")
 476         (forms--process-format-list)
 477
 478         ;; Build the formatter and parser.
 479         ;;(message "forms: building formatter...")
 480         (make-local-variable 'forms--format)
 481         (make-local-variable 'forms--markers)
 482         (make-local-variable 'forms--dyntexts)
 483         (make-local-variable 'forms--elements)
 484         ;;(message "forms: building parser...")
 485         (forms--make-format)
 486         (make-local-variable 'forms--parser)
 487         (forms--make-parser)
 488         ;;(message "forms: building parser... done.")
 489
 490         ;; Check if record filters are defined.
 491         (if (and forms-new-record-filter
 492                  (not (fboundp forms-new-record-filter)))
 493             (error (concat "Forms control file error: "
 494                            "'forms-new-record-filter' is not a function")))
 495
 496         (if (and forms-modified-record-filter
 497                  (not (fboundp forms-modified-record-filter)))
 498             (error (concat "Forms control file error: "
 499                            "'forms-modified-record-filter' is not a function")))
 500
 501         ;; The filters acces the contents of the forms using `forms-fields'.
 502         (make-local-variable 'forms-fields)
 503
 504         ;; Dynamic text support.
 505         (make-local-variable 'forms--dynamic-text)
 506
 507         ;; Prevent accidental overwrite of the control file and autosave.
 508         (setq buffer-file-name nil)
 509         (auto-save-mode nil)
 510
 511         ;; Prepare this buffer for further processing.
 512         (setq buffer-read-only nil)
 513         (erase-buffer)
 514
 515         ;;(message "forms: setting up... done.")
 516         ))
 517
 518   ;; Copy desired faces to the actual variables used by the forms formatter.
 519   (if (fboundp 'make-face)
 520       (progn
 521         (make-local-variable 'forms--ro-face)
 522         (make-local-variable 'forms--rw-face)
 523         (if forms-read-only
 524             (progn
 525               (setq forms--ro-face forms-ro-face)
 526               (setq forms--rw-face forms-ro-face))
 527           (setq forms--ro-face forms-ro-face)
 528           (setq forms--rw-face forms-rw-face))))
 529
 530   ;; Make more local variables.
 531   (make-local-variable 'forms--file-buffer)
 532   (make-local-variable 'forms--total-records)
 533   (make-local-variable 'forms--current-record)
 534   (make-local-variable 'forms--the-record-list)
 535   (make-local-variable 'forms--search-regexp)
 536
 537   ; The keymaps are global, so multiple forms mode buffers can share them.
 538   ;(make-local-variable 'forms-mode-map)
 539   ;(make-local-variable 'forms-mode-ro-map)
 540   ;(make-local-variable 'forms-mode-edit-map)
 541   (if forms-mode-map                    ; already defined
 542       nil
 543     ;;(message "forms: building keymap...")
 544     (forms--mode-commands)
 545     ;;(message "forms: building keymap... done.")
 546     )
 547
 548   ;; set the major mode indicator
 549   (setq major-mode 'forms-mode)
 550   (setq mode-name "Forms")
 551
 552   ;; find the data file
 553   (setq forms--file-buffer (find-file-noselect forms-file))
 554
 555   ;; count the number of records, and set see if it may be modified
 556   (let (ro)
 557     (setq forms--total-records
 558           (save-excursion
 559             (prog1
 560                 (progn
 561                   ;;(message "forms: counting records...")
 562                   (set-buffer forms--file-buffer)
 563                   (bury-buffer (current-buffer))
 564                   (setq ro buffer-read-only)
 565                   (count-lines (point-min) (point-max)))
 566               ;;(message "forms: counting records... done.")
 567               )))
 568     (if ro
 569         (setq forms-read-only t)))
 570
 571   ;;(message "forms: proceeding setup...")
 572
 573   ;; Since we aren't really implementing a minor mode, we hack the modeline
 574   ;; directly to get the text " View " into forms-read-only form buffers.  For
 575   ;; that reason, this variable must be buffer only.
 576   (make-local-variable 'minor-mode-alist)
 577   (setq minor-mode-alist (list (list 'forms-read-only " View")))
 578
 579   ;;(message "forms: proceeding setup (keymaps)...")
 580   (forms--set-keymaps)
 581   ;;(message "forms: proceeding setup (commands)...")
 582   (forms--change-commands)
 583
 584   ;;(message "forms: proceeding setup (buffer)...")
 585   (set-buffer-modified-p nil)
 586
 587   ;; setup the first (or current) record to show
 588   (if (< forms--current-record 1)
 589       (setq forms--current-record 1))
 590   (forms-jump-record forms--current-record)
 591
 592   ;; user customising
 593   ;;(message "forms: proceeding setup (user hooks)...")
 594   (run-hooks 'forms-mode-hooks)
 595   ;;(message "forms: setting up... done.")
 596
 597   ;; be helpful
 598   (forms--help)
 599
 600   ;; initialization done
 601   (setq forms--mode-setup t))
 602 \f
 603 (defun forms--process-format-list ()
 604   ;; Validate `forms-format-list' and set some global variables.
 605   ;; Symbols in the list are evaluated, and consecutive strings are
 606   ;; concatenated.
 607   ;; Array `forms--elements' is constructed that contains the order
 608   ;; of the fields on the display. This array is used by
 609   ;; `forms--parser-using-text-properties' to extract the fields data
 610   ;; from the form on the screen.
 611   ;; Upon completion, `forms-format-list' is garanteed correct, so
 612   ;; `forms--make-format' and `forms--make-parser' do not need to perform
 613   ;; any checks.
 614
 615   ;; Verify that `forms-format-list' is not nil.
 616   (or forms-format-list
 617       (error (concat "Forms control file error: "
 618                      "'forms-format-list' has not been set")))
 619   ;; It must be a list.
 620   (or (listp forms-format-list)
 621       (error (concat "Forms control file error: "
 622                      "'forms-format-list' is not a list")))
 623
 624   ;; Assume every field is painted once.
 625   ;; `forms--elements' will grow if needed.
 626   (setq forms--elements (make-vector forms-number-of-fields nil))
 627
 628   (let ((the-list forms-format-list)    ; the list of format elements
 629         (this-item 0)                   ; element in list
 630         (prev-item nil)
 631         (field-num 0))                  ; highest field number
 632
 633     (setq forms-format-list nil)        ; gonna rebuild
 634
 635     (while the-list
 636
 637       (let ((el (car-safe the-list))
 638             (rem (cdr-safe the-list)))
 639
 640         ;; If it is a symbol, eval it first.
 641         (if (and (symbolp el)
 642                  (boundp el))
 643             (setq el (eval el)))
 644
 645         (cond
 646
 647          ;; Try string ...
 648          ((stringp el)
 649           (if (stringp prev-item)       ; try to concatenate strings
 650               (setq prev-item (concat prev-item el))
 651             (if prev-item
 652                 (setq forms-format-list
 653                       (append forms-format-list (list prev-item) nil)))
 654             (setq prev-item el)))
 655
 656          ;; Try numeric ...
 657          ((numberp el)
 658
 659           ;; Validate range.
 660           (if (or (<= el 0)
 661                   (> el forms-number-of-fields))
 662               (error (concat "Forms format error: "
 663                              "field number %d out of range 1..%d")
 664                      el forms-number-of-fields))
 665
 666           ;; Store forms order.
 667           (if (> field-num (length forms--elements))
 668               (setq forms--elements (vconcat forms--elements (1- el)))
 669             (aset forms--elements field-num (1- el)))
 670           (setq field-num (1+ field-num))
 671
 672           (if prev-item
 673               (setq forms-format-list
 674                     (append forms-format-list (list prev-item) nil)))
 675           (setq prev-item el))
 676
 677          ;; Try function ...
 678          ((listp el)
 679
 680           ;; Validate.
 681           (or (fboundp (car-safe el))
 682               (error (concat "Forms format error: "
 683                              "not a function "
 684                              (prin1-to-string (car-safe el)))))
 685
 686           ;; Shift.
 687           (if prev-item
 688               (setq forms-format-list
 689                     (append forms-format-list (list prev-item) nil)))
 690           (setq prev-item el))
 691
 692          ;; else
 693          (t
 694           (error (concat "Forms format error: "
 695                          "invalid element "
 696                          (prin1-to-string el)))))
 697
 698         ;; Advance to next element of the list.
 699         (setq the-list rem)))
 700
 701     ;; Append last item.
 702     (if prev-item
 703         (progn
 704           (setq forms-format-list
 705                 (append forms-format-list (list prev-item) nil))
 706           ;; Append a newline if the last item is a field.
 707           ;; This prevents parsing problems.
 708           ;; Also it makes it possible to insert an empty last field.
 709           (if (numberp prev-item)
 710               (setq forms-format-list
 711                     (append forms-format-list (list "\n") nil))))))
 712
 713   (forms--debug 'forms-format-list
 714                 'forms--elements))
 715 \f
 716 ;; Special treatment for read-only segments.
 717 ;;
 718 ;; If text is inserted between two read-only segments, it inherits the
 719 ;; read-only properties.  This is not what we want.
 720 ;; To solve this, read-only segments get the `insert-in-front-hooks'
 721 ;; property set with a function that temporarily switches the properties
 722 ;; of the first character of the segment to read-write, so the new
 723 ;; text gets the right properties.
 724 ;; The `post-command-hook' is used to restore the original properties.
 725
 726 (defvar forms--iif-start nil
 727   "Record start of modification command.")
 728 (defvar forms--iif-properties nil
 729   "Original properties of the character being overridden.")
 730
 731 (defun forms--iif-hook (begin end)
 732   "`insert-in-front-hooks' function for read-only segments."
 733
 734   ;; Note start location.  By making it a marker that points one
 735   ;; character beyond the actual location, it is guaranteed to move
 736   ;; correctly if text is inserted.
 737   (or forms--iif-start
 738       (setq forms--iif-start (copy-marker (1+ (point)))))
 739
 740   ;; Check if there is special treatment required.
 741   (if (or (<= forms--iif-start 2)
 742           (get-text-property (- forms--iif-start 2)
 743                              'read-only))
 744       (progn
 745         ;; Fetch current properties.
 746         (setq forms--iif-properties
 747               (text-properties-at (1- forms--iif-start)))
 748
 749         ;; Replace them.
 750         (let ((inhibit-read-only t))
 751           (set-text-properties
 752            (1- forms--iif-start) forms--iif-start
 753            (list 'face forms--rw-face 'front-sticky '(face))))
 754
 755         ;; Enable `post-command-hook' to restore the properties.
 756         (setq post-command-hook
 757               (append (list 'forms--iif-post-command-hook) post-command-hook)))
 758
 759     ;; No action needed.  Clear marker.
 760     (setq forms--iif-start nil)))
 761
 762 (defun forms--iif-post-command-hook ()
 763   "`post-command-hook' function for read-only segments."
 764
 765   ;; Disable `post-command-hook'.
 766   (setq post-command-hook
 767         (delq 'forms--iif-hook-post-command-hook post-command-hook))
 768
 769   ;; Restore properties.
 770   (if forms--iif-start
 771       (let ((inhibit-read-only t))
 772         (set-text-properties
 773          (1- forms--iif-start) forms--iif-start
 774          forms--iif-properties)))
 775
 776   ;; Cleanup.
 777   (setq forms--iif-start nil))
 778 \f
 779 (defvar forms--marker)
 780 (defvar forms--dyntext)
 781
 782 (defun forms--make-format ()
 783   "Generate `forms--format' using the information in `forms-format-list'."
 784
 785   ;; The real work is done using a mapcar of `forms--make-format-elt' on
 786   ;; `forms-format-list'.
 787   ;; This function sets up the necessary environment, and decides
 788   ;; which function to mapcar.
 789
 790   (let ((forms--marker 0)
 791         (forms--dyntext 0))
 792     (setq
 793      forms--format
 794      (if forms-use-text-properties
 795          (` (lambda (arg)
 796               (let ((inhibit-read-only t))
 797                 (,@ (apply 'append
 798                            (mapcar 'forms--make-format-elt-using-text-properties
 799                                    forms-format-list)))
 800                 ;; Prevent insertion before the first text.
 801                 (,@ (if (numberp (car forms-format-list))
 802                         nil
 803                       '((add-text-properties (point-min) (1+ (point-min))
 804                                              '(front-sticky (read-only))))))
 805                 ;; Prevent insertion after the last text.
 806                 (remove-text-properties (1- (point)) (point)
 807                                         '(rear-nonsticky)))
 808               (setq forms--iif-start nil)))
 809        (` (lambda (arg)
 810             (,@ (apply 'append
 811                        (mapcar 'forms--make-format-elt forms-format-list)))))))
 812
 813     ;; We have tallied the number of markers and dynamic texts,
 814     ;; so we can allocate the arrays now.
 815     (setq forms--markers (make-vector forms--marker nil))
 816     (setq forms--dyntexts (make-vector forms--dyntext nil)))
 817   (forms--debug 'forms--format))
 818
 819 (defun forms--make-format-elt-using-text-properties (el)
 820   "Helper routine to generate format function."
 821
 822   ;; The format routine `forms--format' will look like
 823   ;;
 824   ;; ;; preamble
 825   ;; (lambda (arg)
 826   ;;   (let ((inhibit-read-only t))
 827   ;;
 828   ;;     ;; A string, e.g. "text: ".
 829   ;;     (set-text-properties
 830   ;;      (point)
 831   ;;      (progn (insert "text: ") (point))
 832   ;;      (list 'face forms--ro-face
 833   ;;            'read-only 1
 834   ;;            'insert-in-front-hooks 'forms--iif-hook
 835   ;;            'rear-nonsticky '(read-only face insert-in-front-hooks)))
 836   ;;
 837   ;;     ;; A field, e.g. 6.
 838   ;;     (let ((here (point)))
 839   ;;       (aset forms--markers 0 (point-marker))
 840   ;;       (insert (elt arg 5))
 841   ;;       (or (= (point) here)
 842   ;;      (set-text-properties
 843   ;;       here (point)
 844   ;;       (list 'face forms--rw-face
 845   ;;             'front-sticky '(face))))
 846   ;;
 847   ;;     ;; Another string, e.g. "\nmore text: ".
 848   ;;     (set-text-properties
 849   ;;      (point)
 850   ;;      (progn (insert "\nmore text: ") (point))
 851   ;;      (list 'face forms--ro-face
 852   ;;            'read-only 2
 853   ;;            'insert-in-front-hooks 'forms--iif-hook
 854   ;;            'rear-nonsticky '(read-only face insert-in-front-hooks)))
 855   ;;
 856   ;;     ;; A function, e.g. (tocol 40).
 857   ;;     (set-text-properties
 858   ;;      (point)
 859   ;;      (progn
 860   ;;        (insert (aset forms--dyntexts 0 (tocol 40)))
 861   ;;        (point))
 862   ;;      (list 'face forms--ro-face
 863   ;;            'read-only 2
 864   ;;            'insert-in-front-hooks 'forms--iif-hook
 865   ;;            'rear-nonsticky '(read-only face insert-in-front-hooks)))
 866   ;;
 867   ;;     ;; Prevent insertion before the first text.
 868   ;;     (add-text-properties (point-min) (1+ (point-min))
 869   ;;                          '(front-sticky (read-only))))))
 870   ;;     ;; Prevent insertion after the last text.
 871   ;;     (remove-text-properties (1- (point)) (point)
 872   ;;                             '(rear-nonsticky)))
 873   ;;
 874   ;;     ;; wrap up
 875   ;;     (setq forms--iif-start nil)
 876   ;;     ))
 877
 878   (cond
 879    ((stringp el)
 880
 881     (` ((set-text-properties
 882          (point)                        ; start at point
 883          (progn                         ; until after insertion
 884            (insert (, el))
 885            (point))
 886          (list 'face forms--ro-face     ; read-only appearance
 887                'read-only (,@ (list (1+ forms--marker)))
 888                'insert-in-front-hooks '(forms--iif-hook)
 889                'rear-nonsticky '(face read-only insert-in-front-hooks))))))
 890
 891    ((numberp el)
 892     (` ((let ((here (point)))
 893           (aset forms--markers
 894                 (, (prog1 forms--marker
 895                      (setq forms--marker (1+ forms--marker))))
 896                 (point-marker))
 897           (insert (elt arg (, (1- el))))
 898           (or (= (point) here)
 899               (set-text-properties
 900                here (point)
 901                (list 'face forms--rw-face
 902                      'front-sticky '(face))))))))
 903
 904    ((listp el)
 905     (` ((set-text-properties
 906          (point)
 907          (progn
 908            (insert (aset forms--dyntexts
 909                          (, (prog1 forms--dyntext
 910                               (setq forms--dyntext (1+ forms--dyntext))))
 911                          (, el)))
 912            (point))
 913          (list 'face forms--ro-face
 914                'read-only (,@ (list (1+ forms--marker)))
 915                'insert-in-front-hooks '(forms--iif-hook)
 916                'rear-nonsticky '(read-only face insert-in-front-hooks))))))
 917
 918    ;; end of cond
 919    ))
 920
 921 (defun forms--make-format-elt (el)
 922   "Helper routine to generate format function."
 923
 924   ;; If we're not using text properties, the format routine
 925   ;; `forms--format' will look like
 926   ;;
 927   ;; (lambda (arg)
 928   ;;   ;; a string, e.g. "text: "
 929   ;;   (insert "text: ")
 930   ;;   ;; a field, e.g. 6
 931   ;;   (aset forms--markers 0 (point-marker))
 932   ;;   (insert (elt arg 5))
 933   ;;   ;; another string, e.g. "\nmore text: "
 934   ;;   (insert "\nmore text: ")
 935   ;;   ;; a function, e.g. (tocol 40)
 936   ;;   (insert (aset forms--dyntexts 0 (tocol 40)))
 937   ;;   ... )
 938
 939   (cond
 940    ((stringp el)
 941     (` ((insert (, el)))))
 942    ((numberp el)
 943     (prog1
 944         (` ((aset forms--markers (, forms--marker) (point-marker))
 945             (insert (elt arg (, (1- el))))))
 946       (setq forms--marker (1+ forms--marker))))
 947    ((listp el)
 948     (prog1
 949         (` ((insert (aset forms--dyntexts (, forms--dyntext) (, el)))))
 950       (setq forms--dyntext (1+ forms--dyntext))))))
 951 \f
 952 (defvar forms--field)
 953 (defvar forms--recordv)
 954 (defvar forms--seen-text)
 955
 956 (defun forms--make-parser ()
 957   "Generate `forms--parser' from the information in `forms-format-list'."
 958
 959   ;; If we can use text properties, we simply set it to
 960   ;; `forms--parser-using-text-properties'.
 961   ;; Otherwise, the function is constructed using a mapcar of
 962   ;; `forms--make-parser-elt on `forms-format-list'.
 963
 964   (setq
 965    forms--parser
 966    (if forms-use-text-properties
 967        (function forms--parser-using-text-properties)
 968      (let ((forms--field nil)
 969            (forms--seen-text nil)
 970            (forms--dyntext 0))
 971
 972        ;; Note: we add a nil element to the list passed to `mapcar',
 973        ;; see `forms--make-parser-elt' for details.
 974        (` (lambda nil
 975             (let (here)
 976               (goto-char (point-min))
 977               (,@ (apply 'append
 978                          (mapcar
 979                           'forms--make-parser-elt
 980                           (append forms-format-list (list nil)))))))))))
 981
 982   (forms--debug 'forms--parser))
 983
 984 (defun forms--parser-using-text-properties ()
 985   "Extract field info from forms when using text properties."
 986
 987   ;; Using text properties, we can simply jump to the markers, and
 988   ;; extract the information up to the following read-only segment.
 989
 990   (let ((i 0)
 991         here there)
 992     (while (< i (length forms--markers))
 993       (goto-char (setq here (aref forms--markers i)))
 994       (if (get-text-property here 'read-only)
 995           (aset forms--recordv (aref forms--elements i) nil)
 996         (if (setq there
 997                   (next-single-property-change here 'read-only))
 998             (aset forms--recordv (aref forms--elements i)
 999                   (buffer-substring here there))
1000           (aset forms--recordv (aref forms--elements i)
1001                 (buffer-substring here (point-max)))))
1002       (setq i (1+ i)))))
1003
1004 (defun forms--make-parser-elt (el)
1005   "Helper routine to generate forms parser function."
1006
1007   ;; The parse routine will look like:
1008   ;;
1009   ;; (lambda nil
1010   ;;   (let (here)
1011   ;;     (goto-char (point-min))
1012   ;;
1013   ;;     ;;  "text: "
1014   ;;     (if (not (looking-at "text: "))
1015   ;;        (error "Parse error: cannot find \"text: \""))
1016   ;;     (forward-char 6)       ; past "text: "
1017   ;;
1018   ;;     ;;  6
1019   ;;     ;;  "\nmore text: "
1020   ;;     (setq here (point))
1021   ;;     (if (not (search-forward "\nmore text: " nil t nil))
1022   ;;        (error "Parse error: cannot find \"\\nmore text: \""))
1023   ;;     (aset forms--recordv 5 (buffer-substring here (- (point) 12)))
1024   ;;
1025   ;;     ;;  (tocol 40)
1026   ;;    (let ((forms--dyntext (car-safe forms--dynamic-text)))
1027   ;;      (if (not (looking-at (regexp-quote forms--dyntext)))
1028   ;;          (error "Parse error: not looking at \"%s\"" forms--dyntext))
1029   ;;      (forward-char (length forms--dyntext))
1030   ;;      (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))
1031   ;;     ...
1032   ;;     ;; final flush (due to terminator sentinel, see below)
1033   ;;    (aset forms--recordv 7 (buffer-substring (point) (point-max)))
1034
1035   (cond
1036    ((stringp el)
1037     (prog1
1038         (if forms--field
1039             (` ((setq here (point))
1040                 (if (not (search-forward (, el) nil t nil))
1041                     (error "Parse error: cannot find \"%s\"" (, el)))
1042                 (aset forms--recordv (, (1- forms--field))
1043                       (buffer-substring here
1044                                         (- (point) (, (length el)))))))
1045           (` ((if (not (looking-at (, (regexp-quote el))))
1046                   (error "Parse error: not looking at \"%s\"" (, el)))
1047               (forward-char (, (length el))))))
1048       (setq forms--seen-text t)
1049       (setq forms--field nil)))
1050    ((numberp el)
1051     (if forms--field
1052         (error "Cannot parse adjacent fields %d and %d"
1053                forms--field el)
1054       (setq forms--field el)
1055       nil))
1056    ((null el)
1057     (if forms--field
1058         (` ((aset forms--recordv (, (1- forms--field))
1059                   (buffer-substring (point) (point-max)))))))
1060    ((listp el)
1061     (prog1
1062         (if forms--field
1063             (` ((let ((here (point))
1064                       (forms--dyntext (aref forms--dyntexts (, forms--dyntext))))
1065                   (if (not (search-forward forms--dyntext nil t nil))
1066                       (error "Parse error: cannot find \"%s\"" forms--dyntext))
1067                   (aset forms--recordv (, (1- forms--field))
1068                         (buffer-substring here
1069                                           (- (point) (length forms--dyntext)))))))
1070           (` ((let ((forms--dyntext (aref forms--dyntexts (, forms--dyntext))))
1071                 (if (not (looking-at (regexp-quote forms--dyntext)))
1072                     (error "Parse error: not looking at \"%s\"" forms--dyntext))
1073                 (forward-char (length forms--dyntext))))))
1074       (setq forms--dyntext (1+ forms--dyntext))
1075       (setq forms--seen-text t)
1076       (setq forms--field nil)))
1077    ))
1078 \f
1079 (defun forms--set-keymaps ()
1080   "Set the keymaps used in this mode."
1081
1082   (use-local-map (if forms-read-only
1083                      forms-mode-ro-map
1084                    forms-mode-edit-map)))
1085
1086 (defun forms--mode-commands ()
1087   "Fill the Forms mode keymaps."
1088
1089   ;; `forms-mode-map' is always accessible via \C-c prefix.
1090   (setq forms-mode-map (make-keymap))
1091   (define-key forms-mode-map "\t" 'forms-next-field)
1092   (define-key forms-mode-map "\C-k" 'forms-delete-record)
1093   (define-key forms-mode-map "\C-q" 'forms-toggle-read-only)
1094   (define-key forms-mode-map "\C-o" 'forms-insert-record)
1095   (define-key forms-mode-map "\C-l" 'forms-jump-record)
1096   (define-key forms-mode-map "\C-n" 'forms-next-record)
1097   (define-key forms-mode-map "\C-p" 'forms-prev-record)
1098   (define-key forms-mode-map "\C-s" 'forms-search)
1099   (define-key forms-mode-map "\C-x" 'forms-exit)
1100   (define-key forms-mode-map "<" 'forms-first-record)
1101   (define-key forms-mode-map ">" 'forms-last-record)
1102   (define-key forms-mode-map "?" 'describe-mode)
1103   (define-key forms-mode-map "\C-?" 'forms-prev-record)
1104
1105   ;; `forms-mode-ro-map' replaces the local map when in read-only mode.
1106   (setq forms-mode-ro-map (make-keymap))
1107   (suppress-keymap forms-mode-ro-map)
1108   (define-key forms-mode-ro-map "\C-c" forms-mode-map)
1109   (define-key forms-mode-ro-map "\t" 'forms-next-field)
1110   (define-key forms-mode-ro-map "q" 'forms-toggle-read-only)
1111   (define-key forms-mode-ro-map "l" 'forms-jump-record)
1112   (define-key forms-mode-ro-map "n" 'forms-next-record)
1113   (define-key forms-mode-ro-map "p" 'forms-prev-record)
1114   (define-key forms-mode-ro-map "s" 'forms-search)
1115   (define-key forms-mode-ro-map "x" 'forms-exit)
1116   (define-key forms-mode-ro-map "<" 'forms-first-record)
1117   (define-key forms-mode-ro-map ">" 'forms-last-record)
1118   (define-key forms-mode-ro-map "?" 'describe-mode)
1119   (define-key forms-mode-ro-map " " 'forms-next-record)
1120   (forms--mode-commands1 forms-mode-ro-map)
1121
1122   ;; This is the normal, local map.
1123   (setq forms-mode-edit-map (make-keymap))
1124   (define-key forms-mode-edit-map "\t"   'forms-next-field)
1125   (define-key forms-mode-edit-map "\C-c" forms-mode-map)
1126   (forms--mode-commands1 forms-mode-edit-map)
1127   )
1128
1129 (defun forms--mode-commands1 (map)
1130   "Helper routine to define keys."
1131   (define-key map [TAB] 'forms-next-field)
1132   (define-key map [S-tab] 'forms-prev-field)
1133   (define-key map [next] 'forms-next-record)
1134   (define-key map [prior] 'forms-prev-record)
1135   (define-key map [begin] 'forms-first-record)
1136   (define-key map [last] 'forms-last-record)
1137   (define-key map [backtab] 'forms-prev-field)
1138   )
1139 \f
1140 ;;; Changed functions
1141
1142 (defun forms--change-commands ()
1143   "Localize some commands for Forms mode."
1144
1145   ;; scroll-down -> forms-prev-record
1146   ;; scroll-up -> forms-next-record
1147   (if forms-forms-scroll
1148       (progn
1149         (substitute-key-definition 'scroll-up 'forms-next-record
1150                                    (current-local-map)
1151                                    (current-global-map))
1152         (substitute-key-definition 'scroll-down 'forms-prev-record
1153                                    (current-local-map)
1154                                    (current-global-map))))
1155   ;;
1156   ;; beginning-of-buffer -> forms-first-record
1157   ;; end-of-buffer -> forms-end-record
1158   (if forms-forms-jump
1159       (progn
1160         (substitute-key-definition 'beginning-of-buffer 'forms-first-record
1161                                    (current-local-map)
1162                                    (current-global-map))
1163         (substitute-key-definition 'end-of-buffer 'forms-last-record
1164                                    (current-local-map)
1165                                    (current-global-map))))
1166   ;;
1167   ;; save-buffer -> forms--save-buffer
1168   (make-local-variable 'local-write-file-hooks)
1169   (add-hook 'local-write-file-hooks
1170             (function
1171              (lambda (nil)
1172                (forms--checkmod)
1173                (save-excursion
1174                  (set-buffer forms--file-buffer)
1175                  (save-buffer))
1176                t)))
1177   ;; We have our own revert function - use it
1178   (make-local-variable 'revert-buffer-function)
1179   (setq revert-buffer-function 'forms-revert-buffer)
1180
1181   t)
1182
1183 (defun forms--help ()
1184   "Initial help for Forms mode."
1185   ;; We should use
1186   (message (substitute-command-keys (concat
1187   "\\[forms-next-record]:next"
1188   "   \\[forms-prev-record]:prev"
1189   "   \\[forms-first-record]:first"
1190   "   \\[forms-last-record]:last"
1191   "   \\[describe-mode]:help"))))
1192   ; but it's too slow ....
1193 ;  (if forms-read-only
1194 ;      (message "SPC:next   DEL:prev   <:first   >:last   ?:help   q:exit")
1195 ;    (message "C-c n:next   C-c p:prev   C-c <:first   C-c >:last   C-c ?:help   C-c q:exit"))
1196 ;  )
1197
1198 (defun forms--trans (subj arg rep)
1199   "Translate in SUBJ all chars ARG into char REP.  ARG and REP should
1200  be single-char strings."
1201   (let ((i 0)
1202         (x (length subj))
1203         (re (regexp-quote arg))
1204         (k (string-to-char rep)))
1205     (while (setq i (string-match re subj i))
1206       (aset subj i k)
1207       (setq i (1+ i)))))
1208
1209 (defun forms--exit (query &optional save)
1210   "Internal exit from forms mode function."
1211
1212   (let ((buf (buffer-name forms--file-buffer)))
1213     (forms--checkmod)
1214     (if (and save
1215              (buffer-modified-p forms--file-buffer))
1216         (save-excursion
1217           (set-buffer forms--file-buffer)
1218           (save-buffer)))
1219     (save-excursion
1220       (set-buffer forms--file-buffer)
1221       (delete-auto-save-file-if-necessary)
1222       (kill-buffer (current-buffer)))
1223     (if (get-buffer buf)        ; not killed???
1224       (if save
1225           (progn
1226             (beep)
1227             (message "Problem saving buffers?")))
1228       (delete-auto-save-file-if-necessary)
1229       (kill-buffer (current-buffer)))))
1230
1231 (defun forms--get-record ()
1232   "Fetch the current record from the file buffer."
1233
1234   ;; This function is executed in the context of the `forms--file-buffer'.
1235
1236   (or (bolp)
1237       (beginning-of-line nil))
1238   (let ((here (point)))
1239     (prog2
1240      (end-of-line)
1241      (buffer-substring here (point))
1242      (goto-char here))))
1243
1244 (defun forms--show-record (the-record)
1245   "Format THE-RECORD and display it in the current buffer."
1246
1247   ;; Split the-record.
1248   (let (the-result
1249         (start-pos 0)
1250         found-pos
1251         (field-sep-length (length forms-field-sep)))
1252     (if forms-multi-line
1253         (forms--trans the-record forms-multi-line "\n"))
1254     ;; Add an extra separator (makes splitting easy).
1255     (setq the-record (concat the-record forms-field-sep))
1256     (while (setq found-pos (string-match forms-field-sep the-record start-pos))
1257       (let ((ent (substring the-record start-pos found-pos)))
1258         (setq the-result
1259               (append the-result (list ent)))
1260         (setq start-pos (+ field-sep-length found-pos))))
1261     (setq forms--the-record-list the-result))
1262
1263   (setq buffer-read-only nil)
1264   (if forms-use-text-properties
1265       (let ((inhibit-read-only t))
1266         (set-text-properties (point-min) (point-max) nil)))
1267   (erase-buffer)
1268
1269   ;; Verify the number of fields, extend forms--the-record-list if needed.
1270   (if (= (length forms--the-record-list) forms-number-of-fields)
1271       nil
1272     (beep)
1273     (message "Warning: this record has %d fields instead of %d"
1274              (length forms--the-record-list) forms-number-of-fields)
1275     (if (< (length forms--the-record-list) forms-number-of-fields)
1276         (setq forms--the-record-list
1277               (append forms--the-record-list
1278                       (make-list
1279                        (- forms-number-of-fields
1280                           (length forms--the-record-list))
1281                        "")))))
1282
1283   ;; Call the formatter function.
1284   (setq forms-fields (append (list nil) forms--the-record-list nil))
1285   (funcall forms--format forms--the-record-list)
1286
1287   ;; Prepare.
1288   (goto-char (point-min))
1289   (set-buffer-modified-p nil)
1290   (setq buffer-read-only forms-read-only)
1291   (setq mode-line-process
1292         (concat " " forms--current-record "/" forms--total-records)))
1293
1294 (defun forms--parse-form ()
1295   "Parse contents of form into list of strings."
1296   ;; The contents of the form are parsed, and a new list of strings
1297   ;; is constructed.
1298   ;; A vector with the strings from the original record is
1299   ;; constructed, which is updated with the new contents.  Therefore
1300   ;; fields which were not in the form are not modified.
1301   ;; Finally, the vector is transformed into a list for further processing.
1302
1303   (let (forms--recordv)
1304
1305     ;; Build the vector.
1306     (setq forms--recordv (vconcat forms--the-record-list))
1307
1308     ;; Parse the form and update the vector.
1309     (let ((forms--dynamic-text forms--dynamic-text))
1310       (funcall forms--parser))
1311
1312     (if forms-modified-record-filter
1313         ;; As a service to the user, we add a zeroth element so she
1314         ;; can use the same indices as in the forms definition.
1315         (let ((the-fields (vconcat [nil] forms--recordv)))
1316           (setq the-fields (funcall forms-modified-record-filter the-fields))
1317           (cdr (append the-fields nil)))
1318
1319       ;; Transform to a list and return.
1320       (append forms--recordv nil))))
1321
1322 (defun forms--update ()
1323   "Update current record with contents of form.
1324 As a side effect: sets `forms--the-record-list'."
1325
1326   (if forms-read-only
1327       (progn
1328         (message "Read-only buffer!")
1329         (beep))
1330
1331     (let (the-record)
1332       ;; Build new record.
1333       (setq forms--the-record-list (forms--parse-form))
1334       (setq the-record
1335             (mapconcat 'identity forms--the-record-list forms-field-sep))
1336
1337       ;; Handle multi-line fields, if allowed.
1338       (if forms-multi-line
1339           (forms--trans the-record "\n" forms-multi-line))
1340
1341       ;; A final sanity check before updating.
1342       (if (string-match "\n" the-record)
1343           (progn
1344             (message "Multi-line fields in this record - update refused!")
1345             (beep))
1346
1347         (save-excursion
1348           (set-buffer forms--file-buffer)
1349           ;; Use delete-region instead of kill-region, to avoid
1350           ;; adding junk to the kill-ring.
1351           (delete-region (save-excursion (beginning-of-line) (point))
1352                          (save-excursion (end-of-line) (point)))
1353           (insert the-record)
1354           (beginning-of-line))))))
1355
1356 (defun forms--checkmod ()
1357   "Check if this form has been modified, and call forms--update if so."
1358   (if (buffer-modified-p nil)
1359       (let ((here (point)))
1360         (forms--update)
1361         (set-buffer-modified-p nil)
1362         (goto-char here))))
1363 \f
1364 ;;; Start and exit
1365
1366 ;;;###autoload
1367 (defun forms-find-file (fn)
1368   "Visit a file in Forms mode."
1369   (interactive "fForms file: ")
1370   (find-file-read-only fn)
1371   (or forms--mode-setup (forms-mode t)))
1372
1373 ;;;###autoload
1374 (defun forms-find-file-other-window (fn)
1375   "Visit a file in Forms mode in other window."
1376   (interactive "fFbrowse file in other window: ")
1377   (find-file-other-window fn)
1378   (eval-current-buffer)
1379   (or forms--mode-setup (forms-mode t)))
1380
1381 (defun forms-exit (query)
1382   "Normal exit from Forms mode.  Modified buffers are saved."
1383   (interactive "P")
1384   (forms--exit query t))
1385
1386 (defun forms-exit-no-save (query)
1387   "Exit from Forms mode without saving buffers."
1388   (interactive "P")
1389   (forms--exit query nil))
1390 \f
1391 ;;; Navigating commands
1392
1393 (defun forms-next-record (arg)
1394   "Advance to the ARGth following record."
1395   (interactive "P")
1396   (forms-jump-record (+ forms--current-record (prefix-numeric-value arg)) t))
1397
1398 (defun forms-prev-record (arg)
1399   "Advance to the ARGth previous record."
1400   (interactive "P")
1401   (forms-jump-record (- forms--current-record (prefix-numeric-value arg)) t))
1402
1403 (defun forms-jump-record (arg &optional relative)
1404   "Jump to a random record."
1405   (interactive "NRecord number: ")
1406
1407   ;; Verify that the record number is within range.
1408   (if (or (> arg forms--total-records)
1409           (<= arg 0))
1410     (progn
1411       (beep)
1412       ;; Don't give the message if just paging.
1413       (if (not relative)
1414           (message "Record number %d out of range 1..%d"
1415                    arg forms--total-records))
1416       )
1417
1418     ;; Flush.
1419     (forms--checkmod)
1420
1421     ;; Calculate displacement.
1422     (let ((disp (- arg forms--current-record))
1423           (cur forms--current-record))
1424
1425       ;; `forms--show-record' needs it now.
1426       (setq forms--current-record arg)
1427
1428       ;; Get the record and show it.
1429       (forms--show-record
1430        (save-excursion
1431          (set-buffer forms--file-buffer)
1432          (beginning-of-line)
1433
1434          ;; Move, and adjust the amount if needed (shouldn't happen).
1435          (if relative
1436              (if (zerop disp)
1437                  nil
1438                (setq cur (+ cur disp (- (forward-line disp)))))
1439            (setq cur (+ cur disp (- (goto-line arg)))))
1440
1441          (forms--get-record)))
1442
1443       ;; This shouldn't happen.
1444       (if (/= forms--current-record cur)
1445           (progn
1446             (setq forms--current-record cur)
1447             (beep)
1448             (message "Stuck at record %d" cur))))))
1449
1450 (defun forms-first-record ()
1451   "Jump to first record."
1452   (interactive)
1453   (forms-jump-record 1))
1454
1455 (defun forms-last-record ()
1456   "Jump to last record.
1457 As a side effect: re-calculates the number of records in the data file."
1458   (interactive)
1459   (let
1460       ((numrec
1461         (save-excursion
1462           (set-buffer forms--file-buffer)
1463           (count-lines (point-min) (point-max)))))
1464     (if (= numrec forms--total-records)
1465         nil
1466       (beep)
1467       (setq forms--total-records numrec)
1468       (message "Warning: number of records changed to %d" forms--total-records)))
1469   (forms-jump-record forms--total-records))
1470 \f
1471 ;;; Other commands
1472
1473 (defun forms-toggle-read-only (arg)
1474   "Toggles read-only mode of a forms mode buffer.
1475 With an argument, enables read-only mode if the argument is positive.
1476 Otherwise enables edit mode if the visited file is writeable."
1477
1478   (interactive "P")
1479
1480   (if (if arg
1481           ;; Negative arg means switch it off.
1482           (<= (prefix-numeric-value arg) 0)
1483         ;; No arg means toggle.
1484         forms-read-only)
1485
1486       ;; Enable edit mode, if possible.
1487       (let ((ro forms-read-only))
1488         (if (save-excursion
1489               (set-buffer forms--file-buffer)
1490               buffer-read-only)
1491             (progn
1492               (setq forms-read-only t)
1493               (message "No write access to \"%s\"" forms-file)
1494               (beep))
1495           (setq forms-read-only nil))
1496         (if (equal ro forms-read-only)
1497             nil
1498           (forms-mode)))
1499
1500     ;; Enable view mode.
1501     (if forms-read-only
1502         nil
1503       (forms--checkmod)                 ; sync
1504       (setq forms-read-only t)
1505       (forms-mode))))
1506
1507 ;; Sample:
1508 ;; (defun my-new-record-filter (the-fields)
1509 ;;   ;; numbers are relative to 1
1510 ;;   (aset the-fields 4 (current-time-string))
1511 ;;   (aset the-fields 6 (user-login-name))
1512 ;;   the-list)
1513 ;; (setq forms-new-record-filter 'my-new-record-filter)
1514
1515 (defun forms-insert-record (arg)
1516   "Create a new record before the current one.
1517 With ARG: store the record after the current one.
1518 If `forms-new-record-filter' contains the name of a function,
1519 it is called to fill (some of) the fields with default values."
1520
1521   (interactive "P")
1522
1523   (if forms-read-only
1524       (error ""))
1525
1526   (let ((ln (if arg (1+ forms--current-record) forms--current-record))
1527         the-list the-record)
1528
1529     (forms--checkmod)
1530     (if forms-new-record-filter
1531         ;; As a service to the user, we add a zeroth element so she
1532         ;; can use the same indices as in the forms definition.
1533         (let ((the-fields (make-vector (1+ forms-number-of-fields) "")))
1534           (setq the-fields (funcall forms-new-record-filter the-fields))
1535           (setq the-list (cdr (append the-fields nil))))
1536       (setq the-list (make-list forms-number-of-fields "")))
1537
1538     (setq the-record
1539           (mapconcat
1540           'identity
1541           the-list
1542           forms-field-sep))
1543
1544     (save-excursion
1545       (set-buffer forms--file-buffer)
1546       (goto-line ln)
1547       (open-line 1)
1548       (insert the-record)
1549       (beginning-of-line))
1550
1551     (setq forms--current-record ln))
1552
1553   (setq forms--total-records (1+ forms--total-records))
1554   (forms-jump-record forms--current-record))
1555
1556 (defun forms-delete-record (arg)
1557   "Deletes a record.  With a prefix argument: don't ask."
1558   (interactive "P")
1559
1560   (if forms-read-only
1561       (error ""))
1562
1563   (forms--checkmod)
1564   (if (or arg
1565           (y-or-n-p "Really delete this record? "))
1566       (let ((ln forms--current-record))
1567         (save-excursion
1568           (set-buffer forms--file-buffer)
1569           (goto-line ln)
1570           ;; Use delete-region instead of kill-region, to avoid
1571           ;; adding junk to the kill-ring.
1572           (delete-region (save-excursion (beginning-of-line) (point))
1573                          (save-excursion (end-of-line) (1+ (point)))))
1574         (setq forms--total-records (1- forms--total-records))
1575         (if (> forms--current-record forms--total-records)
1576             (setq forms--current-record forms--total-records))
1577         (forms-jump-record forms--current-record)))
1578   (message ""))
1579
1580 (defun forms-search (regexp)
1581   "Search REGEXP in file buffer."
1582   (interactive
1583    (list (read-string (concat "Search for"
1584                                   (if forms--search-regexp
1585                                    (concat " ("
1586                                            forms--search-regexp
1587                                            ")"))
1588                                   ": "))))
1589   (if (equal "" regexp)
1590       (setq regexp forms--search-regexp))
1591   (forms--checkmod)
1592
1593   (let (the-line the-record here
1594                  (fld-sep forms-field-sep))
1595     (if (save-excursion
1596           (set-buffer forms--file-buffer)
1597           (setq here (point))
1598           (end-of-line)
1599           (if (null (re-search-forward regexp nil t))
1600               (progn
1601                 (goto-char here)
1602                 (message (concat "\"" regexp "\" not found."))
1603                 nil)
1604             (setq the-record (forms--get-record))
1605             (setq the-line (1+ (count-lines (point-min) (point))))))
1606         (progn
1607           (setq forms--current-record the-line)
1608           (forms--show-record the-record)
1609           (re-search-forward regexp nil t))))
1610   (setq forms--search-regexp regexp))
1611
1612 (defun forms-revert-buffer (&optional arg noconfirm)
1613   "Reverts current form to un-modified."
1614   (interactive "P")
1615   (if (or noconfirm
1616           (yes-or-no-p "Revert form to unmodified? "))
1617       (progn
1618         (set-buffer-modified-p nil)
1619         (forms-jump-record forms--current-record))))
1620
1621 (defun forms-next-field (arg)
1622   "Jump to ARG-th next field."
1623   (interactive "p")
1624
1625   (let ((i 0)
1626         (here (point))
1627         there
1628         (cnt 0))
1629
1630     (if (zerop arg)
1631         (setq cnt 1)
1632       (setq cnt (+ cnt arg)))
1633
1634     (if (catch 'done
1635           (while (< i (length forms--markers))
1636             (if (or (null (setq there (aref forms--markers i)))
1637                     (<= there here))
1638                 nil
1639               (if (<= (setq cnt (1- cnt)) 0)
1640                   (progn
1641                     (goto-char there)
1642                     (throw 'done t))))
1643             (setq i (1+ i))))
1644         nil
1645       (goto-char (aref forms--markers 0)))))
1646
1647 (defun forms-prev-field (arg)
1648   "Jump to ARG-th previous field."
1649   (interactive "p")
1650
1651   (let ((i (length forms--markers))
1652         (here (point))
1653         there
1654         (cnt 0))
1655
1656     (if (zerop arg)
1657         (setq cnt 1)
1658       (setq cnt (+ cnt arg)))
1659
1660     (if (catch 'done
1661           (while (> i 0)
1662             (setq i ( 1- i))
1663             (if (or (null (setq there (aref forms--markers i)))
1664                     (>= there here))
1665                 nil
1666               (if (<= (setq cnt (1- cnt)) 0)
1667                   (progn
1668                     (goto-char there)
1669                     (throw 'done t))))))
1670         nil
1671       (goto-char (aref forms--markers (1- (length forms--markers)))))))
1672 ;;;
1673 ;;; Special service
1674 ;;;
1675 (defun forms-enumerate (the-fields)
1676   "Take a quoted list of symbols, and set their values to sequential numbers.
1677 The first symbol gets number 1, the second 2 and so on.
1678 It returns the higest number.
1679
1680 Usage: (setq forms-number-of-fields
1681              (forms-enumerate
1682               '(field1 field2 field2 ...)))"
1683
1684   (let ((the-index 0))
1685     (while the-fields
1686       (setq the-index (1+ the-index))
1687       (let ((el (car-safe the-fields)))
1688         (setq the-fields (cdr-safe the-fields))
1689         (set el the-index)))
1690     the-index))
1691 \f
1692 ;;; Debugging
1693
1694 (defvar forms--debug nil
1695   "*Enables forms-mode debugging if not nil.")
1696
1697 (defun forms--debug (&rest args)
1698   "Internal debugging routine."
1699   (if forms--debug
1700       (let ((ret nil))
1701         (while args
1702           (let ((el (car-safe args)))
1703             (setq args (cdr-safe args))
1704             (if (stringp el)
1705                 (setq ret (concat ret el))
1706               (setq ret (concat ret (prin1-to-string el) " = "))
1707               (if (boundp el)
1708                   (let ((vel (eval el)))
1709                     (setq ret (concat ret (prin1-to-string vel) "\n")))
1710                 (setq ret (concat ret "<unbound>" "\n")))
1711               (if (fboundp el)
1712                   (setq ret (concat ret (prin1-to-string (symbol-function el))
1713                                     "\n"))))))
1714         (save-excursion
1715           (set-buffer (get-buffer-create "*forms-mode debug*"))
1716           (if (zerop (buffer-size))
1717               (emacs-lisp-mode))
1718           (goto-char (point-max))
1719           (insert ret)))))
1720
1721 ;;; forms.el ends here.