;;; 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.;;;;;; 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.(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;;;;;; - 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.;;;;;; - 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.;;;;;; 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 [symbol, no default];;; If defined: this should be the name of a ;;; function that is called when a new;;; record is created. It can be used to fill in;;; the new record with default fields, for example.;;; 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 ;;; function that is called when a record has;;; been modified. It is called after the fields;;; are parsed. It can be used to register;;; modification dates, for example.;;; Instead of the name of the function, it may;;; be the function itself.;;;;;; 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 built 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 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.;;;;;; 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.7" "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 "List of formatting specifications.")(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.")(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.")(defvar forms-fields nil "List with fields of the current forms. First field has number 1.");;;;;; 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 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) (make-local-variable 'forms-fields) ;; 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." (forms--debug "forms-forms-list before 1st pass:\n" 'forms-format-list) ;; 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 (this-item 0) ; element in list (field-num 0)) ; highest field number (setq forms-format-list nil) ; gonna rebuild (while the-list (let ((el (car-safe the-list)) (rem (cdr-safe the-list))) ;; 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 ... ((numberp el) (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 ((listp el) (or (fboundp (car-safe el)) (error "Forms error: not a function: %s" (prin1-to-string (car-safe el))))) ;; else (t (error "Invalid element in 'forms-format-list': %s" (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))))) (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) (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);;; (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));;;;;; ... );;; (defun forms--make-format () "Generate format function for forms" (setq forms--format (forms--format-maker forms-format-list)) (forms--debug 'forms--format))(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)))))))(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))))) ))) ))(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)));;;;;; ;; (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)));;; (defun forms--make-parser () "Generate parser function for forms" (setq forms--parser (forms--parser-maker forms-format-list)) (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--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))))))) ((listp el) (prog1 (if the-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))) ));;;(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 (&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))))) ;; ;; 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 (setq forms-fields (append (list nil) forms--the-record-list nil)) (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 (let ((forms--dynamic-text forms--dynamic-text)) (funcall forms--parser)) (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)) (cdr (append the-fields nil))) ;; transform to a list and return (append the-recordv nil))))(defun forms--update () "Update current record with contents of form. As a side effect: setsforms--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 my-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);; (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 (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)))));;;;;; Special service;;;(defun forms-enumerate (the-fields) "Take a quoted list of symbols, and set their values to the numbers1, 2 and so on. Returns the higest number.Usage: (setq forms-number-of-fields (forms-enumerate '(field1 field2 field2 ...)))" (let ((the-index 0)) (while the-fields (setq the-index (1+ the-index)) (let ((el (car-safe the-fields))) (setq the-fields (cdr-safe the-fields)) (set el the-index))) the-index));;;;;; Debugging;;;(defvar forms--debug nil "*Enables forms-mode debugging if not nil.")(defun forms--debug (&rest args) "Internal - debugging routine" (if forms--debug (let ((ret nil)) (while args (let ((el (car-safe args))) (setq args (cdr-safe args)) (if (stringp el) (setq ret (concat ret el)) (setq ret (concat ret (prin1-to-string el) " = ")) (if (boundp el) (let ((vel (eval el))) (setq ret (concat ret (prin1-to-string vel) "\n"))) (setq ret (concat ret "<unbound>" "\n"))) (if (fboundp el) (setq ret (concat ret (prin1-to-string (symbol-function el)) "\n")))))) (save-excursion (set-buffer (get-buffer-create "*forms-mode debug*")) (goto-char (point-max)) (insert ret)))));;; Local Variables:;;; eval: (headers);;; eval: (setq comment-start ";;; ");;; End: