Mercurial > emacs
changeset 276:e7eb71cbf478
Initial revision
author | Brian Preble <rassilon@gnu.org> |
---|---|
date | Mon, 20 May 1991 20:35:19 +0000 |
parents | 9b41e1ed5e68 |
children | 3140f2aa89ae |
files | lisp/forms.el |
diffstat | 1 files changed, 1195 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/forms.el Mon May 20 20:35:19 1991 +0000 @@ -0,0 +1,1195 @@ +;;; Forms Mode - A GNU Emacs Major Mode ; @(#)@ forms 1.2.2 +;;; Created 1989 - Johan Vromans <jv@mh.nl> +;;; See the docs for a list of other contributors. +;;; +;;; 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. +;;; + +(provide 'forms-mode) + +;;; 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 +;;; 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 +;;; controls if forms-mode has been enabled in a buffer. +;;; +;;; === How it works === +;;; +;;; Forms mode means visiting a data file which is supposed to consist +;;; of records each containing a number of fields. The records are +;;; separated by a newline, the fields are separated by a user-defined +;;; field 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 +;;; time. +;;; +;;; Forms mode is a composite mode. It involves two files, and two +;;; buffers. +;;; The first file, called the control file, defines the name of the +;;; data file and the forms format. This file buffer will be used to +;;; present the forms. +;;; The second file holds the actual data. The buffer of this file +;;; will be buried, for it is never accessed directly. +;;; +;;; Forms mode is invoked using "forms-find-file control-file". +;;; Alternativily 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. +;;; +;;; The control file is visited, evaluated using +;;; eval-current-buffer, and should set at least the following +;;; variables: +;;; +;;; forms-file [string] the name of the data file. +;;; +;;; forms-number-of-fields [integer] +;;; The number of fields in each record. +;;; +;;; forms-format-list [list] formatting instructions. +;;; +;;; The forms-format-list should be a list, each element containing +;;; +;;; - either a string, e.g. "hello" (which is inserted \"as is\"), +;;; +;;; - an integer, denoting a field number. The contents of the field +;;; are inserted at this point. +;;; The first field has number one. +;;; +;;; Optional variables which may be set in the control file: +;;; +;;; forms-field-sep [string, default TAB] +;;; The field separator used to separate the +;;; fields in the data file. It may be a string. +;;; +;;; forms-read-only [bool, default nil] +;;; 't' means that the data file is visited read-only. +;;; If no write access to the data file is +;;; possible, read-only mode is enforced. +;;; +;;; forms-multi-line [string, default "^K"] +;;; If non-null the records of the data file may +;;; contain fields which 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. +;;; +;;; 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 t] +;;; If non-nil: redefine beginning/end-of-buffer +;;; to performs forms-first/last-field if in +;;; forms mode. +;;; +;;; forms-new-record-filter [function, no default] +;;; If defined: this function is called when a new +;;; record is created. It can be used to fill in +;;; the new record with default fields, for example. +;;; +;;; 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. +;;; Great malfunctioning may be expected if this file/buffer is modified +;;; outside of this package while it's 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 build upon startup to format +;;; the records. +;;; +;;; 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 build 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. +;;; +;;; Other functions are: +;;; +;;; paging (forward, backward) by record +;;; jumping (first, last, random number) +;;; searching +;;; creating and deleting records +;;; reverting the form (NOT the file buffer) +;;; switching edit <-> view mode v.v. +;;; jumping from field to field +;;; +;;; As an documented side-effect: jumping to the last record in the +;;; 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. +;;; +;;; 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 +;;; +;;; 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. +;;; +;;; Function save-buffer is also wrapped to perform a sensible action. +;;; A revert-file-hook is defined to revert a forms to original. +;;; +;;; For convenience, TAB is always bound to forms-next-field, so you +;;; don't need the C-c prefix for this command. +;;; +;;; Global variables and constants + +(defconst forms-version "1.2.2" + "Version of forms-mode implementation") + +(defvar forms-forms-scrolls t + "If non-null: redefine scroll-up/down to be used with forms-mode.") + +(defvar forms-forms-jumps t + "If non-null: redefine beginning/end-of-buffer to be used with forms-mode.") + +(defvar forms-mode-hooks nil + "Hook functions to be run upon entering forms mode.") +;;; +;;; Mandatory variables - must be set by evaluating the control file + +(defvar forms-file nil + "Name of the file holding the data.") + +(defvar forms-format-list nil + "Formatting specifications: + +It should be a list, each element containing + + - either a string, e.g. "hello" (which is inserted \"as is\"), + + - an integer, denoting the number of a field which contents are + inserted at this point. + The first field has number one. +") + +(defvar forms-number-of-fields nil + "Number of fields per record.") + +;;; +;;; Optional variables with default values + +(defvar forms-field-sep "\t" + "Field separator character (default TAB)") + +(defvar forms-read-only nil + "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)") + +(defvar forms-forms-scroll t + "Redefine scroll-up/down to perform forms-next/prev-record when in + forms mode.") + +(defvar forms-forms-jump t + "Redefine beginning/end-of-buffer to perform forms-first/last-record + when in forms mode.") + +;;; +;;; Internal variables. + +(defvar forms--file-buffer nil + "Buffer which holds the file data") + +(defvar forms--total-records 0 + "Total number of records in the data file.") + +(defvar forms--current-record 0 + "Number of the record currently on the screen.") + +(defvar forms-mode-map nil ; yes - this one is global + "Keymap for form buffer.") + +(defvar forms--markers nil + "Field markers in the screen.") + +(defvar forms--number-of-markers 0 + "Number of fields on 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.") + +(defvar forms--format nil + "Formatting routine.") + +(defvar forms--parser nil + "Forms parser routine.") + +(defvar forms--mode-setup nil + "Internal - keeps 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.") + +;;; +;;; 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. + +(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}" + + (interactive) ; no - 'primary' is not prefix arg + + ;; Primary set-up: evaluate buffer and check if the mandatory + ;; variables have been set. + (if (or primary (not forms--mode-setup)) + (progn + (kill-all-local-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-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) + + ;; eval the buffer, should set variables + (eval-current-buffer) + + ;; 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")) + (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"))) + + ;; validate and process forms-format-list + (make-local-variable 'forms--number-of-markers) + (make-local-variable 'forms--markers) + (forms--process-format-list) + + ;; build the formatter and parser + (make-local-variable 'forms--format) + (forms--make-format) + (make-local-variable 'forms--parser) + (forms--make-parser) + + ;; check if a new record filter was defined + (make-local-variable 'forms--new-record-filter) + (setq forms--new-record-filter + (and (fboundp 'forms-new-record-filter) + (symbol-function 'forms-new-record-filter))) + (fmakunbound 'forms-new-record-filter) + + + ;; prepare this buffer for further processing + (setq buffer-read-only nil) + + ;; prevent accidental overwrite of the control file and autosave + (setq buffer-file-name nil) + (auto-save-mode nil) + + ;; and clean it + (erase-buffer))) + + ;; make 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) + + ;; 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) + (if forms-mode-map ; already defined + nil + (setq forms-mode-map (make-keymap)) + (forms--mode-commands forms-mode-map) + (forms--change-commands)) + + ;; find the data file + (setq forms--file-buffer (find-file-noselect forms-file)) + + ;; 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)))) + (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) + (forms--set-keymaps) + + (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) + + ;; user customising + (run-hooks 'forms-mode-hooks) + + ;; be helpful + (forms--help) + + ;; initialization done + (setq forms--mode-setup t)) + +;;; +;;; forms-process-format-list +;;; +;;; Validates forms-format-list. +;;; +;;; Sets forms--number-of-markers and forms--markers. + +(defun forms--process-format-list () + "Validate forms-format-list and set some global variables." + + ;; it must be non-nil + (or forms-format-list + (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")) + + (setq forms--number-of-markers 0) + + (let ((the-list forms-format-list) ; the list of format elements + (field-num 0)) ; highest field number + + (while the-list + + (let ((el (car-safe the-list)) + (rem (cdr-safe the-list))) + + (cond + + ;; try string ... + ((stringp el)) ; string is OK + + ;; try int ... + ((numberp el) ; check it + + (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))) + + ;; else + (t + (error "invalid element in 'forms-format-list': %s" + (prin1-to-string el))) + + ;; dead code - we'll need it in the future + ((consp el) ; check it + + (let ((str (car-safe el)) + (idx (cdr-safe el))) + + (cond + + ;; car must be string + ((not (stringp str)) + (error "forms error: car of cons %s must be string" + (prin1-to-string el))) + + ;; cdr must be number, > zero + ((or (not (numberp idx)) + (<= idx 0) + (> idx forms-number-of-fields)) + (error + "forms error: cdr of cons %s must be a number between 1 and %d" + (prin1-to-string el) + forms-number-of-fields))) + + ;; passed the test - handle it + (setq forms--number-of-markers (1+ forms--number-of-markers)) + (if (> idx field-num) + (setq field-num idx))))) + + ;; advance to next element of the list + (setq the-list rem)))) + + (setq forms--markers (make-vector forms--number-of-markers nil))) + + +;;; +;;; Build the format routine from forms-format-list. +;;; +;;; The format routine (forms--format) will look like +;;; +;;; (lambda (arg) +;;; +;;; ;; "text: " +;;; (insert "text: ") +;;; ;; 6 +;;; (aset forms--markers 0 (point-marker)) +;;; (insert (elt arg 5)) +;;; ;; "\nmore text: " +;;; (insert "\nmore text: ") +;;; ;; 9 +;;; (aset forms--markers 1 (point-marker)) +;;; (insert (elt arg 8)) +;;; +;;; ... ) +;;; + +(defun forms--make-format () + "Generate parser function for forms" + (setq forms--format (forms--format-maker forms-format-list))) + +(defun forms--format-maker (the-format-list) + "Returns the parser function for forms" + (let ((the-marker 0)) + (` (lambda (arg) + (,@ (apply 'append + (mapcar 'forms--make-format-elt + (forms--concat-adjacent the-format-list)))))))) + +(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)))))) + + +(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)) +;;; +;;; 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))) +;;; ... +;;; ... +;;; ;; final flush (due to terminator sentinel, see below) +;;; (aset the-recordv 7 (buffer-substring (point) (point-max))) +;;; + +(defun forms--make-parser () + "Generate parser function for forms" + (setq forms--parser (forms--parser-maker forms-format-list))) + +(defun forms--parser-maker (the-format-list) + "Returns the parser function for forms" + (let ((the-field nil) + (seen-text nil) + the--format-list) + ;; concat adjacent strings and add a terminator sentinel + (setq the--format-list + (append (forms--concat-adjacent 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--make-parser-elt (el) + (cond ((stringp el) + (prog1 + (if the-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 + (- (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))) + ((numberp el) + (if the-field + (error "Cannot parse adjacent fields %d and %d" + the-field el) + (setq the-field el) + nil)) + ((null el) + (if the-field + (` ((aset the-recordv (, (1- the-field)) + (buffer-substring (point) (point-max))))))))) +;;; + +(defun forms--set-minor-mode () + (setq minor-mode-alist + (if forms-read-only + " View" + nil))) + +(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) + ) +;;; +;;; 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." + ;; + ;; scroll-down -> forms-prev-record + ;; + (if (fboundp 'forms--scroll-down) + nil + (fset 'forms--scroll-down (symbol-function 'scroll-down)) + (fset 'scroll-down + '(lambda (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 (arg) + (interactive "P") + (if (and forms--mode-setup + forms-forms-scroll) + (forms-next-record arg) + (forms--scroll-up arg))))) + ;; + ;; 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 (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))))) + ;; + ) + +(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"))) + +(defun forms--trans (subj arg rep) + "Translate in SUBJ all chars ARG into char REP. ARG and REP should + be single-char strings." + (let ((i 0) + (x (length subj)) + (re (regexp-quote arg)) + (k (string-to-char rep))) + (while (setq i (string-match re subj i)) + (aset subj i k) + (setq i (1+ i))))) + +(defun forms--exit (query &optional save) + (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))) + (save-excursion + (set-buffer forms--file-buffer) + (delete-auto-save-file-if-necessary) + (kill-buffer (current-buffer))) + (if (get-buffer buf) ; not killed??? + (if save + (progn + (beep) + (message "Problem saving buffers?"))) + (delete-auto-save-file-if-necessary) + (kill-buffer (current-buffer))))) + +(defun forms--get-record () + "Fetch the current record from the 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)) + (goto-char here)))) + +(defun forms--show-record (the-record) + "Format THE-RECORD according to forms-format-list, + and display it in the current buffer." + + ;; 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) + (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 the-result + (append the-result (list ent))) + (setq start-pos (+ field-sep-length found-pos)))) + (setq forms--the-record-list the-result)) + + (setq buffer-read-only nil) + (erase-buffer) + + ;; 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 (< (length forms--the-record-list) forms-number-of-fields) + (setq forms--the-record-list + (append forms--the-record-list + (make-list + (- forms-number-of-fields + (length forms--the-record-list)) + ""))))) + + ;; call the formatter function + (funcall forms--format forms--the-record-list) + + ;; prepare + (goto-char (point-min)) + (set-buffer-modified-p nil) + (setq buffer-read-only forms-read-only) + (setq mode-line-process + (concat " " forms--current-record "/" forms--total-records))) + +(defun forms--parse-form () + "Parse contents of form into list of strings." + ;; 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 + ;; fields which were not in the form are not modified. + ;; Finally, the vector is transformed into a list for further processing. + + (let (the-recordv) + + ;; build the vector + (setq the-recordv (vconcat forms--the-record-list)) + + ;; parse the form and update the vector + (funcall forms--parser) + + ;; transform to a list and return + (append the-recordv nil))) + +(defun forms--update () + "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 + (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 forms-multi-line + (forms--trans the-record "\n" forms-multi-line)) + + ;; a final sanity check before updating + (if (string-match "\n" the-record) + (progn + (message "Multi-line fields in this record - update refused!") + (beep)) + + (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) + (insert the-record) + (beginning-of-line)))))) + +(defun forms--checkmod () + "Check if this form has been modified, and call forms--update if so." + (if (buffer-modified-p nil) + (let ((here (point))) + (forms--update) + (set-buffer-modified-p nil) + (goto-char here)))) + +;;; +;;; Start and exit +(defun forms-find-file (fn) + "Visit file FN in forms mode" + (interactive "fForms file: ") + (find-file-read-only fn) + (or forms--mode-setup (forms-mode t))) + +(defun forms-find-file-other-window (fn) + "Visit file FN in form 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))) + +(defun forms-exit (query) + "Normal exit. Modified buffers are saved." + (interactive "P") + (forms--exit query t)) + +(defun forms-exit-no-save (query) + "Exit without saving buffers." + (interactive "P") + (forms--exit query nil)) + +;;; +;;; Navigating commands + +(defun forms-next-record (arg) + "Advance to the ARGth following record." + (interactive "P") + (forms-jump-record (+ forms--current-record (prefix-numeric-value arg)) t)) + +(defun forms-prev-record (arg) + "Advance to the ARGth previous record." + (interactive "P") + (forms-jump-record (- forms--current-record (prefix-numeric-value arg)) t)) + +(defun forms-jump-record (arg &optional relative) + "Jump to a random record." + (interactive "NRecord number: ") + + ;; 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 + (if (not relative) + (message "Record number %d out of range 1..%d" + arg forms--total-records)) + ) + + ;; flush + (forms--checkmod) + + ;; calculate displacement + (let ((disp (- arg forms--current-record)) + (cur forms--current-record)) + + ;; forms--show-record needs it now + (setq forms--current-record arg) + + ;; 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) + (if relative + (if (zerop disp) + nil + (setq cur (+ cur disp (- (forward-line disp))))) + (setq cur (+ cur disp (- (goto-line arg))))) + + (forms--get-record))) + + ;; this shouldn't happen + (if (/= forms--current-record cur) + (progn + (setq forms--current-record cur) + (beep) + (message "Stuck at record %d." cur)))))) + +(defun forms-first-record () + "Jump to first record." + (interactive) + (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." + (interactive) + (let + ((numrec + (save-excursion + (set-buffer forms--file-buffer) + (count-lines (point-min) (point-max))))) + (if (= numrec forms--total-records) + nil + (beep) + (setq forms--total-records numrec) + (message "Number of records reset to %d." forms--total-records))) + (forms-jump-record forms--total-records)) + +;;; +;;; 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) + nil + (forms-mode)))) + +;; Sample: +;; (defun forms-new-record-filter (the-fields) +;; ;; numbers are relative to 1 +;; (aset the-fields 4 (current-time-string)) +;; (aset the-fields 6 (user-login-name)) +;; the-list) + +(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, is is called to + fill (some of) the fields with default values." + ; The above doc is not true, but for documentary purposes only + + (interactive "P") + + (let ((ln (if arg (1+ forms--current-record) forms--current-record)) + the-list the-record) + + (forms--checkmod) + (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-list (cdr (append the-fields nil)))) + (setq the-list (make-list forms-number-of-fields ""))) + + (setq the-record + (mapconcat + 'identity + the-list + forms-field-sep)) + + (save-excursion + (set-buffer forms--file-buffer) + (goto-line ln) + (open-line 1) + (insert the-record) + (beginning-of-line)) + + (setq forms--current-record ln)) + + (setq forms--total-records (1+ forms--total-records)) + (forms-jump-record forms--current-record)) + +(defun forms-delete-record (arg) + "Deletes a record. With ARG: don't ask." + (interactive "P") + (forms--checkmod) + (if (or arg + (y-or-n-p "Really delete this record? ")) + (let ((ln forms--current-record)) + (save-excursion + (set-buffer forms--file-buffer) + (goto-line ln) + (kill-line 1)) + (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." + (interactive + (list (read-string (concat "Search 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)) + (end-of-line) + (if (null (re-search-forward 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-revert-buffer (&optional arg noconfirm) + "Reverts current form to un-modified." + (interactive "P") + (if (or noconfirm + (yes-or-no-p "Revert form to unmodified? ")) + (progn + (set-buffer-modified-p nil) + (forms-jump-record forms--current-record)))) + +(defun forms-next-field (arg) + "Jump to ARG-th next field." + (interactive "p") + + (let ((i 0) + (here (point)) + there + (cnt 0)) + + (if (zerop arg) + (setq cnt 1) + (setq cnt (+ cnt arg))) + + (if (catch 'done + (while (< i forms--number-of-markers) + (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)))) + (setq i (1+ i)))) + nil + (goto-char (aref forms--markers 0)))))