Mercurial > emacs
view lisp/forms.el @ 695:e3fac20d3015
*** empty log message ***
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 07 Jun 1992 02:36:01 +0000 |
parents | 7fede845e304 |
children | 994bb6dc9249 |
line wrap: on
line source
;;; 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: 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 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 numbers 1, 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: