(provide (quote forms)) (provide (quote forms-mode)) (defconst forms-version "1.2.9" "\ 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.") (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.") (defvar forms-field-sep " " "\ 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 " " "\ 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.") (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 "\ 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 (quote 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.") (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) (byte-code " ? !!!!!!!!! :! B! VW!W ;W! x ;e G=u \"r!x!!! ! ! !!K!!!!!K! ! !!!ˉ ˉ ! !!!!! ˂!   ! !qp! ed\")M҉)!@ A B!!CWD!EF!G ҉" [primary forms--mode-setup forms-file forms-number-of-fields forms-field-sep forms-multi-line forms--new-record-filter forms-new-record-filter forms--modified-record-filter forms-modified-record-filter buffer-read-only nil buffer-file-name forms-mode-map forms--file-buffer ro forms--total-records forms-read-only t major-mode mode-name revert-buffer-function forms--current-record kill-all-local-variables make-local-variable forms-format-list forms-forms-scroll forms-forms-jump fmakunbound eval-current-buffer error "'forms-file' has not been set" "'forms-number-of-fields' has not been set" 0 "'forms-number-of-fields' must be > 0" "'forms-field-sep' is not a string" 1 string= "'forms-multi-line' is equal to 'forms-field-sep'" "'forms-multi-line' must be nil or a one-character string" forms--number-of-markers forms--markers forms--process-format-list forms--format forms--make-format forms--parser forms--make-parser fboundp boundp forms--dynamic-text forms-fields auto-save-mode erase-buffer forms--the-record-list forms--search-rexexp make-keymap forms--mode-commands forms--change-commands find-file-noselect bury-buffer count-lines forms-mode "Forms" minor-mode-alist forms--set-minor-mode forms--set-keymaps set-buffer-modified-p forms-revert-buffer forms-jump-record run-hooks forms-mode-hooks forms--help] 60)) (defun forms--process-format-list nil "\ Validate forms-format-list and set some global variables." (byte-code "\" !<!Љʼn ! !9<!F!;!~X`Vj# T V{<!!!!\"!\"C#*$+\"!# \" " [forms-format-list forms--number-of-markers the-list this-item field-num nil el rem forms-number-of-fields t forms--markers forms--debug "forms-forms-list before 1st pass: " error "'forms-format-list' has not been set" "'forms-format-list' is not a list" 0 car-safe cdr-safe boundp eval numberp "Forms error: field number %d out of range 1..%d" fboundp "Forms error: not a function: %s" prin1-to-string "Invalid element in 'forms-format-list': %s" append "forms-forms-list after 1st pass: " forms--concat-adjacent "forms-forms-list after 2nd pass: " make-vector] 23)) (defun forms--make-format nil "\ Generate format function for forms" (byte-code " !!" [forms--format forms-format-list forms--format-maker forms--debug] 3)) (defun forms--format-maker (the-format-list) "\ Returns the parser function for forms" (byte-code " \"\"\")" [the-marker the-format-list 0 append (lambda (arg) (setq forms--dynamic-text nil)) apply mapcar forms--make-format-elt] 7)) (defun forms--make-format-elt (el) (byte-code "; DC5!' FSEDD T5<5DCFC" [el the-marker insert numberp aset forms--markers (point-marker) elt arg let the-dyntext (insert the-dyntext) (setq forms--dynamic-text (append forms--dynamic-text (list the-dyntext)))] 6)) (defun forms--concat-adjacent (the-list) "\ Concatenate adjacent strings in the-list and return the resulting list" (byte-code ":)A!@; @;!@ @P AB%@ B)*" [the-list the-rest forms--concat-adjacent] 3)) (defun forms--make-parser nil "\ Generate parser function for forms" (byte-code " !!" [forms--parser forms-format-list forms--parser-maker forms--debug] 3)) (defun forms--parser-maker (the-format-list) "\ Returns the parser function for forms" (byte-code " C\" \"\"\"E+" [the-field seen-text the--format-list the-format-list nil append lambda (let (here) (goto-char (point-min))) apply mapcar forms--make-parser-elt] 10)) (defun forms--make-parser-elt (el) (byte-code ";F )C#DEE SGEEFE;!DDEEGDDÉĉ!` X #]Ă?s p SFC< SF%CÉĉ" [el the-field seen-text t nil (setq here (point)) if not append (search-forward) (nil t nil) error "Parse error: cannot find \"%s\"" aset the-recordv buffer-substring here - (point) looking-at regexp-quote "Parse error: not looking at \"%s\"" forward-char numberp "Cannot parse adjacent fields %d and %d" (buffer-substring (point) (point-max)) list 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)) (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))))] 12)) (defun forms--set-minor-mode nil (setq minor-mode-alist (if forms-read-only " View" nil))) (defun forms--set-keymaps nil "\ Set the keymaps used in this mode." (byte-code " ! ! # #" [forms-read-only forms-mode-map use-local-map make-sparse-keymap define-key current-local-map "" " " forms-next-field] 10)) (defun forms--mode-commands (map) "\ Fill map with all commands." (byte-code "################# ## #" [map ctl-x-map help-map define-key " " forms-next-field " " forms-next-record "d" forms-delete-record "e" forms-edit-mode "i" forms-insert-record "j" forms-jump-record "n" "p" forms-prev-record "q" forms-exit "s" forms-search "v" forms-view-mode "x" forms-exit-no-save "<" forms-first-record ">" forms-last-record "?" describe-mode "" "" ESC-prefix "" "" universal-argument ""] 23)) (defun forms--change-commands nil "\ Localize some commands." (byte-code "! KMM!%KMM!08KMM!CKKMM!V^KMM" [nil fboundp forms--scroll-down scroll-down (lambda (&optional arg) (interactive "P") (if (and forms--mode-setup forms-forms-scroll) (forms-prev-record arg) (forms--scroll-down arg))) forms--scroll-up scroll-up (lambda (&optional arg) (interactive "P") (if (and forms--mode-setup forms-forms-scroll) (forms-next-record arg) (forms--scroll-up arg))) forms--beginning-of-buffer beginning-of-buffer (lambda nil (interactive) (if (and forms--mode-setup forms-forms-jump) (forms-first-record) (forms--beginning-of-buffer))) forms--end-of-buffer end-of-buffer (lambda nil (interactive) (if (and forms--mode-setup forms-forms-jump) (forms-last-record) (forms--end-of-buffer))) forms--save-buffer 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)))] 7)) (defun forms--help nil "\ Initial help." (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." (byte-code " G !! #%  IT," [i x subj re arg k rep 0 regexp-quote string-to-char string-match] 7)) (defun forms--exit (query &optional save) (byte-code " !  ! q ) q p!)!8 5 !> p!)" [buf forms--file-buffer save buffer-name forms--checkmod buffer-modified-p save-buffer delete-auto-save-file-if-necessary kill-buffer get-buffer beep message "Problem saving buffers?"] 12)) (defun forms--get-record nil "\ Fetch the current record from the file buffer." (byte-code "n!` `\" b)" [nil here beginning-of-line end-of-line buffer-substring] 5)) (defun forms--show-record (the-record) "\ Format THE-RECORD according to forms-format-list, and display it in the current buffer." (byte-code " G  # P  #A OC\" \\),ʉ G U]ʂ G #G W GZ\"\"C#  \"eb! R" [the-result start-pos found-pos field-sep-length forms-field-sep forms-multi-line the-record ent forms--the-record-list buffer-read-only nil forms-number-of-fields forms-fields forms--format forms-read-only mode-line-process forms--current-record forms--total-records 0 forms--trans " " string-match append erase-buffer beep message "Record has %d fields instead of %d." make-list "" funcall set-buffer-modified-p " " "/"] 15)) (defun forms--parse-form nil "\ Parse contents of form into list of strings." (byte-code " !  !) (\" \" \"A),\")" [the-recordv forms--the-record-list forms--dynamic-text forms--parser forms--modified-record-filter the-fields nil vconcat funcall [nil] append] 8)) (defun forms--update nil "\ Update current record with contents of form. As a side effect: sets forms--the-record-list ." (byte-code " ! K  # % # \"6! J qc ! c ))" [forms-read-only the-record forms--the-record-list forms-field-sep forms-multi-line forms--file-buffer nil message "Read-only buffer!" beep forms--parse-form mapconcat identity forms--trans " " string-match "Multi-line fields in this record - update refused!" "*" beginning-of-line kill-line] 12)) (defun forms--checkmod nil "\ Check if this form has been modified, and call forms--update if so." (byte-code "!` ! b)" [nil here buffer-modified-p forms--update set-buffer-modified-p] 4)) (defun forms-find-file (fn) "\ Visit file FN in forms mode" (interactive "fForms file: ") (byte-code "! !" [fn forms--mode-setup t find-file-read-only forms-mode] 3)) (defun forms-find-file-other-window (fn) "\ Visit file FN in form mode in other window" (interactive "fFbrowse file in other window: ") (byte-code "! !" [fn forms--mode-setup t find-file-other-window eval-current-buffer forms-mode] 4)) (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)) (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: ") (byte-code " V X ? #p  Z ͊q M !@ǂJ ![#W ![# )! \"o  \"*" [arg forms--total-records relative disp forms--current-record cur forms--file-buffer nil 0 beep message "Record number %d out of range 1..%d" forms--checkmod forms--show-record beginning-of-line zerop + forward-line goto-line forms--get-record /= "Stuck at record %d."] 16)) (defun forms-first-record nil "\ Jump to first record." (interactive) (forms-jump-record 1)) (defun forms-last-record nil "\ Jump to last record. As a side effect: re-calculates the number of records in the data file." (interactive) (byte-code " qed\") UÂ  \") !" [numrec forms--file-buffer forms--total-records nil count-lines beep message "Number of records reset to %d." forms-jump-record] 5)) (defun forms-view-mode nil "\ Visit buffer read-only." (interactive) (byte-code " ‰ " [forms-read-only nil t forms--checkmod forms-mode] 3)) (defun forms-edit-mode nil "\ Make form suitable for editing, if possible." (interactive) (byte-code "  q )ĉ \" Ɖ \"(Ƃ* )" [ro forms-read-only forms--file-buffer buffer-read-only t forms-file nil message "No write access to \"%s\"" beep equal forms-mode] 5)) (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." (interactive "P") (byte-code " T  3T\" \"\"A):\"  # q!! c )+ T !" [ln arg forms--current-record the-list the-record forms--new-record-filter the-fields forms-number-of-fields nil forms-field-sep forms--file-buffer forms--total-records forms--checkmod make-vector "" funcall append make-list mapconcat identity goto-line open-line 1 beginning-of-line forms-jump-record] 11)) (defun forms-delete-record (arg) "\ Deletes a record. With ARG: don't ask." (interactive "P") (byte-code "  !/  q !!) S V*  !)!" [arg ln forms--current-record forms--file-buffer forms--total-records forms--checkmod y-or-n-p "Really delete this record? " goto-line kill-line 1 forms-jump-record message ""] 7)) (defun forms-search (regexp) "\ Search REGEXP in file buffer." (interactive (byte-code " QQ!C" [forms--search-regexp read-string "Search for" " (" ")" ": "] 5)) (byte-code "\"  q` #?: bQ!ȂF e`\"T)X  !#," [regexp forms--search-regexp the-line the-record here fld-sep forms-field-sep forms--file-buffer nil t forms--current-record equal "" forms--checkmod end-of-line re-search-forward message "\"" "\" not found." forms--get-record count-lines forms--show-record] 12)) (defun forms-revert-buffer (&optional arg noconfirm) "\ Reverts current form to un-modified." (interactive "P") (byte-code "!! !" [noconfirm nil forms--current-record yes-or-no-p "Revert form to unmodified? " set-buffer-modified-p forms-jump-record] 4)) (defun forms-next-field (arg) "\ Jump to ARG-th next field." (interactive "p") (byte-code "` !ɉ \\ˍ$ł)Hb," [i here there cnt arg nil forms--markers 0 zerop 1 done (byte-code " W4 H? Xł+SX+ b\"T" [i forms--number-of-markers there forms--markers here nil cnt t 0 throw done] 4)] 4)) (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 ...)))" (byte-code " T ! ! L))" [the-index the-fields el 0 car-safe cdr-safe] 5)) (defvar forms--debug nil "\ *Enables forms-mode debugging if not nil.") (defun forms--debug (&rest args) "\ Internal - debugging routine" (byte-code "i [ ! ! ;! PV !Q !@ ! !Q)F Q !V K!Q)!qdb c))" [forms--debug ret args el vel nil car-safe cdr-safe prin1-to-string " = " boundp eval " " "" fboundp get-buffer-create "*forms-mode debug*"] 12))