lisp/forms.el

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