-;;; forms.el -- Forms Mode - A GNU Emacs Major Mode
-;;; SCCS Status : @(#)@ forms 1.2.7
-;;; Author : Johan Vromans
-;;; Created On : 1989
-;;; Last Modified By: Johan Vromans
-;;; Last Modified On: Mon Jul 1 14:13:20 1991
-;;; Update Count : 15
-;;; Status : OK
-
-;;; This file is part of GNU Emacs.
-;;; GNU Emacs is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY. No author or distributor
-;;; accepts responsibility to anyone for the consequences of using it
-;;; or for whether it serves any particular purpose or works at all,
-;;; unless he says so in writing. Refer to the GNU Emacs General Public
-;;; License for full details.
-
-;;; Everyone is granted permission to copy, modify and redistribute
-;;; GNU Emacs, but only under the conditions described in the
-;;; GNU Emacs General Public License. A copy of this license is
-;;; supposed to have been given to you along with GNU Emacs so you
-;;; can know your rights and responsibilities.
-;;; If you don't have this copy, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-;;;
+;;; forms.el --- Forms mode: edit a file as a form to fill in
-;;; HISTORY
-;;; 1-Jul-1991 Johan Vromans
-;;; Normalized error messages.
-;;; 30-Jun-1991 Johan Vromans
-;;; Add support for forms-modified-record-filter.
-;;; Allow the filter functions to be the name of a function.
-;;; Fix: parse--format used forms--dynamic-text destructively.
-;;; Internally optimized the forms-format-list.
-;;; Added support for debugging.
-;;; Stripped duplicate documentation.
-;;;
-;;; 29-Jun-1991 Johan Vromans
-;;; Add support for functions and lisp symbols in forms-format-list.
-;;; Add function forms-enumerate.
+;; Copyright (C) 1991, 1994, 1995 Free Software Foundation, Inc.
+
+;; Author: Johan Vromans <jvromans@squirrel.nl>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
-(provide 'forms-mode)
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
;;; Visit a file using a form.
;;;
;;; === Naming conventions
;;;
-;;; The names of all variables and functions start with 'form-'.
-;;; Names which start with 'form--' are intended for internal use, and
+;;; The names of all variables and functions start with 'forms-'.
+;;; Names which start with 'forms--' are intended for internal use, and
;;; should *NOT* be used from the outside.
;;;
;;; All variables are buffer-local, to enable multiple forms visits
;;; simultaneously.
-;;; Variable 'forms--mode-setup' is local to *ALL* buffers, for it
+;;; Variable `forms--mode-setup' is local to *ALL* buffers, for it
;;; controls if forms-mode has been enabled in a buffer.
;;;
;;; === How it works ===
;;;
;;; Forms mode means visiting a data file which is supposed to consist
-;;; of records each containing a number of fields. The records are
+;;; of records each containing a number of fields. The records are
;;; separated by a newline, the fields are separated by a user-defined
-;;; field separater (default: TAB).
-;;; When shown, a record is transferred to an emacs buffer and
-;;; presented using a user-defined form. One record is shown at a
+;;; field separator (default: TAB).
+;;; When shown, a record is transferred to an Emacs buffer and
+;;; presented using a user-defined form. One record is shown at a
;;; time.
;;;
-;;; Forms mode is a composite mode. It involves two files, and two
+;;; Forms mode is a composite mode. It involves two files, and two
;;; buffers.
;;; The first file, called the control file, defines the name of the
-;;; data file and the forms format. This file buffer will be used to
+;;; data file and the forms format. This file buffer will be used to
;;; present the forms.
-;;; The second file holds the actual data. The buffer of this file
+;;; The second file holds the actual data. The buffer of this file
;;; will be buried, for it is never accessed directly.
;;;
-;;; Forms mode is invoked using "forms-find-file control-file".
-;;; Alternativily forms-find-file-other-window can be used.
+;;; Forms mode is invoked using M-x forms-find-file control-file .
+;;; Alternatively `forms-find-file-other-window' can be used.
;;;
;;; You may also visit the control file, and switch to forms mode by hand
;;; with M-x forms-mode .
;;;
-;;; Automatic mode switching is supported, so you may use "find-file"
-;;; if you specify "-*- forms -*-" in the first line of the control file.
+;;; Automatic mode switching is supported if you specify
+;;; "-*- forms -*-" in the first line of the control file.
;;;
-;;; The control file is visited, evaluated using
-;;; eval-current-buffer, and should set at least the following
-;;; variables:
+;;; The control file is visited, evaluated using `eval-current-buffer',
+;;; and should set at least the following variables:
;;;
-;;; forms-file [string] the name of the data file.
+;;; forms-file [string]
+;;; The name of the data file.
;;;
-;;; forms-number-of-fields [integer]
+;;; forms-number-of-fields [integer]
;;; The number of fields in each record.
;;;
-;;; forms-format-list [list] formatting instructions.
-;;;
-;;; The forms-format-list should be a list, each element containing
-;;;
-;;; - a string, e.g. "hello" (which is inserted \"as is\"),
+;;; forms-format-list [list]
+;;; Formatting instructions.
;;;
-;;; - an integer, denoting a field number. The contents of the field
-;;; are inserted at this point.
-;;; The first field has number one.
+;;; `forms-format-list' should be a list, each element containing
;;;
-;;; - a function call, e.g. (insert "text"). This function call is
-;;; dynamically evaluated and should return a string. It should *NOT*
-;;; have side-effects on the forms being constructed.
-;;; The current fields are available to the function in the variable
-;;; forms-fields, they should *NOT* be modified.
-;;;
-;;; - a lisp symbol, that must evaluate to one of the above.
+;;; - a string, e.g. "hello". The string is inserted in the forms
+;;; "as is".
+;;;
+;;; - an integer, denoting a field number.
+;;; The contents of this field are inserted at this point.
+;;; Fields are numbered starting with number one.
+;;;
+;;; - a function call, e.g. (insert "text").
+;;; This function call is dynamically evaluated and should return a
+;;; string. It should *NOT* have side-effects on the forms being
+;;; constructed. The current fields are available to the function
+;;; in the variable `forms-fields', they should *NOT* be modified.
+;;;
+;;; - a lisp symbol, that must evaluate to one of the above.
;;;
;;; Optional variables which may be set in the control file:
;;;
;;; forms-field-sep [string, default TAB]
;;; The field separator used to separate the
-;;; fields in the data file. It may be a string.
+;;; fields in the data file. It may be a string.
;;;
;;; forms-read-only [bool, default nil]
-;;; 't' means that the data file is visited read-only.
+;;; Non-nil means that the data file is visited
+;;; read-only (view mode) as opposed to edit mode.
;;; If no write access to the data file is
-;;; possible, read-only mode is enforced.
+;;; possible, view mode is enforced.
+;;;
+;;; forms-check-number-of-fields [bool, default t]
+;;; If non-nil, a warning will be issued whenever
+;;; a record is found that does not have the number
+;;; of fields specified by `forms-number-of-fields'.
;;;
;;; forms-multi-line [string, default "^K"]
;;; If non-null the records of the data file may
-;;; contain fields which span multiple lines in
+;;; contain fields that can span multiple lines in
;;; the form.
-;;; This variable denoted the separator character
-;;; to be used for this purpose. Upon display, all
-;;; occurrencies of this character are translated
-;;; to newlines. Upon storage they are translated
-;;; back to the separator.
+;;; This variable denotes the separator character
+;;; to be used for this purpose. Upon display, all
+;;; occurrences of this character are translated
+;;; to newlines. Upon storage they are translated
+;;; back to the separator character.
+;;;
+;;; forms-forms-scroll [bool, default nil]
+;;; Non-nil means: rebind locally the commands that
+;;; perform `scroll-up' or `scroll-down' to use
+;;; `forms-next-field' resp. `forms-prev-field'.
;;;
-;;; forms-forms-scroll [bool, default t]
-;;; If non-nil: redefine scroll-up/down to perform
-;;; forms-next/prev-field if in forms mode.
+;;; forms-forms-jump [bool, default nil]
+;;; Non-nil means: rebind locally the commands that
+;;; perform `beginning-of-buffer' or `end-of-buffer'
+;;; to perform `forms-first-field' resp. `forms-last-field'.
;;;
-;;; forms-forms-jump [bool, default t]
-;;; If non-nil: redefine beginning/end-of-buffer
-;;; to performs forms-first/last-field if in
-;;; forms mode.
+;;; forms-read-file-filter [symbol, default nil]
+;;; If not nil: this should be the name of a
+;;; function that is called after the forms data file
+;;; has been read. It can be used to transform
+;;; the contents of the file into a format more suitable
+;;; for forms-mode processing.
;;;
-;;; forms-new-record-filter [symbol, no default]
-;;; If defined: this should be the name of a
+;;; forms-write-file-filter [symbol, default nil]
+;;; If not nil: this should be the name of a
+;;; function that is called before the forms data file
+;;; is written (saved) to disk. It can be used to undo
+;;; the effects of `forms-read-file-filter', if any.
+;;;
+;;; forms-new-record-filter [symbol, default nil]
+;;; If not nil: this should be the name of a
;;; function that is called when a new
-;;; record is created. It can be used to fill in
+;;; record is created. It can be used to fill in
;;; the new record with default fields, for example.
-;;; Instead of the name of the function, it may
-;;; be the function itself.
;;;
-;;; forms-modified-record-filter [symbol, no default]
-;;; If defined: this should be the name of a
+;;; forms-modified-record-filter [symbol, default nil]
+;;; If not nil: this should be the name of a
;;; function that is called when a record has
-;;; been modified. It is called after the fields
-;;; are parsed. It can be used to register
+;;; been modified. It is called after the fields
+;;; are parsed. It can be used to register
;;; modification dates, for example.
-;;; Instead of the name of the function, it may
-;;; be the function itself.
+;;;
+;;; forms-use-text-properties [bool, see text for default]
+;;; This variable controls if forms mode should use
+;;; text properties to protect the form text from being
+;;; modified (using text-property `read-only').
+;;; Also, the read-write fields are shown using a
+;;; distinct face, if possible.
+;;; As of emacs 19.29, the `intangible' text property
+;;; is used to prevent moving into read-only fields.
+;;; This variable defaults to t if running Emacs 19
+;;; with text properties.
+;;; The default face to show read-write fields is
+;;; copied from face `region'.
+;;;
+;;; forms-ro-face [symbol, default 'default]
+;;; This is the face that is used to show
+;;; read-only text on the screen.If used, this
+;;; variable should be set to a symbol that is a
+;;; valid face.
+;;; E.g.
+;;; (make-face 'my-face)
+;;; (setq forms-ro-face 'my-face)
+;;;
+;;; forms-rw-face [symbol, default 'region]
+;;; This is the face that is used to show
+;;; read-write text on the screen.
;;;
;;; After evaluating the control file, its buffer is cleared and used
;;; for further processing.
-;;; The data file (as designated by "forms-file") is visited in a buffer
-;;; (forms--file-buffer) which will not normally be shown.
+;;; The data file (as designated by `forms-file') is visited in a buffer
+;;; `forms--file-buffer' which will not normally be shown.
;;; Great malfunctioning may be expected if this file/buffer is modified
-;;; outside of this package while it's being visited!
+;;; outside of this package while it is being visited!
;;;
-;;; A record from the data file is transferred from the data file,
-;;; split into fields (into forms--the-record-list), and displayed using
-;;; the specs in forms-format-list.
-;;; A format routine 'forms--format' is built upon startup to format
-;;; the records.
+;;; Normal operation is to transfer one line (record) from the data file,
+;;; split it into fields (into `forms--the-record-list'), and display it
+;;; using the specs in `forms-format-list'.
+;;; A format routine `forms--format' is built upon startup to format
+;;; the records according to `forms-format-list'.
;;;
;;; When a form is changed the record is updated as soon as this form
-;;; is left. The contents of the form are parsed using forms-format-list,
-;;; and the fields which are deduced from the form are modified. So,
-;;; fields not shown on the forms retain their origional values.
-;;; The newly formed record and replaces the contents of the
-;;; old record in forms--file-buffer.
-;;; A parse routine 'forms--parser' is built upon startup to parse
+;;; is left. The contents of the form are parsed using information
+;;; obtained from `forms-format-list', and the fields which are
+;;; deduced from the form are modified. Fields not shown on the forms
+;;; retain their original values. The newly formed record then
+;;; replaces the contents of the old record in `forms--file-buffer'.
+;;; A parse routine `forms--parser' is built upon startup to parse
;;; the records.
;;;
-;;; Two exit functions exist: forms-exit (which saves) and forms-exit-no-save
-;;; (which doesn't). However, if forms-exit-no-save is executed and the file
-;;; buffer has been modified, emacs will ask questions.
+;;; Two exit functions exist: `forms-exit' and `forms-exit-no-save'.
+;;; `forms-exit' saves the data to the file, if modified.
+;;; `forms-exit-no-save` does not. However, if `forms-exit-no-save'
+;;; is executed and the file buffer has been modified, Emacs will ask
+;;; questions anyway.
;;;
-;;; Other functions are:
+;;; Other functions provided by forms mode are:
;;;
;;; paging (forward, backward) by record
;;; jumping (first, last, random number)
;;; file (using forms-last-record) will adjust forms--total-records if
;;; needed.
;;;
-;;; Commands and keymaps:
-;;;
-;;; A local keymap 'forms-mode-map' is used in the forms buffer.
-;;; As conventional, this map can be accessed with C-c prefix.
-;;; In read-only mode, the C-c prefix must be omitted.
+;;; The forms buffer can be in on eof two modes: edit mode or view
+;;; mode. View mode is a read-only mode, you cannot modify the
+;;; contents of the buffer.
;;;
-;;; Default bindings:
-;;;
-;;; \C-c forms-mode-map
-;;; TAB forms-next-field
-;;; SPC forms-next-record
-;;; < forms-first-record
-;;; > forms-last-record
-;;; ? describe-mode
-;;; d forms-delete-record
-;;; e forms-edit-mode
-;;; i forms-insert-record
-;;; j forms-jump-record
-;;; n forms-next-record
-;;; p forms-prev-record
-;;; q forms-exit
-;;; s forms-search
-;;; v forms-view-mode
-;;; x forms-exit-no-save
-;;; DEL forms-prev-record
+;;; Edit mode commands:
+;;;
+;;; TAB forms-next-field
+;;; \C-c TAB forms-next-field
+;;; \C-c < forms-first-record
+;;; \C-c > forms-last-record
+;;; \C-c ? describe-mode
+;;; \C-c \C-k forms-delete-record
+;;; \C-c \C-q forms-toggle-read-only
+;;; \C-c \C-o forms-insert-record
+;;; \C-c \C-l forms-jump-record
+;;; \C-c \C-n forms-next-record
+;;; \C-c \C-p forms-prev-record
+;;; \C-c \C-r forms-search-backward
+;;; \C-c \C-s forms-search-forward
+;;; \C-c \C-x forms-exit
+;;;
+;;; Read-only mode commands:
+;;;
+;;; SPC forms-next-record
+;;; DEL forms-prev-record
+;;; ? describe-mode
+;;; \C-q forms-toggle-read-only
+;;; l forms-jump-record
+;;; n forms-next-record
+;;; p forms-prev-record
+;;; r forms-search-backward
+;;; s forms-search-forward
+;;; x forms-exit
+;;;
+;;; Of course, it is also possible to use the \C-c prefix to obtain the
+;;; same command keys as in edit mode.
+;;;
+;;; The following bindings are available, independent of the mode:
+;;;
+;;; [next] forms-next-record
+;;; [prior] forms-prev-record
+;;; [begin] forms-first-record
+;;; [end] forms-last-record
+;;; [S-TAB] forms-prev-field
+;;; [backtab] forms-prev-field
;;;
-;;; Standard functions scroll-up, scroll-down, beginning-of-buffer and
-;;; end-of-buffer are wrapped with re-definitions, which map them to
-;;; next/prev record and first/last record.
-;;; Buffer-local variables forms-forms-scroll and forms-forms-jump
-;;; may be used to control these redefinitions.
+;;; For convenience, TAB is always bound to `forms-next-field', so you
+;;; don't need the C-c prefix for this command.
;;;
-;;; Function save-buffer is also wrapped to perform a sensible action.
-;;; A revert-file-hook is defined to revert a forms to original.
+;;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump')
+;;; the bindings of standard functions `scroll-up', `scroll-down',
+;;; `beginning-of-buffer' and `end-of-buffer' can be locally replaced with
+;;; forms mode functions next/prev record and first/last
+;;; record.
;;;
-;;; For convenience, TAB is always bound to forms-next-field, so you
-;;; don't need the C-c prefix for this command.
-;;;\f
-;;; Global variables and constants
+;;; `local-write-file hook' is defined to save the actual data file
+;;; instead of the buffer data, `revert-file-hook' is defined to
+;;; revert a forms to original.
+\f
+;;; Code:
+
+;;; Global variables and constants:
-(defconst forms-version "1.2.7"
- "Version of forms-mode implementation")
+(provide 'forms) ;;; official
+(provide 'forms-mode) ;;; for compatibility
-(defvar forms-forms-scrolls t
- "If non-null: redefine scroll-up/down to be used with forms-mode.")
+(defconst forms-version (substring "$Revision: 2.23 $" 11 -2)
+ "The version number of forms-mode (as string). The complete RCS id is:
-(defvar forms-forms-jumps t
- "If non-null: redefine beginning/end-of-buffer to be used with forms-mode.")
+ $Id: forms.el,v 2.23 1995/11/16 20:04:57 jvromans Exp kwzh $")
(defvar forms-mode-hooks nil
- "Hook functions to be run upon entering forms mode.")
-;;;\f
-;;; Mandatory variables - must be set by evaluating the control file
+ "Hook functions to be run upon entering Forms mode.")
+\f
+;;; Mandatory variables - must be set by evaluating the control file.
(defvar forms-file nil
"Name of the file holding the data.")
(defvar forms-number-of-fields nil
"Number of fields per record.")
+\f
+;;; Optional variables with default values.
-;;;\f
-;;; Optional variables with default values
+(defvar forms-check-number-of-fields t
+ "*If non-nil, warn about records with wrong number of fields.")
(defvar forms-field-sep "\t"
- "Field separator character (default TAB)")
+ "Field separator character (default TAB).")
(defvar forms-read-only nil
- "Read-only mode (defaults to the write access on the data file).")
+ "Non-nil means: visit the file in view (read-only) mode.
+\(Defaults to the write access on the data file).")
(defvar forms-multi-line "\C-k"
- "Character to separate multi-line fields (default ^K)")
+ "If not nil: use this character to separate multi-line fields (default C-k).")
+
+(defvar forms-forms-scroll nil
+ "*Non-nil means replace scroll-up/down commands in Forms mode.
+The replacement commands performs forms-next/prev-record.")
+
+(defvar forms-forms-jump nil
+ "*Non-nil means redefine beginning/end-of-buffer in Forms mode.
+The replacement commands performs forms-first/last-record.")
-(defvar forms-forms-scroll t
- "Redefine scroll-up/down to perform forms-next/prev-record when in
- forms mode.")
+(defvar forms-read-file-filter nil
+ "The name of a function that is called after reading the data file.
+This can be used to change the contents of the file to something more
+suitable for forms processing.")
-(defvar forms-forms-jump t
- "Redefine beginning/end-of-buffer to perform forms-first/last-record
- when in forms mode.")
+(defvar forms-write-file-filter nil
+ "The name of a function that is called before writing the data file.
+This can be used to undo the effects of form-read-file-hook.")
-;;;\f
+(defvar forms-new-record-filter nil
+ "The name of a function that is called when a new record is created.")
+
+(defvar forms-modified-record-filter nil
+ "The name of a function that is called when a record has been modified.")
+
+(defvar forms-fields nil
+ "List with fields of the current forms. First field has number 1.
+This variable is for use by the filter routines only.
+The contents may NOT be modified.")
+
+(defvar forms-use-text-properties (fboundp 'set-text-properties)
+ "*Non-nil means: use emacs-19 text properties.
+Defaults to t if this emacs is capable of handling text properties.")
+
+(defvar forms-ro-face 'default
+ "The face (a symbol) that is used to display read-only text on the screen.")
+
+(defvar forms-rw-face 'region
+ "The face (a symbol) that is used to display read-write text on the screen.")
+\f
;;; Internal variables.
(defvar forms--file-buffer nil
(defvar forms--current-record 0
"Number of the record currently on the screen.")
-(defvar forms-mode-map nil ; yes - this one is global
+(defvar forms-mode-map nil
"Keymap for form buffer.")
+(defvar forms-mode-ro-map nil
+ "Keymap for form buffer in view mode.")
+(defvar forms-mode-edit-map nil
+ "Keymap for form buffer in edit mode.")
(defvar forms--markers nil
"Field markers in the screen.")
-(defvar forms--number-of-markers 0
- "Number of fields on screen.")
+(defvar forms--dyntexts nil
+ "Dynamic texts (resulting from function calls) on the screen.")
(defvar forms--the-record-list nil
"List of strings of the current record, as parsed from the file.")
(defvar forms--search-regexp nil
- "Last regexp used by forms-search.")
+ "Last regexp used by forms-search functions.")
(defvar forms--format nil
"Formatting routine.")
"Forms parser routine.")
(defvar forms--mode-setup nil
- "Internal - keeps track of forms-mode being set-up.")
+ "To keep track of forms-mode being set-up.")
(make-variable-buffer-local 'forms--mode-setup)
-(defvar forms--new-record-filter nil
- "Internal - set if a new record filter has been defined.")
-
-(defvar forms--modified-record-filter nil
- "Internal - set if a modified record filter has been defined.")
-
(defvar forms--dynamic-text nil
- "Internal - holds dynamic text to insert between fields.")
+ "Array that holds dynamic texts to insert between fields.")
-(defvar forms-fields nil
- "List with fields of the current forms. First field has number 1.")
+(defvar forms--elements nil
+ "Array with the order in which the fields are displayed.")
-;;;\f
-;;; forms-mode
-;;;
-;;; This is not a simple major mode, as usual. Therefore, forms-mode
-;;; takes an optional argument 'primary' which is used for the initial
-;;; set-up. Normal use would leave 'primary' to nil.
-;;;
-;;; A global buffer-local variable 'forms--mode-setup' has the same effect
-;;; but makes it possible to auto-invoke forms-mode using find-file.
-;;;
-;;; Note: although it seems logical to have (make-local-variable) executed
-;;; where the variable is first needed, I deliberately placed all calls
-;;; in the forms-mode function.
-
+(defvar forms--ro-face nil
+ "Face used to represent read-only data on the screen.")
+
+(defvar forms--rw-face nil
+ "Face used to represent read-write data on the screen.")
+\f
+;;;###autoload
(defun forms-mode (&optional primary)
"Major mode to visit files in a field-structured manner using a form.
- Commands (prefix with C-c if not in read-only mode):
- \\{forms-mode-map}"
+Commands: Equivalent keys in read-only mode:
+ TAB forms-next-field TAB
+ \\C-c TAB forms-next-field
+ \\C-c < forms-first-record <
+ \\C-c > forms-last-record >
+ \\C-c ? describe-mode ?
+ \\C-c \\C-k forms-delete-record
+ \\C-c \\C-q forms-toggle-read-only q
+ \\C-c \\C-o forms-insert-record
+ \\C-c \\C-l forms-jump-record l
+ \\C-c \\C-n forms-next-record n
+ \\C-c \\C-p forms-prev-record p
+ \\C-c \\C-r forms-search-reverse r
+ \\C-c \\C-s forms-search-forward s
+ \\C-c \\C-x forms-exit x
+"
+ (interactive)
- (interactive) ; no - 'primary' is not prefix arg
+ ;; This is not a simple major mode, as usual. Therefore, forms-mode
+ ;; takes an optional argument `primary' which is used for the
+ ;; initial set-up. Normal use would leave `primary' to nil.
+ ;; A global buffer-local variable `forms--mode-setup' has the same
+ ;; effect but makes it possible to auto-invoke forms-mode using
+ ;; `find-file'.
+ ;; Note: although it seems logical to have `make-local-variable'
+ ;; executed where the variable is first needed, I have deliberately
+ ;; placed all calls in this function.
;; Primary set-up: evaluate buffer and check if the mandatory
;; variables have been set.
(if (or primary (not forms--mode-setup))
(progn
+ ;;(message "forms: setting up...")
(kill-all-local-variables)
- ;; make mandatory variables
+ ;; Make mandatory variables.
(make-local-variable 'forms-file)
(make-local-variable 'forms-number-of-fields)
(make-local-variable 'forms-format-list)
- ;; make optional variables
+ ;; Make optional variables.
(make-local-variable 'forms-field-sep)
(make-local-variable 'forms-read-only)
(make-local-variable 'forms-multi-line)
(make-local-variable 'forms-forms-scroll)
(make-local-variable 'forms-forms-jump)
- (fmakunbound 'forms-new-record-filter)
+ (make-local-variable 'forms-use-text-properties)
+
+ ;; Filter functions.
+ (make-local-variable 'forms-read-file-filter)
+ (make-local-variable 'forms-write-file-filter)
+ (make-local-variable 'forms-new-record-filter)
+ (make-local-variable 'forms-modified-record-filter)
+
+ ;; Make sure no filters exist.
+ (setq forms-read-file-filter nil)
+ (setq forms-write-file-filter nil)
+ (setq forms-new-record-filter nil)
+ (setq forms-modified-record-filter nil)
+
+ ;; If running Emacs 19 under X, setup faces to show read-only and
+ ;; read-write fields.
+ (if (fboundp 'make-face)
+ (progn
+ (make-local-variable 'forms-ro-face)
+ (make-local-variable 'forms-rw-face)))
;; eval the buffer, should set variables
- (eval-current-buffer)
-
- ;; check if the mandatory variables make sense.
+ ;;(message "forms: processing control file...")
+ ;; If enable-local-eval is not set to t the user is asked first.
+ (if (or (eq enable-local-eval t)
+ (yes-or-no-p
+ (concat "Evaluate lisp code in buffer "
+ (buffer-name) " to display forms ")))
+ (eval-current-buffer)
+ (error "`enable-local-eval' inhibits buffer evaluation"))
+
+ ;; Check if the mandatory variables make sense.
(or forms-file
- (error "'forms-file' has not been set"))
- (or forms-number-of-fields
- (error "'forms-number-of-fields' has not been set"))
- (or (> forms-number-of-fields 0)
- (error "'forms-number-of-fields' must be > 0")
- (or (stringp forms-field-sep))
- (error "'forms-field-sep' is not a string"))
+ (error (concat "Forms control file error: "
+ "'forms-file' has not been set")))
+
+ ;; Check forms-field-sep first, since it can be needed to
+ ;; construct a default format list.
+ (or (stringp forms-field-sep)
+ (error (concat "Forms control file error: "
+ "'forms-field-sep' is not a string")))
+
+ (if forms-number-of-fields
+ (or (and (numberp forms-number-of-fields)
+ (> forms-number-of-fields 0))
+ (error (concat "Forms control file error: "
+ "'forms-number-of-fields' must be a number > 0")))
+ (or (null forms-format-list)
+ (error (concat "Forms control file error: "
+ "'forms-number-of-fields' has not been set"))))
+
+ (or forms-format-list
+ (forms--intuit-from-file))
+
(if forms-multi-line
(if (and (stringp forms-multi-line)
(eq (length forms-multi-line) 1))
(if (string= forms-multi-line forms-field-sep)
- (error "'forms-multi-line' is equal to 'forms-field-sep'"))
- (error "'forms-multi-line' must be nil or a one-character string")))
+ (error (concat "Forms control file error: "
+ "'forms-multi-line' is equal to 'forms-field-sep'")))
+ (error (concat "Forms control file error: "
+ "'forms-multi-line' must be nil or a one-character string"))))
+ (or (fboundp 'set-text-properties)
+ (setq forms-use-text-properties nil))
- ;; validate and process forms-format-list
- (make-local-variable 'forms--number-of-markers)
- (make-local-variable 'forms--markers)
+ ;; Validate and process forms-format-list.
+ ;;(message "forms: pre-processing format list...")
(forms--process-format-list)
- ;; build the formatter and parser
+ ;; Build the formatter and parser.
+ ;;(message "forms: building formatter...")
(make-local-variable 'forms--format)
+ (make-local-variable 'forms--markers)
+ (make-local-variable 'forms--dyntexts)
+ (make-local-variable 'forms--elements)
+ ;;(message "forms: building parser...")
(forms--make-format)
(make-local-variable 'forms--parser)
(forms--make-parser)
+ ;;(message "forms: building parser... done.")
- ;; check if record filters are defined
- (make-local-variable 'forms--new-record-filter)
- (setq forms--new-record-filter
- (cond
- ((fboundp 'forms-new-record-filter)
- (symbol-function 'forms-new-record-filter))
- ((and (boundp 'forms-new-record-filter)
- (fboundp forms-new-record-filter))
- forms-new-record-filter)))
- (fmakunbound 'forms-new-record-filter)
- (make-local-variable 'forms--modified-record-filter)
- (setq forms--modified-record-filter
- (cond
- ((fboundp 'forms-modified-record-filter)
- (symbol-function 'forms-modified-record-filter))
- ((and (boundp 'forms-modified-record-filter)
- (fboundp forms-modified-record-filter))
- forms-modified-record-filter)))
- (fmakunbound 'forms-modified-record-filter)
-
- ;; dynamic text support
- (make-local-variable 'forms--dynamic-text)
+ ;; Check if record filters are defined.
+ (if (and forms-new-record-filter
+ (not (fboundp forms-new-record-filter)))
+ (error (concat "Forms control file error: "
+ "'forms-new-record-filter' is not a function")))
+
+ (if (and forms-modified-record-filter
+ (not (fboundp forms-modified-record-filter)))
+ (error (concat "Forms control file error: "
+ "'forms-modified-record-filter' is not a function")))
+
+ ;; The filters acces the contents of the forms using `forms-fields'.
(make-local-variable 'forms-fields)
- ;; prepare this buffer for further processing
+ ;; Dynamic text support.
+ (make-local-variable 'forms--dynamic-text)
+
+ ;; Prevent accidental overwrite of the control file and autosave.
+ (set-visited-file-name nil)
+
+ ;; Prepare this buffer for further processing.
(setq buffer-read-only nil)
+ (erase-buffer)
- ;; prevent accidental overwrite of the control file and autosave
- (setq buffer-file-name nil)
- (auto-save-mode nil)
+ ;;(message "forms: setting up... done.")
+ ))
+
+ ;; initialization done
+ (setq forms--mode-setup t)
- ;; and clean it
- (erase-buffer)))
+ ;; Copy desired faces to the actual variables used by the forms formatter.
+ (if (fboundp 'make-face)
+ (progn
+ (make-local-variable 'forms--ro-face)
+ (make-local-variable 'forms--rw-face)
+ (if forms-read-only
+ (progn
+ (setq forms--ro-face forms-ro-face)
+ (setq forms--rw-face forms-ro-face))
+ (setq forms--ro-face forms-ro-face)
+ (setq forms--rw-face forms-rw-face))))
- ;; make local variables
+ ;; Make more local variables.
(make-local-variable 'forms--file-buffer)
(make-local-variable 'forms--total-records)
(make-local-variable 'forms--current-record)
(make-local-variable 'forms--the-record-list)
- (make-local-variable 'forms--search-rexexp)
+ (make-local-variable 'forms--search-regexp)
- ;; A bug in the current Emacs release prevents a keymap
- ;; which is buffer-local from being used by 'describe-mode'.
- ;; Hence we'll leave it global.
- ;;(make-local-variable 'forms-mode-map)
+ ; The keymaps are global, so multiple forms mode buffers can share them.
+ ;(make-local-variable 'forms-mode-map)
+ ;(make-local-variable 'forms-mode-ro-map)
+ ;(make-local-variable 'forms-mode-edit-map)
(if forms-mode-map ; already defined
nil
- (setq forms-mode-map (make-keymap))
- (forms--mode-commands forms-mode-map)
- (forms--change-commands))
+ ;;(message "forms: building keymap...")
+ (forms--mode-commands)
+ ;;(message "forms: building keymap... done.")
+ )
+
+ ;; set the major mode indicator
+ (setq major-mode 'forms-mode)
+ (setq mode-name "Forms")
;; find the data file
(setq forms--file-buffer (find-file-noselect forms-file))
+ ;; Pre-transform.
+ (let ((read-file-filter forms-read-file-filter)
+ (write-file-filter forms-write-file-filter))
+ (if read-file-filter
+ (save-excursion
+ (set-buffer forms--file-buffer)
+ (let ((inhibit-read-only t)
+ (file-modified (buffer-modified-p)))
+ (run-hooks 'read-file-filter)
+ (if (not file-modified) (set-buffer-modified-p nil)))
+ (if write-file-filter
+ (progn
+ (make-variable-buffer-local 'local-write-file-hooks)
+ (setq local-write-file-hooks (list write-file-filter)))))
+ (if write-file-filter
+ (save-excursion
+ (set-buffer forms--file-buffer)
+ (make-variable-buffer-local 'local-write-file-hooks)
+ (setq local-write-file-hooks (list write-file-filter))))))
+
;; count the number of records, and set see if it may be modified
(let (ro)
(setq forms--total-records
(save-excursion
- (set-buffer forms--file-buffer)
- (bury-buffer (current-buffer))
- (setq ro buffer-read-only)
- (count-lines (point-min) (point-max))))
+ (prog1
+ (progn
+ ;;(message "forms: counting records...")
+ (set-buffer forms--file-buffer)
+ (bury-buffer (current-buffer))
+ (setq ro buffer-read-only)
+ (count-lines (point-min) (point-max)))
+ ;;(message "forms: counting records... done.")
+ )))
(if ro
(setq forms-read-only t)))
- ;; set the major mode indicator
- (setq major-mode 'forms-mode)
- (setq mode-name "Forms")
- (make-local-variable 'minor-mode-alist) ; needed?
- (forms--set-minor-mode)
+ ;;(message "forms: proceeding setup...")
+
+ ;; Since we aren't really implementing a minor mode, we hack the modeline
+ ;; directly to get the text " View " into forms-read-only form buffers. For
+ ;; that reason, this variable must be buffer only.
+ (make-local-variable 'minor-mode-alist)
+ (setq minor-mode-alist (list (list 'forms-read-only " View")))
+
+ ;;(message "forms: proceeding setup (keymaps)...")
(forms--set-keymaps)
+ ;;(message "forms: proceeding setup (commands)...")
+ (forms--change-commands)
+ ;;(message "forms: proceeding setup (buffer)...")
(set-buffer-modified-p nil)
- ;; We have our own revert function - use it
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'forms-revert-buffer)
-
- ;; setup the first (or current) record to show
- (if (< forms--current-record 1)
- (setq forms--current-record 1))
- (forms-jump-record forms--current-record)
+ (if (= forms--total-records 0)
+ ;;(message "forms: proceeding setup (new file)...")
+ (progn
+ (insert
+ "GNU Emacs Forms Mode version " forms-version "\n\n"
+ (if (file-exists-p forms-file)
+ (concat "No records available in file \"" forms-file "\".\n\n")
+ (format "Creating new file \"%s\"\nwith %d field%s per record.\n\n"
+ forms-file forms-number-of-fields
+ (if (= 1 forms-number-of-fields) "" "s")))
+ "Use " (substitute-command-keys "\\[forms-insert-record]")
+ " to create new records.\n")
+ (setq forms--current-record 1)
+ (setq buffer-read-only t)
+ (set-buffer-modified-p nil))
+
+ ;; setup the first (or current) record to show
+ (if (< forms--current-record 1)
+ (setq forms--current-record 1))
+ (forms-jump-record forms--current-record)
+ )
;; user customising
+ ;;(message "forms: proceeding setup (user hooks)...")
(run-hooks 'forms-mode-hooks)
+ ;;(message "forms: setting up... done.")
;; be helpful
(forms--help)
-
- ;; initialization done
- (setq forms--mode-setup t))
-
-;;;\f
-;;; forms-process-format-list
-;;;
-;;; Validates forms-format-list.
-;;;
-;;; Sets forms--number-of-markers and forms--markers.
-
+)
+\f
(defun forms--process-format-list ()
- "Validate forms-format-list and set some global variables."
-
- (forms--debug "forms-forms-list before 1st pass:\n"
- 'forms-format-list)
-
- ;; it must be non-nil
+ ;; Validate `forms-format-list' and set some global variables.
+ ;; Symbols in the list are evaluated, and consecutive strings are
+ ;; concatenated.
+ ;; Array `forms--elements' is constructed that contains the order
+ ;; of the fields on the display. This array is used by
+ ;; `forms--parser-using-text-properties' to extract the fields data
+ ;; from the form on the screen.
+ ;; Upon completion, `forms-format-list' is guaranteed correct, so
+ ;; `forms--make-format' and `forms--make-parser' do not need to perform
+ ;; any checks.
+
+ ;; Verify that `forms-format-list' is not nil.
(or forms-format-list
- (error "'forms-format-list' has not been set"))
- ;; it must be a list ...
+ (error (concat "Forms control file error: "
+ "'forms-format-list' has not been set")))
+ ;; It must be a list.
(or (listp forms-format-list)
- (error "'forms-format-list' is not a list"))
+ (error (concat "Forms control file error: "
+ "'forms-format-list' is not a list")))
- (setq forms--number-of-markers 0)
+ ;; Assume every field is painted once.
+ ;; `forms--elements' will grow if needed.
+ (setq forms--elements (make-vector forms-number-of-fields nil))
(let ((the-list forms-format-list) ; the list of format elements
(this-item 0) ; element in list
+ (prev-item nil)
(field-num 0)) ; highest field number
(setq forms-format-list nil) ; gonna rebuild
(let ((el (car-safe the-list))
(rem (cdr-safe the-list)))
- ;; if it is a symbol, eval it first
+ ;; If it is a symbol, eval it first.
(if (and (symbolp el)
(boundp el))
(setq el (eval el)))
(cond
- ;; try string ...
- ((stringp el)) ; string is OK
-
- ;; try numeric ...
+ ;; Try string ...
+ ((stringp el)
+ (if (stringp prev-item) ; try to concatenate strings
+ (setq prev-item (concat prev-item el))
+ (if prev-item
+ (setq forms-format-list
+ (append forms-format-list (list prev-item) nil)))
+ (setq prev-item el)))
+
+ ;; Try numeric ...
((numberp el)
+ ;; Validate range.
(if (or (<= el 0)
(> el forms-number-of-fields))
- (error
- "Forms error: field number %d out of range 1..%d"
- el forms-number-of-fields))
-
- (setq forms--number-of-markers (1+ forms--number-of-markers))
- (if (> el field-num)
- (setq field-num el)))
-
- ;; try function
+ (error (concat "Forms format error: "
+ "field number %d out of range 1..%d")
+ el forms-number-of-fields))
+
+ ;; Store forms order.
+ (if (> field-num (length forms--elements))
+ (setq forms--elements (vconcat forms--elements (1- el)))
+ (aset forms--elements field-num (1- el)))
+ (setq field-num (1+ field-num))
+
+ (if prev-item
+ (setq forms-format-list
+ (append forms-format-list (list prev-item) nil)))
+ (setq prev-item el))
+
+ ;; Try function ...
((listp el)
+
+ ;; Validate.
(or (fboundp (car-safe el))
- (error
- "Forms error: not a function: %s"
- (prin1-to-string (car-safe el)))))
+ (error (concat "Forms format error: "
+ "not a function "
+ (prin1-to-string (car-safe el)))))
+
+ ;; Shift.
+ (if prev-item
+ (setq forms-format-list
+ (append forms-format-list (list prev-item) nil)))
+ (setq prev-item el))
;; else
(t
- (error "Invalid element in 'forms-format-list': %s"
- (prin1-to-string el))))
+ (error (concat "Forms format error: "
+ "invalid element "
+ (prin1-to-string el)))))
- ;; advance to next element of the list
- (setq the-list rem)
- (setq forms-format-list
- (append forms-format-list (list el) nil)))))
+ ;; Advance to next element of the list.
+ (setq the-list rem)))
- (forms--debug "forms-forms-list after 1st pass:\n"
- 'forms-format-list)
-
- ;; concat adjacent strings
- (setq forms-format-list (forms--concat-adjacent forms-format-list))
-
- (forms--debug "forms-forms-list after 2nd pass:\n"
- 'forms-format-list
- 'forms--number-of-markers)
+ ;; Append last item.
+ (if prev-item
+ (progn
+ (setq forms-format-list
+ (append forms-format-list (list prev-item) nil))
+ ;; Append a newline if the last item is a field.
+ ;; This prevents parsing problems.
+ ;; Also it makes it possible to insert an empty last field.
+ (if (numberp prev-item)
+ (setq forms-format-list
+ (append forms-format-list (list "\n") nil))))))
+
+ (forms--debug 'forms-format-list
+ 'forms--elements))
+\f
+;; Special treatment for read-only segments.
+;;
+;; If text is inserted between two read-only segments, it inherits the
+;; read-only properties. This is not what we want.
+;; To solve this, read-only segments get the `insert-in-front-hooks'
+;; property set with a function that temporarily switches the properties
+;; of the first character of the segment to read-write, so the new
+;; text gets the right properties.
+;; The `post-command-hook' is used to restore the original properties.
+
+(defvar forms--iif-start nil
+ "Record start of modification command.")
+(defvar forms--iif-properties nil
+ "Original properties of the character being overridden.")
+
+(defun forms--iif-hook (begin end)
+ "`insert-in-front-hooks' function for read-only segments."
+
+ ;; Note start location. By making it a marker that points one
+ ;; character beyond the actual location, it is guaranteed to move
+ ;; correctly if text is inserted.
+ (or forms--iif-start
+ (setq forms--iif-start (copy-marker (1+ (point)))))
+
+ ;; Check if there is special treatment required.
+ (if (or (<= forms--iif-start 2)
+ (get-text-property (- forms--iif-start 2)
+ 'read-only))
+ (progn
+ ;; Fetch current properties.
+ (setq forms--iif-properties
+ (text-properties-at (1- forms--iif-start)))
+
+ ;; Replace them.
+ (let ((inhibit-read-only t))
+ (set-text-properties
+ (1- forms--iif-start) forms--iif-start
+ (list 'face forms--rw-face 'front-sticky '(face))))
+
+ ;; Enable `post-command-hook' to restore the properties.
+ (setq post-command-hook
+ (append (list 'forms--iif-post-command-hook) post-command-hook)))
+
+ ;; No action needed. Clear marker.
+ (setq forms--iif-start nil)))
+
+(defun forms--iif-post-command-hook ()
+ "`post-command-hook' function for read-only segments."
+
+ ;; Disable `post-command-hook'.
+ (setq post-command-hook
+ (delq 'forms--iif-hook-post-command-hook post-command-hook))
+
+ ;; Restore properties.
+ (if forms--iif-start
+ (let ((inhibit-read-only t))
+ (set-text-properties
+ (1- forms--iif-start) forms--iif-start
+ forms--iif-properties)))
+
+ ;; Cleanup.
+ (setq forms--iif-start nil))
+\f
+(defvar forms--marker)
+(defvar forms--dyntext)
- (setq forms--markers (make-vector forms--number-of-markers nil)))
+(defun forms--make-format ()
+ "Generate `forms--format' using the information in `forms-format-list'."
+
+ ;; The real work is done using a mapcar of `forms--make-format-elt' on
+ ;; `forms-format-list'.
+ ;; This function sets up the necessary environment, and decides
+ ;; which function to mapcar.
+
+ (let ((forms--marker 0)
+ (forms--dyntext 0))
+ (setq
+ forms--format
+ (if forms-use-text-properties
+ (` (lambda (arg)
+ (let ((inhibit-read-only t))
+ (,@ (apply 'append
+ (mapcar 'forms--make-format-elt-using-text-properties
+ forms-format-list)))
+ ;; Prevent insertion before the first text.
+ (,@ (if (numberp (car forms-format-list))
+ nil
+ '((add-text-properties (point-min) (1+ (point-min))
+ '(front-sticky (read-only intangible))))))
+ ;; Prevent insertion after the last text.
+ (remove-text-properties (1- (point)) (point)
+ '(rear-nonsticky)))
+ (setq forms--iif-start nil)))
+ (` (lambda (arg)
+ (,@ (apply 'append
+ (mapcar 'forms--make-format-elt forms-format-list)))))))
+
+ ;; We have tallied the number of markers and dynamic texts,
+ ;; so we can allocate the arrays now.
+ (setq forms--markers (make-vector forms--marker nil))
+ (setq forms--dyntexts (make-vector forms--dyntext nil)))
+ (forms--debug 'forms--format))
+(defun forms--make-format-elt-using-text-properties (el)
+ "Helper routine to generate format function."
-;;;\f
-;;; Build the format routine from forms-format-list.
-;;;
-;;; The format routine (forms--format) will look like
-;;;
-;;; (lambda (arg)
-;;; (setq forms--dynamic-text nil)
-;;; ;; "text: "
-;;; (insert "text: ")
-;;; ;; 6
-;;; (aset forms--markers 0 (point-marker))
-;;; (insert (elt arg 5))
-;;; ;; "\nmore text: "
-;;; (insert "\nmore text: ")
-;;; ;; (tocol 40)
-;;; (let ((the-dyntext (tocol 40)))
-;;; (insert the-dyntext)
-;;; (setq forms--dynamic-text (append forms--dynamic-text
-;;; (list the-dyntext))))
-;;; ;; 9
-;;; (aset forms--markers 1 (point-marker))
-;;; (insert (elt arg 8))
-;;;
-;;; ... )
-;;;
+ ;; The format routine `forms--format' will look like
+ ;;
+ ;; ;; preamble
+ ;; (lambda (arg)
+ ;; (let ((inhibit-read-only t))
+ ;;
+ ;; ;; A string, e.g. "text: ".
+ ;; (set-text-properties
+ ;; (point)
+ ;; (progn (insert "text: ") (point))
+ ;; (list 'face forms--ro-face
+ ;; 'read-only 1
+ ;; 'insert-in-front-hooks 'forms--iif-hook
+ ;; 'rear-nonsticky '(read-only face insert-in-front-hooks)))
+ ;;
+ ;; ;; A field, e.g. 6.
+ ;; (let ((here (point)))
+ ;; (aset forms--markers 0 (point-marker))
+ ;; (insert (elt arg 5))
+ ;; (or (= (point) here)
+ ;; (set-text-properties
+ ;; here (point)
+ ;; (list 'face forms--rw-face
+ ;; 'front-sticky '(face))))
+ ;;
+ ;; ;; Another string, e.g. "\nmore text: ".
+ ;; (set-text-properties
+ ;; (point)
+ ;; (progn (insert "\nmore text: ") (point))
+ ;; (list 'face forms--ro-face
+ ;; 'read-only 2
+ ;; 'insert-in-front-hooks 'forms--iif-hook
+ ;; 'rear-nonsticky '(read-only face insert-in-front-hooks)))
+ ;;
+ ;; ;; A function, e.g. (tocol 40).
+ ;; (set-text-properties
+ ;; (point)
+ ;; (progn
+ ;; (insert (aset forms--dyntexts 0 (tocol 40)))
+ ;; (point))
+ ;; (list 'face forms--ro-face
+ ;; 'read-only 2
+ ;; 'insert-in-front-hooks 'forms--iif-hook
+ ;; 'rear-nonsticky '(read-only face insert-in-front-hooks)))
+ ;;
+ ;; ;; Prevent insertion before the first text.
+ ;; (add-text-properties (point-min) (1+ (point-min))
+ ;; '(front-sticky (read-only))))))
+ ;; ;; Prevent insertion after the last text.
+ ;; (remove-text-properties (1- (point)) (point)
+ ;; '(rear-nonsticky)))
+ ;;
+ ;; ;; wrap up
+ ;; (setq forms--iif-start nil)
+ ;; ))
-(defun forms--make-format ()
- "Generate format function for forms"
- (setq forms--format (forms--format-maker forms-format-list))
- (forms--debug 'forms--format))
+ (cond
+ ((stringp el)
+
+ (` ((set-text-properties
+ (point) ; start at point
+ (progn ; until after insertion
+ (insert (, el))
+ (point))
+ (list 'face forms--ro-face ; read-only appearance
+ 'read-only (,@ (list (1+ forms--marker)))
+ 'intangible t
+ 'insert-in-front-hooks '(forms--iif-hook)
+ 'rear-nonsticky '(face read-only insert-in-front-hooks
+ intangible))))))
+
+ ((numberp el)
+ (` ((let ((here (point)))
+ (aset forms--markers
+ (, (prog1 forms--marker
+ (setq forms--marker (1+ forms--marker))))
+ (point-marker))
+ (insert (elt arg (, (1- el))))
+ (or (= (point) here)
+ (set-text-properties
+ here (point)
+ (list 'face forms--rw-face
+ 'front-sticky '(face))))))))
-(defun forms--format-maker (the-format-list)
- "Returns the parser function for forms"
- (let ((the-marker 0))
- (` (lambda (arg)
- (setq forms--dynamic-text nil)
- (,@ (apply 'append
- (mapcar 'forms--make-format-elt the-format-list)))))))
+ ((listp el)
+ (` ((set-text-properties
+ (point)
+ (progn
+ (insert (aset forms--dyntexts
+ (, (prog1 forms--dyntext
+ (setq forms--dyntext (1+ forms--dyntext))))
+ (, el)))
+ (point))
+ (list 'face forms--ro-face
+ 'read-only (,@ (list (1+ forms--marker)))
+ 'intangible t
+ 'insert-in-front-hooks '(forms--iif-hook)
+ 'rear-nonsticky '(read-only face insert-in-front-hooks
+ intangible))))))
+
+ ;; end of cond
+ ))
(defun forms--make-format-elt (el)
- (cond ((stringp el)
- (` ((insert (, el)))))
- ((numberp el)
- (prog1
- (` ((aset forms--markers (, the-marker) (point-marker))
- (insert (elt arg (, (1- el))))))
- (setq the-marker (1+ the-marker))))
- ((listp el)
- (prog1
- (` ((let ((the-dyntext (, el)))
- (insert the-dyntext)
- (setq forms--dynamic-text (append forms--dynamic-text
- (list the-dyntext)))))
- )))
- ))
-
+ "Helper routine to generate format function."
-(defun forms--concat-adjacent (the-list)
- "Concatenate adjacent strings in the-list and return the resulting list"
- (if (consp the-list)
- (let ((the-rest (forms--concat-adjacent (cdr the-list))))
- (if (and (stringp (car the-list)) (stringp (car the-rest)))
- (cons (concat (car the-list) (car the-rest))
- (cdr the-rest))
- (cons (car the-list) the-rest)))
- the-list))
-;;;\f
-;;; forms--make-parser.
-;;;
-;;; Generate parse routine from forms-format-list.
-;;;
-;;; The parse routine (forms--parser) will look like (give or take
-;;; a few " " .
-;;;
-;;; (lambda nil
-;;; (let (here)
-;;; (goto-char (point-min))
-;;;
-;;; ;; "text: "
-;;; (if (not (looking-at "text: "))
-;;; (error "Parse error: cannot find \"text: \""))
-;;; (forward-char 6) ; past "text: "
-;;;
-;;; ;; 6
-;;; ;; "\nmore text: "
-;;; (setq here (point))
-;;; (if (not (search-forward "\nmore text: " nil t nil))
-;;; (error "Parse error: cannot find \"\\nmore text: \""))
-;;; (aset the-recordv 5 (buffer-substring here (- (point) 12)))
-;;;
-;;; ;; (tocol 40)
-;;; (let ((the-dyntext (car-safe forms--dynamic-text)))
-;;; (if (not (looking-at (regexp-quote the-dyntext)))
-;;; (error "Parse error: not looking at \"%s\"" the-dyntext))
-;;; (forward-char (length the-dyntext))
-;;; (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))
-;;; ...
-;;; ;; final flush (due to terminator sentinel, see below)
-;;; (aset the-recordv 7 (buffer-substring (point) (point-max)))
-;;;
+ ;; If we're not using text properties, the format routine
+ ;; `forms--format' will look like
+ ;;
+ ;; (lambda (arg)
+ ;; ;; a string, e.g. "text: "
+ ;; (insert "text: ")
+ ;; ;; a field, e.g. 6
+ ;; (aset forms--markers 0 (point-marker))
+ ;; (insert (elt arg 5))
+ ;; ;; another string, e.g. "\nmore text: "
+ ;; (insert "\nmore text: ")
+ ;; ;; a function, e.g. (tocol 40)
+ ;; (insert (aset forms--dyntexts 0 (tocol 40)))
+ ;; ... )
+
+ (cond
+ ((stringp el)
+ (` ((insert (, el)))))
+ ((numberp el)
+ (prog1
+ (` ((aset forms--markers (, forms--marker) (point-marker))
+ (insert (elt arg (, (1- el))))))
+ (setq forms--marker (1+ forms--marker))))
+ ((listp el)
+ (prog1
+ (` ((insert (aset forms--dyntexts (, forms--dyntext) (, el)))))
+ (setq forms--dyntext (1+ forms--dyntext))))))
+\f
+(defvar forms--field)
+(defvar forms--recordv)
+(defvar forms--seen-text)
(defun forms--make-parser ()
- "Generate parser function for forms"
- (setq forms--parser (forms--parser-maker forms-format-list))
+ "Generate `forms--parser' from the information in `forms-format-list'."
+
+ ;; If we can use text properties, we simply set it to
+ ;; `forms--parser-using-text-properties'.
+ ;; Otherwise, the function is constructed using a mapcar of
+ ;; `forms--make-parser-elt on `forms-format-list'.
+
+ (setq
+ forms--parser
+ (if forms-use-text-properties
+ (function forms--parser-using-text-properties)
+ (let ((forms--field nil)
+ (forms--seen-text nil)
+ (forms--dyntext 0))
+
+ ;; Note: we add a nil element to the list passed to `mapcar',
+ ;; see `forms--make-parser-elt' for details.
+ (` (lambda nil
+ (let (here)
+ (goto-char (point-min))
+ (,@ (apply 'append
+ (mapcar
+ 'forms--make-parser-elt
+ (append forms-format-list (list nil)))))))))))
+
(forms--debug 'forms--parser))
-(defun forms--parser-maker (the-format-list)
- "Returns the parser function for forms"
- (let ((the-field nil)
- (seen-text nil)
- the--format-list)
- ;; add a terminator sentinel
- (setq the--format-list (append the-format-list (list nil)))
- (` (lambda nil
- (let (here)
- (goto-char (point-min))
- (,@ (apply 'append
- (mapcar 'forms--make-parser-elt the--format-list))))))))
+(defun forms--parser-using-text-properties ()
+ "Extract field info from forms when using text properties."
+
+ ;; Using text properties, we can simply jump to the markers, and
+ ;; extract the information up to the following read-only segment.
+
+ (let ((i 0)
+ here there)
+ (while (< i (length forms--markers))
+ (goto-char (setq here (aref forms--markers i)))
+ (if (get-text-property here 'read-only)
+ (aset forms--recordv (aref forms--elements i) nil)
+ (if (setq there
+ (next-single-property-change here 'read-only))
+ (aset forms--recordv (aref forms--elements i)
+ (buffer-substring-no-properties here there))
+ (aset forms--recordv (aref forms--elements i)
+ (buffer-substring-no-properties here (point-max)))))
+ (setq i (1+ i)))))
(defun forms--make-parser-elt (el)
+ "Helper routine to generate forms parser function."
+
+ ;; The parse routine will look like:
+ ;;
+ ;; (lambda nil
+ ;; (let (here)
+ ;; (goto-char (point-min))
+ ;;
+ ;; ;; "text: "
+ ;; (if (not (looking-at "text: "))
+ ;; (error "Parse error: cannot find \"text: \""))
+ ;; (forward-char 6) ; past "text: "
+ ;;
+ ;; ;; 6
+ ;; ;; "\nmore text: "
+ ;; (setq here (point))
+ ;; (if (not (search-forward "\nmore text: " nil t nil))
+ ;; (error "Parse error: cannot find \"\\nmore text: \""))
+ ;; (aset forms--recordv 5 (buffer-substring-no-properties here (- (point) 12)))
+ ;;
+ ;; ;; (tocol 40)
+ ;; (let ((forms--dyntext (car-safe forms--dynamic-text)))
+ ;; (if (not (looking-at (regexp-quote forms--dyntext)))
+ ;; (error "Parse error: not looking at \"%s\"" forms--dyntext))
+ ;; (forward-char (length forms--dyntext))
+ ;; (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))
+ ;; ...
+ ;; ;; final flush (due to terminator sentinel, see below)
+ ;; (aset forms--recordv 7 (buffer-substring-no-properties (point) (point-max)))
+
(cond
((stringp el)
(prog1
- (if the-field
+ (if forms--field
(` ((setq here (point))
(if (not (search-forward (, el) nil t nil))
(error "Parse error: cannot find \"%s\"" (, el)))
- (aset the-recordv (, (1- the-field))
- (buffer-substring here
+ (aset forms--recordv (, (1- forms--field))
+ (buffer-substring-no-properties here
(- (point) (, (length el)))))))
(` ((if (not (looking-at (, (regexp-quote el))))
(error "Parse error: not looking at \"%s\"" (, el)))
(forward-char (, (length el))))))
- (setq seen-text t)
- (setq the-field nil)))
+ (setq forms--seen-text t)
+ (setq forms--field nil)))
((numberp el)
- (if the-field
+ (if forms--field
(error "Cannot parse adjacent fields %d and %d"
- the-field el)
- (setq the-field el)
+ forms--field el)
+ (setq forms--field el)
nil))
((null el)
- (if the-field
- (` ((aset the-recordv (, (1- the-field))
- (buffer-substring (point) (point-max)))))))
+ (if forms--field
+ (` ((aset forms--recordv (, (1- forms--field))
+ (buffer-substring-no-properties (point) (point-max)))))))
((listp el)
(prog1
- (if the-field
+ (if forms--field
(` ((let ((here (point))
- (the-dyntext (car-safe forms--dynamic-text)))
- (if (not (search-forward the-dyntext nil t nil))
- (error "Parse error: cannot find \"%s\"" the-dyntext))
- (aset the-recordv (, (1- the-field))
- (buffer-substring here
- (- (point) (length the-dyntext))))
- (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))))
- (` ((let ((the-dyntext (car-safe forms--dynamic-text)))
- (if (not (looking-at (regexp-quote the-dyntext)))
- (error "Parse error: not looking at \"%s\"" the-dyntext))
- (forward-char (length the-dyntext))
- (setq forms--dynamic-text (cdr-safe forms--dynamic-text))))))
- (setq seen-text t)
- (setq the-field nil)))
+ (forms--dyntext (aref forms--dyntexts (, forms--dyntext))))
+ (if (not (search-forward forms--dyntext nil t nil))
+ (error "Parse error: cannot find \"%s\"" forms--dyntext))
+ (aset forms--recordv (, (1- forms--field))
+ (buffer-substring-no-properties here
+ (- (point) (length forms--dyntext)))))))
+ (` ((let ((forms--dyntext (aref forms--dyntexts (, forms--dyntext))))
+ (if (not (looking-at (regexp-quote forms--dyntext)))
+ (error "Parse error: not looking at \"%s\"" forms--dyntext))
+ (forward-char (length forms--dyntext))))))
+ (setq forms--dyntext (1+ forms--dyntext))
+ (setq forms--seen-text t)
+ (setq forms--field nil)))
))
-;;;\f
-
-(defun forms--set-minor-mode ()
- (setq minor-mode-alist
- (if forms-read-only
- " View"
- nil)))
-
+\f
+(defun forms--intuit-from-file ()
+ "Get number of fields and a default form using the data file."
+
+ ;; If `forms-number-of-fields' is not set, get it from the data file.
+ (if (null forms-number-of-fields)
+
+ ;; Need a file to do this.
+ (if (not (file-exists-p forms-file))
+ (error "Need existing file or explicit 'forms-number-of-records'.")
+
+ ;; Visit the file and extract the first record.
+ (setq forms--file-buffer (find-file-noselect forms-file))
+ (let ((read-file-filter forms-read-file-filter)
+ (the-record))
+ (setq the-record
+ (save-excursion
+ (set-buffer forms--file-buffer)
+ (let ((inhibit-read-only t))
+ (run-hooks 'read-file-filter))
+ (goto-char (point-min))
+ (forms--get-record)))
+
+ ;; This may be overkill, but try to avoid interference with
+ ;; the normal processing.
+ (kill-buffer forms--file-buffer)
+
+ ;; Count the number of fields in `the-record'.
+ (let (the-result
+ (start-pos 0)
+ found-pos
+ (field-sep-length (length forms-field-sep)))
+ (setq forms-number-of-fields 1)
+ (while (setq found-pos
+ (string-match forms-field-sep the-record start-pos))
+ (progn
+ (setq forms-number-of-fields (1+ forms-number-of-fields))
+ (setq start-pos (+ field-sep-length found-pos))))))))
+
+ ;; Construct default format list.
+ (setq forms-format-list (list "Forms file \"" forms-file "\".\n\n"))
+ (let ((i 0))
+ (while (<= (setq i (1+ i)) forms-number-of-fields)
+ (setq forms-format-list
+ (append forms-format-list
+ (list (format "%4d: " i) i "\n"))))))
+\f
(defun forms--set-keymaps ()
"Set the keymaps used in this mode."
- (if forms-read-only
- (use-local-map forms-mode-map)
- (use-local-map (make-sparse-keymap))
- (define-key (current-local-map) "\C-c" forms-mode-map)
- (define-key (current-local-map) "\t" 'forms-next-field)))
-
-(defun forms--mode-commands (map)
- "Fill map with all commands."
- (define-key map "\t" 'forms-next-field)
- (define-key map " " 'forms-next-record)
- (define-key map "d" 'forms-delete-record)
- (define-key map "e" 'forms-edit-mode)
- (define-key map "i" 'forms-insert-record)
- (define-key map "j" 'forms-jump-record)
- (define-key map "n" 'forms-next-record)
- (define-key map "p" 'forms-prev-record)
- (define-key map "q" 'forms-exit)
- (define-key map "s" 'forms-search)
- (define-key map "v" 'forms-view-mode)
- (define-key map "x" 'forms-exit-no-save)
- (define-key map "<" 'forms-first-record)
- (define-key map ">" 'forms-last-record)
- (define-key map "?" 'describe-mode)
- (define-key map "\177" 'forms-prev-record)
- ; (define-key map "\C-c" map)
- (define-key map "\e" 'ESC-prefix)
- (define-key map "\C-x" ctl-x-map)
- (define-key map "\C-u" 'universal-argument)
- (define-key map "\C-h" help-map)
+ (use-local-map (if forms-read-only
+ forms-mode-ro-map
+ forms-mode-edit-map)))
+
+(defun forms--mode-commands ()
+ "Fill the Forms mode keymaps."
+
+ ;; `forms-mode-map' is always accessible via \C-c prefix.
+ (setq forms-mode-map (make-keymap))
+ (define-key forms-mode-map "\t" 'forms-next-field)
+ (define-key forms-mode-map "\C-k" 'forms-delete-record)
+ (define-key forms-mode-map "\C-q" 'forms-toggle-read-only)
+ (define-key forms-mode-map "\C-o" 'forms-insert-record)
+ (define-key forms-mode-map "\C-l" 'forms-jump-record)
+ (define-key forms-mode-map "\C-n" 'forms-next-record)
+ (define-key forms-mode-map "\C-p" 'forms-prev-record)
+ (define-key forms-mode-map "\C-r" 'forms-search-backward)
+ (define-key forms-mode-map "\C-s" 'forms-search-forward)
+ (define-key forms-mode-map "\C-x" 'forms-exit)
+ (define-key forms-mode-map "<" 'forms-first-record)
+ (define-key forms-mode-map ">" 'forms-last-record)
+ (define-key forms-mode-map "\C-?" 'forms-prev-record)
+
+ ;; `forms-mode-ro-map' replaces the local map when in read-only mode.
+ (setq forms-mode-ro-map (make-keymap))
+ (suppress-keymap forms-mode-ro-map)
+ (define-key forms-mode-ro-map "\C-c" forms-mode-map)
+ (define-key forms-mode-ro-map "\t" 'forms-next-field)
+ (define-key forms-mode-ro-map "q" 'forms-toggle-read-only)
+ (define-key forms-mode-ro-map "l" 'forms-jump-record)
+ (define-key forms-mode-ro-map "n" 'forms-next-record)
+ (define-key forms-mode-ro-map "p" 'forms-prev-record)
+ (define-key forms-mode-ro-map "r" 'forms-search-backward)
+ (define-key forms-mode-ro-map "s" 'forms-search-forward)
+ (define-key forms-mode-ro-map "x" 'forms-exit)
+ (define-key forms-mode-ro-map "<" 'forms-first-record)
+ (define-key forms-mode-ro-map ">" 'forms-last-record)
+ (define-key forms-mode-ro-map "?" 'describe-mode)
+ (define-key forms-mode-ro-map " " 'forms-next-record)
+ (forms--mode-commands1 forms-mode-ro-map)
+ (forms--mode-menu-ro forms-mode-ro-map)
+
+ ;; This is the normal, local map.
+ (setq forms-mode-edit-map (make-keymap))
+ (define-key forms-mode-edit-map "\t" 'forms-next-field)
+ (define-key forms-mode-edit-map "\C-c" forms-mode-map)
+ (forms--mode-commands1 forms-mode-edit-map)
+ (forms--mode-menu-edit forms-mode-edit-map)
+ )
+
+(defun forms--mode-menu-ro (map)
+;;; Menu initialisation
+; (define-key map [menu-bar] (make-sparse-keymap))
+ (define-key map [menu-bar forms]
+ (cons "Forms" (make-sparse-keymap "Forms")))
+ (define-key map [menu-bar forms menu-forms-exit]
+ '("Exit" . forms-exit))
+ (define-key map [menu-bar forms menu-forms-sep1]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-save]
+ '("Save Data" . forms-save-buffer))
+ (define-key map [menu-bar forms menu-forms-print]
+ '("Print Data" . forms-print))
+ (define-key map [menu-bar forms menu-forms-describe]
+ '("Describe Mode" . describe-mode))
+ (define-key map [menu-bar forms menu-forms-toggle-ro]
+ '("Toggle View/Edit" . forms-toggle-read-only))
+ (define-key map [menu-bar forms menu-forms-jump-record]
+ '("Jump" . forms-jump-record))
+ (define-key map [menu-bar forms menu-forms-search-backward]
+ '("Search Backward" . forms-search-backward))
+ (define-key map [menu-bar forms menu-forms-search-forward]
+ '("Search Forward" . forms-search-forward))
+ (define-key map [menu-bar forms menu-forms-delete-record]
+ '("Delete" . forms-delete-record))
+ (define-key map [menu-bar forms menu-forms-insert-record]
+ '("Insert" . forms-insert-record))
+ (define-key map [menu-bar forms menu-forms-sep2]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-last-record]
+ '("Last Record" . forms-last-record))
+ (define-key map [menu-bar forms menu-forms-first-record]
+ '("First Record" . forms-first-record))
+ (define-key map [menu-bar forms menu-forms-prev-record]
+ '("Previous Record" . forms-prev-record))
+ (define-key map [menu-bar forms menu-forms-next-record]
+ '("Next Record" . forms-next-record))
+ (define-key map [menu-bar forms menu-forms-sep3]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-prev-field]
+ '("Previous Field" . forms-prev-field))
+ (define-key map [menu-bar forms menu-forms-next-field]
+ '("Next Field" . forms-next-field))
+ (put 'forms-insert-record 'menu-enable '(not forms-read-only))
+ (put 'forms-delete-record 'menu-enable '(not forms-read-only))
+)
+(defun forms--mode-menu-edit (map)
+;;; Menu initialisation
+; (define-key map [menu-bar] (make-sparse-keymap))
+ (define-key map [menu-bar forms]
+ (cons "Forms" (make-sparse-keymap "Forms")))
+ (define-key map [menu-bar forms menu-forms-edit--exit]
+ '("Exit" . forms-exit))
+ (define-key map [menu-bar forms menu-forms-edit-sep1]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-edit-save]
+ '("Save Data" . forms-save-buffer))
+ (define-key map [menu-bar forms menu-forms-edit-print]
+ '("Print Data" . forms-print))
+ (define-key map [menu-bar forms menu-forms-edit-describe]
+ '("Describe Mode" . describe-mode))
+ (define-key map [menu-bar forms menu-forms-edit-toggle-ro]
+ '("Toggle View/Edit" . forms-toggle-read-only))
+ (define-key map [menu-bar forms menu-forms-edit-jump-record]
+ '("Jump" . forms-jump-record))
+ (define-key map [menu-bar forms menu-forms-edit-search-backward]
+ '("Search Backward" . forms-search-backward))
+ (define-key map [menu-bar forms menu-forms-edit-search-forward]
+ '("Search Forward" . forms-search-forward))
+ (define-key map [menu-bar forms menu-forms-edit-delete-record]
+ '("Delete" . forms-delete-record))
+ (define-key map [menu-bar forms menu-forms-edit-insert-record]
+ '("Insert" . forms-insert-record))
+ (define-key map [menu-bar forms menu-forms-edit-sep2]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-edit-last-record]
+ '("Last Record" . forms-last-record))
+ (define-key map [menu-bar forms menu-forms-edit-first-record]
+ '("First Record" . forms-first-record))
+ (define-key map [menu-bar forms menu-forms-edit-prev-record]
+ '("Previous Record" . forms-prev-record))
+ (define-key map [menu-bar forms menu-forms-edit-next-record]
+ '("Next Record" . forms-next-record))
+ (define-key map [menu-bar forms menu-forms-edit-sep3]
+ '("----"))
+ (define-key map [menu-bar forms menu-forms-edit-prev-field]
+ '("Previous Field" . forms-prev-field))
+ (define-key map [menu-bar forms menu-forms-edit-next-field]
+ '("Next Field" . forms-next-field))
+ (put 'forms-insert-record 'menu-enable '(not forms-read-only))
+ (put 'forms-delete-record 'menu-enable '(not forms-read-only))
+)
+
+(defun forms--mode-commands1 (map)
+ "Helper routine to define keys."
+ (define-key map [TAB] 'forms-next-field)
+ (define-key map [S-tab] 'forms-prev-field)
+ (define-key map [next] 'forms-next-record)
+ (define-key map [prior] 'forms-prev-record)
+ (define-key map [begin] 'forms-first-record)
+ (define-key map [last] 'forms-last-record)
+ (define-key map [backtab] 'forms-prev-field)
)
-;;;\f
+\f
;;; Changed functions
-;;;
-;;; Emacs (as of 18.55) lacks the functionality of buffer-local
-;;; funtions. Therefore we save the original meaning of some handy
-;;; functions, and replace them with a wrapper.
(defun forms--change-commands ()
- "Localize some commands."
- ;;
+ "Localize some commands for Forms mode."
+
;; scroll-down -> forms-prev-record
- ;;
- (if (fboundp 'forms--scroll-down)
- nil
- (fset 'forms--scroll-down (symbol-function 'scroll-down))
- (fset 'scroll-down
- '(lambda (&optional arg)
- (interactive "P")
- (if (and forms--mode-setup
- forms-forms-scroll)
- (forms-prev-record arg)
- (forms--scroll-down arg)))))
- ;;
;; scroll-up -> forms-next-record
- ;;
- (if (fboundp 'forms--scroll-up)
- nil
- (fset 'forms--scroll-up (symbol-function 'scroll-up))
- (fset 'scroll-up
- '(lambda (&optional arg)
- (interactive "P")
- (if (and forms--mode-setup
- forms-forms-scroll)
- (forms-next-record arg)
- (forms--scroll-up arg)))))
+ (if forms-forms-scroll
+ (progn
+ (substitute-key-definition 'scroll-up 'forms-next-record
+ (current-local-map)
+ (current-global-map))
+ (substitute-key-definition 'scroll-down 'forms-prev-record
+ (current-local-map)
+ (current-global-map))))
;;
;; beginning-of-buffer -> forms-first-record
- ;;
- (if (fboundp 'forms--beginning-of-buffer)
- nil
- (fset 'forms--beginning-of-buffer (symbol-function 'beginning-of-buffer))
- (fset 'beginning-of-buffer
- '(lambda ()
- (interactive)
- (if (and forms--mode-setup
- forms-forms-jump)
- (forms-first-record)
- (forms--beginning-of-buffer)))))
- ;;
;; end-of-buffer -> forms-end-record
+ (if forms-forms-jump
+ (progn
+ (substitute-key-definition 'beginning-of-buffer 'forms-first-record
+ (current-local-map)
+ (current-global-map))
+ (substitute-key-definition 'end-of-buffer 'forms-last-record
+ (current-local-map)
+ (current-global-map))))
;;
- (if (fboundp 'forms--end-of-buffer)
- nil
- (fset 'forms--end-of-buffer (symbol-function 'end-of-buffer))
- (fset 'end-of-buffer
- '(lambda ()
- (interactive)
- (if (and forms--mode-setup
- forms-forms-jump)
- (forms-last-record)
- (forms--end-of-buffer)))))
- ;;
- ;; save-buffer -> forms--save-buffer
- ;;
- (if (fboundp 'forms--save-buffer)
- nil
- (fset 'forms--save-buffer (symbol-function 'save-buffer))
- (fset 'save-buffer
- '(lambda (&optional arg)
- (interactive "p")
- (if forms--mode-setup
- (progn
- (forms--checkmod)
- (save-excursion
- (set-buffer forms--file-buffer)
- (forms--save-buffer arg)))
- (forms--save-buffer arg)))))
+ ;; Save buffer
+ (local-set-key "\C-x\C-s" 'forms-save-buffer)
;;
- )
+ ;; We have our own revert function - use it.
+ (make-local-variable 'revert-buffer-function)
+ (setq revert-buffer-function 'forms--revert-buffer)
+
+ t)
(defun forms--help ()
- "Initial help."
- ;; We should use
- ;;(message (substitute-command-keys (concat
- ;;"\\[forms-next-record]:next"
- ;;" \\[forms-prev-record]:prev"
- ;;" \\[forms-first-record]:first"
- ;;" \\[forms-last-record]:last"
- ;;" \\[describe-mode]:help"
- ;;" \\[forms-exit]:exit")))
- ;; but it's too slow ....
- (if forms-read-only
- (message "SPC:next DEL:prev <:first >:last ?:help q:exit")
- (message "C-c n:next C-c p:prev C-c <:first C-c >:last C-c ?:help C-c q:exit")))
+ "Initial help for Forms mode."
+ (message (substitute-command-keys (concat
+ "\\[forms-next-record]:next"
+ " \\[forms-prev-record]:prev"
+ " \\[forms-first-record]:first"
+ " \\[forms-last-record]:last"
+ " \\[describe-mode]:help"))))
(defun forms--trans (subj arg rep)
- "Translate in SUBJ all chars ARG into char REP. ARG and REP should
+ "Translate in SUBJ all chars ARG into char REP. ARG and REP should
be single-char strings."
(let ((i 0)
(x (length subj))
(setq i (1+ i)))))
(defun forms--exit (query &optional save)
+ "Internal exit from forms mode function."
+
(let ((buf (buffer-name forms--file-buffer)))
(forms--checkmod)
(if (and save
(buffer-modified-p forms--file-buffer))
- (save-excursion
- (set-buffer forms--file-buffer)
- (save-buffer)))
+ (forms-save-buffer))
(save-excursion
(set-buffer forms--file-buffer)
(delete-auto-save-file-if-necessary)
(defun forms--get-record ()
"Fetch the current record from the file buffer."
- ;;
- ;; This function is executed in the context of the forms--file-buffer.
- ;;
+
+ ;; This function is executed in the context of the `forms--file-buffer'.
+
(or (bolp)
(beginning-of-line nil))
(let ((here (point)))
(prog2
(end-of-line)
- (buffer-substring here (point))
+ (buffer-substring-no-properties here (point))
(goto-char here))))
(defun forms--show-record (the-record)
- "Format THE-RECORD according to forms-format-list,
- and display it in the current buffer."
+ "Format THE-RECORD and display it in the current buffer."
- ;; split the-record
+ ;; Split the-record.
(let (the-result
(start-pos 0)
found-pos
(field-sep-length (length forms-field-sep)))
(if forms-multi-line
(forms--trans the-record forms-multi-line "\n"))
- ;; add an extra separator (makes splitting easy)
+ ;; Add an extra separator (makes splitting easy).
(setq the-record (concat the-record forms-field-sep))
(while (setq found-pos (string-match forms-field-sep the-record start-pos))
(let ((ent (substring the-record start-pos found-pos)))
(setq forms--the-record-list the-result))
(setq buffer-read-only nil)
+ (if forms-use-text-properties
+ (let ((inhibit-read-only t))
+ (set-text-properties (point-min) (point-max) nil)))
(erase-buffer)
- ;; verify the number of fields, extend forms--the-record-list if needed
+ ;; Verify the number of fields, extend forms--the-record-list if needed.
(if (= (length forms--the-record-list) forms-number-of-fields)
nil
- (beep)
- (message "Record has %d fields instead of %d."
- (length forms--the-record-list) forms-number-of-fields)
+ (if (null forms-check-number-of-fields)
+ nil
+ (beep)
+ (message "Warning: this record has %d fields instead of %d"
+ (length forms--the-record-list) forms-number-of-fields))
(if (< (length forms--the-record-list) forms-number-of-fields)
(setq forms--the-record-list
(append forms--the-record-list
(length forms--the-record-list))
"")))))
- ;; call the formatter function
+ ;; Call the formatter function.
(setq forms-fields (append (list nil) forms--the-record-list nil))
(funcall forms--format forms--the-record-list)
- ;; prepare
+ ;; Prepare.
(goto-char (point-min))
(set-buffer-modified-p nil)
(setq buffer-read-only forms-read-only)
;; The contents of the form are parsed, and a new list of strings
;; is constructed.
;; A vector with the strings from the original record is
- ;; constructed, which is updated with the new contents. Therefore
+ ;; constructed, which is updated with the new contents. Therefore
;; fields which were not in the form are not modified.
;; Finally, the vector is transformed into a list for further processing.
- (let (the-recordv)
+ (let (forms--recordv)
- ;; build the vector
- (setq the-recordv (vconcat forms--the-record-list))
+ ;; Build the vector.
+ (setq forms--recordv (vconcat forms--the-record-list))
- ;; parse the form and update the vector
+ ;; Parse the form and update the vector.
(let ((forms--dynamic-text forms--dynamic-text))
(funcall forms--parser))
- (if forms--modified-record-filter
+ (if forms-modified-record-filter
;; As a service to the user, we add a zeroth element so she
;; can use the same indices as in the forms definition.
- (let ((the-fields (vconcat [nil] the-recordv)))
- (setq the-fields (funcall forms--modified-record-filter the-fields))
+ (let ((the-fields (vconcat [nil] forms--recordv)))
+ (setq the-fields (funcall forms-modified-record-filter the-fields))
(cdr (append the-fields nil)))
- ;; transform to a list and return
- (append the-recordv nil))))
+ ;; Transform to a list and return.
+ (append forms--recordv nil))))
(defun forms--update ()
- "Update current record with contents of form. As a side effect: sets
-forms--the-record-list ."
+ "Update current record with contents of form.
+As a side effect: sets `forms--the-record-list'."
+
(if forms-read-only
(progn
(message "Read-only buffer!")
(beep))
(let (the-record)
- ;; build new record
+ ;; Build new record.
(setq forms--the-record-list (forms--parse-form))
(setq the-record
(mapconcat 'identity forms--the-record-list forms-field-sep))
- ;; handle multi-line fields, if allowed
+ (if (string-match (regexp-quote forms-field-sep)
+ (mapconcat 'identity forms--the-record-list ""))
+ (error "Field separator occurs in record - update refused!"))
+
+ ;; Handle multi-line fields, if allowed.
(if forms-multi-line
(forms--trans the-record "\n" forms-multi-line))
- ;; a final sanity check before updating
+ ;; A final sanity check before updating.
(if (string-match "\n" the-record)
(progn
(message "Multi-line fields in this record - update refused!")
(save-excursion
(set-buffer forms--file-buffer)
- ;; Insert something before kill-line is called. See kill-line
- ;; doc. Bugfix provided by Ignatios Souvatzis.
- (insert "*")
- (beginning-of-line)
- (kill-line nil)
+ ;; Use delete-region instead of kill-region, to avoid
+ ;; adding junk to the kill-ring.
+ (delete-region (save-excursion (beginning-of-line) (point))
+ (save-excursion (end-of-line) (point)))
(insert the-record)
(beginning-of-line))))))
(forms--update)
(set-buffer-modified-p nil)
(goto-char here))))
-
-;;;\f
+\f
;;; Start and exit
+
+;;;###autoload
(defun forms-find-file (fn)
- "Visit file FN in forms mode"
+ "Visit a file in Forms mode."
(interactive "fForms file: ")
- (find-file-read-only fn)
- (or forms--mode-setup (forms-mode t)))
+ (let ((enable-local-eval t)
+ (enable-local-variables t))
+ (find-file-read-only fn)
+ (or forms--mode-setup (forms-mode t))))
+;;;###autoload
(defun forms-find-file-other-window (fn)
- "Visit file FN in form mode in other window"
+ "Visit a file in Forms mode in other window."
(interactive "fFbrowse file in other window: ")
- (find-file-other-window fn)
- (eval-current-buffer)
- (or forms--mode-setup (forms-mode t)))
+ (let ((enable-local-eval t)
+ (enable-local-variables t))
+ (find-file-other-window fn)
+ (or forms--mode-setup (forms-mode t))))
(defun forms-exit (query)
- "Normal exit. Modified buffers are saved."
+ "Normal exit from Forms mode. Modified buffers are saved."
(interactive "P")
(forms--exit query t))
(defun forms-exit-no-save (query)
- "Exit without saving buffers."
+ "Exit from Forms mode without saving buffers."
(interactive "P")
(forms--exit query nil))
-
-;;;\f
+\f
;;; Navigating commands
(defun forms-next-record (arg)
"Jump to a random record."
(interactive "NRecord number: ")
- ;; verify that the record number is within range
+ ;; Verify that the record number is within range.
(if (or (> arg forms--total-records)
(<= arg 0))
(progn
(beep)
- ;; don't give the message if just paging
+ ;; Don't give the message if just paging.
(if (not relative)
(message "Record number %d out of range 1..%d"
arg forms--total-records))
)
- ;; flush
+ ;; Flush.
(forms--checkmod)
- ;; calculate displacement
+ ;; Calculate displacement.
(let ((disp (- arg forms--current-record))
(cur forms--current-record))
- ;; forms--show-record needs it now
+ ;; `forms--show-record' needs it now.
(setq forms--current-record arg)
- ;; get the record and show it
+ ;; Get the record and show it.
(forms--show-record
(save-excursion
(set-buffer forms--file-buffer)
(beginning-of-line)
- ;; move, and adjust the amount if needed (shouldn't happen)
+ ;; Move, and adjust the amount if needed (shouldn't happen).
(if relative
(if (zerop disp)
nil
(forms--get-record)))
- ;; this shouldn't happen
+ ;; This shouldn't happen.
(if (/= forms--current-record cur)
(progn
(setq forms--current-record cur)
(beep)
- (message "Stuck at record %d." cur))))))
+ (message "Stuck at record %d" cur))))))
(defun forms-first-record ()
"Jump to first record."
(forms-jump-record 1))
(defun forms-last-record ()
- "Jump to last record. As a side effect: re-calculates the number
- of records in the data file."
+ "Jump to last record.
+As a side effect: re-calculates the number of records in the data file."
(interactive)
(let
((numrec
nil
(beep)
(setq forms--total-records numrec)
- (message "Number of records reset to %d." forms--total-records)))
+ (message "Warning: number of records changed to %d" forms--total-records)))
(forms-jump-record forms--total-records))
-
-;;;\f
+\f
;;; Other commands
-(defun forms-view-mode ()
- "Visit buffer read-only."
- (interactive)
- (if forms-read-only
- nil
- (forms--checkmod) ; sync
- (setq forms-read-only t)
- (forms-mode)))
-(defun forms-edit-mode ()
- "Make form suitable for editing, if possible."
- (interactive)
- (let ((ro forms-read-only))
- (if (save-excursion
- (set-buffer forms--file-buffer)
- buffer-read-only)
- (progn
- (setq forms-read-only t)
- (message "No write access to \"%s\"" forms-file)
- (beep))
- (setq forms-read-only nil))
- (if (equal ro forms-read-only)
+(defun forms-toggle-read-only (arg)
+ "Toggles read-only mode of a forms mode buffer.
+With an argument, enables read-only mode if the argument is positive.
+Otherwise enables edit mode if the visited file is writable."
+
+ (interactive "P")
+
+ (if (if arg
+ ;; Negative arg means switch it off.
+ (<= (prefix-numeric-value arg) 0)
+ ;; No arg means toggle.
+ forms-read-only)
+
+ ;; Enable edit mode, if possible.
+ (let ((ro forms-read-only))
+ (if (save-excursion
+ (set-buffer forms--file-buffer)
+ buffer-read-only)
+ (progn
+ (setq forms-read-only t)
+ (message "No write access to \"%s\"" forms-file)
+ (beep))
+ (setq forms-read-only nil))
+ (if (equal ro forms-read-only)
+ nil
+ (forms-mode)))
+
+ ;; Enable view mode.
+ (if forms-read-only
nil
+ (forms--checkmod) ; sync
+ (setq forms-read-only t)
(forms-mode))))
;; Sample:
;; (setq forms-new-record-filter 'my-new-record-filter)
(defun forms-insert-record (arg)
- "Create a new record before the current one. With ARG: store the
- record after the current one.
- If a function forms-new-record-filter is defined, or forms-new-record-filter
- contains the name of a function, it is called to
- fill (some of) the fields with default values."
- ; The above doc is not true, but for documentary purposes only
+ "Create a new record before the current one.
+With ARG: store the record after the current one.
+If `forms-new-record-filter' contains the name of a function,
+it is called to fill (some of) the fields with default values."
(interactive "P")
+ (if forms-read-only
+ (error ""))
+
(let ((ln (if arg (1+ forms--current-record) forms--current-record))
the-list the-record)
(forms--checkmod)
- (if forms--new-record-filter
+ (if forms-new-record-filter
;; As a service to the user, we add a zeroth element so she
;; can use the same indices as in the forms definition.
(let ((the-fields (make-vector (1+ forms-number-of-fields) "")))
- (setq the-fields (funcall forms--new-record-filter the-fields))
+ (setq the-fields (funcall forms-new-record-filter the-fields))
(setq the-list (cdr (append the-fields nil))))
(setq the-list (make-list forms-number-of-fields "")))
(forms-jump-record forms--current-record))
(defun forms-delete-record (arg)
- "Deletes a record. With ARG: don't ask."
+ "Deletes a record. With a prefix argument: don't ask."
(interactive "P")
+
+ (if forms-read-only
+ (error ""))
+
(forms--checkmod)
(if (or arg
(y-or-n-p "Really delete this record? "))
(save-excursion
(set-buffer forms--file-buffer)
(goto-line ln)
- (kill-line 1))
+ ;; Use delete-region instead of kill-region, to avoid
+ ;; adding junk to the kill-ring.
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (beginning-of-line 2) (point))))
(setq forms--total-records (1- forms--total-records))
(if (> forms--current-record forms--total-records)
(setq forms--current-record forms--total-records))
(forms-jump-record forms--current-record)))
(message ""))
-(defun forms-search (regexp)
- "Search REGEXP in file buffer."
+(defun forms-search-forward (regexp)
+ "Search forward for record containing REGEXP."
(interactive
- (list (read-string (concat "Search for"
+ (list (read-string (concat "Search forward for"
(if forms--search-regexp
(concat " ("
forms--search-regexp
(re-search-forward regexp nil t))))
(setq forms--search-regexp regexp))
-(defun forms-revert-buffer (&optional arg noconfirm)
+(defun forms-search-backward (regexp)
+ "Search backward for record containing REGEXP."
+ (interactive
+ (list (read-string (concat "Search backward for"
+ (if forms--search-regexp
+ (concat " ("
+ forms--search-regexp
+ ")"))
+ ": "))))
+ (if (equal "" regexp)
+ (setq regexp forms--search-regexp))
+ (forms--checkmod)
+
+ (let (the-line the-record here
+ (fld-sep forms-field-sep))
+ (if (save-excursion
+ (set-buffer forms--file-buffer)
+ (setq here (point))
+ (beginning-of-line)
+ (if (null (re-search-backward regexp nil t))
+ (progn
+ (goto-char here)
+ (message (concat "\"" regexp "\" not found."))
+ nil)
+ (setq the-record (forms--get-record))
+ (setq the-line (1+ (count-lines (point-min) (point))))))
+ (progn
+ (setq forms--current-record the-line)
+ (forms--show-record the-record)
+ (re-search-forward regexp nil t))))
+ (setq forms--search-regexp regexp))
+
+(defun forms-save-buffer (&optional args)
+ "Forms mode replacement for save-buffer.
+It saves the data buffer instead of the forms buffer.
+Calls `forms-write-file-filter' before writing out the data."
+ (interactive "p")
+ (forms--checkmod)
+ (let ((read-file-filter forms-read-file-filter))
+ (save-excursion
+ (set-buffer forms--file-buffer)
+ (let ((inhibit-read-only t))
+ (save-buffer args)
+ (if read-file-filter
+ (run-hooks 'read-file-filter))
+ (set-buffer-modified-p nil))))
+ t)
+
+(defun forms--revert-buffer (&optional arg noconfirm)
"Reverts current form to un-modified."
(interactive "P")
(if (or noconfirm
(let ((i 0)
(here (point))
there
- (cnt 0))
+ (cnt 0)
+ (inhibit-point-motion-hooks t))
(if (zerop arg)
(setq cnt 1)
(setq cnt (+ cnt arg)))
(if (catch 'done
- (while (< i forms--number-of-markers)
+ (while (< i (length forms--markers))
(if (or (null (setq there (aref forms--markers i)))
(<= there here))
nil
nil
(goto-char (aref forms--markers 0)))))
+(defun forms-prev-field (arg)
+ "Jump to ARG-th previous field."
+ (interactive "p")
+
+ (let ((i (length forms--markers))
+ (here (point))
+ there
+ (cnt 0)
+ (inhibit-point-motion-hooks t))
+
+ (if (zerop arg)
+ (setq cnt 1)
+ (setq cnt (+ cnt arg)))
+
+ (if (catch 'done
+ (while (> i 0)
+ (setq i ( 1- i))
+ (if (or (null (setq there (aref forms--markers i)))
+ (>= there here))
+ nil
+ (if (<= (setq cnt (1- cnt)) 0)
+ (progn
+ (goto-char there)
+ (throw 'done t))))))
+ nil
+ (goto-char (aref forms--markers (1- (length forms--markers)))))))
+
+(defun forms-print ()
+ "Send the records to the printer with 'print-buffer', one record per page."
+ (interactive)
+ (let ((inhibit-read-only t)
+ (save-record forms--current-record)
+ (nb-record 1)
+ (record nil))
+ (while (<= nb-record forms--total-records)
+ (forms-jump-record nb-record)
+ (setq record (buffer-string))
+ (save-excursion
+ (set-buffer (get-buffer-create "*forms-print*"))
+ (goto-char (buffer-end 1))
+ (insert record)
+ (setq buffer-read-only nil)
+ (if (< nb-record forms--total-records)
+ (insert "\n\f\n")))
+ (setq nb-record (1+ nb-record)))
+ (save-excursion
+ (set-buffer "*forms-print*")
+ (print-buffer)
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer)))
+ (forms-jump-record save-record)))
+
;;;
;;; Special service
;;;
(defun forms-enumerate (the-fields)
- "Take a quoted list of symbols, and set their values to the numbers
-1, 2 and so on. Returns the higest number.
+ "Take a quoted list of symbols, and set their values to sequential numbers.
+The first symbol gets number 1, the second 2 and so on.
+It returns the highest number.
Usage: (setq forms-number-of-fields
(forms-enumerate
(setq the-fields (cdr-safe the-fields))
(set el the-index)))
the-index))
-
-;;;\f
+\f
;;; Debugging
-;;;
+
(defvar forms--debug nil
"*Enables forms-mode debugging if not nil.")
(defun forms--debug (&rest args)
- "Internal - debugging routine"
+ "Internal debugging routine."
(if forms--debug
(let ((ret nil))
(while args
"\n"))))))
(save-excursion
(set-buffer (get-buffer-create "*forms-mode debug*"))
+ (if (zerop (buffer-size))
+ (emacs-lisp-mode))
(goto-char (point-max))
(insert ret)))))
-;;; Local Variables:
-;;; eval: (headers)
-;;; eval: (setq comment-start ";;; ")
-;;; End:
+;;; forms.el ends here.
HCoop / bpt / emacs.git / blobdiff