1 |
;;; forms.el --- Forms mode: edit a file as a form to fill in |
;;; forms.el --- Forms mode: edit a file as a form to fill in |
2 |
|
|
3 |
;; Copyright (C) 1991, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. |
;; Copyright (C) 1991, 1994, 1995, 1996, 1997, 2003 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Johan Vromans <jvromans@squirrel.nl> |
;; Author: Johan Vromans <jvromans@squirrel.nl> |
6 |
|
|
31 |
;; Names which start with 'forms--' are intended for internal use, and |
;; Names which start with 'forms--' are intended for internal use, and |
32 |
;; should *NOT* be used from the outside. |
;; should *NOT* be used from the outside. |
33 |
;; |
;; |
34 |
;; All variables are buffer-local, to enable multiple forms visits |
;; All variables are buffer-local, to enable multiple forms visits |
35 |
;; simultaneously. |
;; simultaneously. |
36 |
;; Variable `forms--mode-setup' is local to *ALL* buffers, for it |
;; Variable `forms--mode-setup' is local to *ALL* buffers, for it |
37 |
;; controls if forms-mode has been enabled in a buffer. |
;; controls if forms-mode has been enabled in a buffer. |
38 |
;; |
;; |
39 |
;; === How it works === |
;; === How it works === |
60 |
;; You may also visit the control file, and switch to forms mode by hand |
;; You may also visit the control file, and switch to forms mode by hand |
61 |
;; with M-x `forms-mode'. |
;; with M-x `forms-mode'. |
62 |
;; |
;; |
63 |
;; Automatic mode switching is supported if you specify |
;; Automatic mode switching is supported if you specify |
64 |
;; "-*- forms -*-" in the first line of the control file. |
;; "-*- forms -*-" in the first line of the control file. |
65 |
;; |
;; |
66 |
;; The control file is visited, evaluated using `eval-current-buffer', |
;; The control file is visited, evaluated using `eval-current-buffer', |
67 |
;; and should set at least the following variables: |
;; and should set at least the following variables: |
68 |
;; |
;; |
79 |
;; |
;; |
80 |
;; - a string, e.g. "hello". The string is inserted in the forms |
;; - a string, e.g. "hello". The string is inserted in the forms |
81 |
;; "as is". |
;; "as is". |
82 |
;; |
;; |
83 |
;; - an integer, denoting a field number. |
;; - an integer, denoting a field number. |
84 |
;; The contents of this field are inserted at this point. |
;; The contents of this field are inserted at this point. |
85 |
;; Fields are numbered starting with number one. |
;; Fields are numbered starting with number one. |
86 |
;; |
;; |
87 |
;; - a function call, e.g. (insert "text"). |
;; - a function call, e.g. (insert "text"). |
88 |
;; This function call is dynamically evaluated and should return a |
;; This function call is dynamically evaluated and should return a |
89 |
;; string. It should *NOT* have side-effects on the forms being |
;; string. It should *NOT* have side-effects on the forms being |
90 |
;; constructed. The current fields are available to the function |
;; constructed. The current fields are available to the function |
91 |
;; in the variable `forms-fields', they should *NOT* be modified. |
;; in the variable `forms-fields', they should *NOT* be modified. |
92 |
;; |
;; |
93 |
;; - a lisp symbol, that must evaluate to one of the above. |
;; - a lisp symbol, that must evaluate to one of the above. |
94 |
;; |
;; |
95 |
;; Optional variables which may be set in the control file: |
;; Optional variables which may be set in the control file: |
102 |
;; Non-nil means that the data file is visited |
;; Non-nil means that the data file is visited |
103 |
;; read-only (view mode) as opposed to edit mode. |
;; read-only (view mode) as opposed to edit mode. |
104 |
;; If no write access to the data file is |
;; If no write access to the data file is |
105 |
;; possible, view mode is enforced. |
;; possible, view mode is enforced. |
106 |
;; |
;; |
107 |
;; forms-check-number-of-fields [bool, default t] |
;; forms-check-number-of-fields [bool, default t] |
108 |
;; If non-nil, a warning will be issued whenever |
;; If non-nil, a warning will be issued whenever |
138 |
;; first record. |
;; first record. |
139 |
;; |
;; |
140 |
;; forms-read-file-filter [symbol, default nil] |
;; forms-read-file-filter [symbol, default nil] |
141 |
;; If not nil: this should be the name of a |
;; If not nil: this should be the name of a |
142 |
;; function that is called after the forms data file |
;; function that is called after the forms data file |
143 |
;; has been read. It can be used to transform |
;; has been read. It can be used to transform |
144 |
;; the contents of the file into a format more suitable |
;; the contents of the file into a format more suitable |
145 |
;; for forms-mode processing. |
;; for forms-mode processing. |
146 |
;; |
;; |
147 |
;; forms-write-file-filter [symbol, default nil] |
;; forms-write-file-filter [symbol, default nil] |
148 |
;; If not nil: this should be the name of a |
;; If not nil: this should be the name of a |
149 |
;; function that is called before the forms data file |
;; function that is called before the forms data file |
150 |
;; is written (saved) to disk. It can be used to undo |
;; is written (saved) to disk. It can be used to undo |
151 |
;; the effects of `forms-read-file-filter', if any. |
;; the effects of `forms-read-file-filter', if any. |
152 |
;; |
;; |
153 |
;; forms-new-record-filter [symbol, default nil] |
;; forms-new-record-filter [symbol, default nil] |
154 |
;; If not nil: this should be the name of a |
;; If not nil: this should be the name of a |
155 |
;; function that is called when a new |
;; function that is called when a new |
156 |
;; record is created. It can be used to fill in |
;; record is created. It can be used to fill in |
157 |
;; the new record with default fields, for example. |
;; the new record with default fields, for example. |
158 |
;; |
;; |
159 |
;; forms-modified-record-filter [symbol, default nil] |
;; forms-modified-record-filter [symbol, default nil] |
160 |
;; If not nil: this should be the name of a |
;; If not nil: this should be the name of a |
161 |
;; function that is called when a record has |
;; function that is called when a record has |
162 |
;; been modified. It is called after the fields |
;; been modified. It is called after the fields |
163 |
;; are parsed. It can be used to register |
;; are parsed. It can be used to register |
199 |
;; Normal operation is to transfer one line (record) from the data file, |
;; Normal operation is to transfer one line (record) from the data file, |
200 |
;; split it into fields (into `forms--the-record-list'), and display it |
;; split it into fields (into `forms--the-record-list'), and display it |
201 |
;; using the specs in `forms-format-list'. |
;; using the specs in `forms-format-list'. |
202 |
;; A format routine `forms--format' is built upon startup to format |
;; A format routine `forms--format' is built upon startup to format |
203 |
;; the records according to `forms-format-list'. |
;; the records according to `forms-format-list'. |
204 |
;; |
;; |
205 |
;; When a form is changed the record is updated as soon as this form |
;; When a form is changed the record is updated as soon as this form |
236 |
;; contents of the buffer. |
;; contents of the buffer. |
237 |
;; |
;; |
238 |
;; Edit mode commands: |
;; Edit mode commands: |
239 |
;; |
;; |
240 |
;; TAB forms-next-field |
;; TAB forms-next-field |
241 |
;; \C-c TAB forms-next-field |
;; \C-c TAB forms-next-field |
242 |
;; \C-c < forms-first-record |
;; \C-c < forms-first-record |
251 |
;; \C-c \C-r forms-search-backward |
;; \C-c \C-r forms-search-backward |
252 |
;; \C-c \C-s forms-search-forward |
;; \C-c \C-s forms-search-forward |
253 |
;; \C-c \C-x forms-exit |
;; \C-c \C-x forms-exit |
254 |
;; |
;; |
255 |
;; Read-only mode commands: |
;; Read-only mode commands: |
256 |
;; |
;; |
257 |
;; SPC forms-next-record |
;; SPC forms-next-record |
258 |
;; DEL forms-prev-record |
;; DEL forms-prev-record |
259 |
;; ? describe-mode |
;; ? describe-mode |
264 |
;; r forms-search-backward |
;; r forms-search-backward |
265 |
;; s forms-search-forward |
;; s forms-search-forward |
266 |
;; x forms-exit |
;; x forms-exit |
267 |
;; |
;; |
268 |
;; Of course, it is also possible to use the \C-c prefix to obtain the |
;; Of course, it is also possible to use the \C-c prefix to obtain the |
269 |
;; same command keys as in edit mode. |
;; same command keys as in edit mode. |
270 |
;; |
;; |
271 |
;; The following bindings are available, independent of the mode: |
;; The following bindings are available, independent of the mode: |
272 |
;; |
;; |
273 |
;; [next] forms-next-record |
;; [next] forms-next-record |
274 |
;; [prior] forms-prev-record |
;; [prior] forms-prev-record |
275 |
;; [begin] forms-first-record |
;; [begin] forms-first-record |
368 |
|
|
369 |
(defvar forms-fields nil |
(defvar forms-fields nil |
370 |
"List with fields of the current forms. First field has number 1. |
"List with fields of the current forms. First field has number 1. |
371 |
This variable is for use by the filter routines only. |
This variable is for use by the filter routines only. |
372 |
The contents may NOT be modified.") |
The contents may NOT be modified.") |
373 |
|
|
374 |
(defcustom forms-use-text-properties t |
(defcustom forms-use-text-properties t |
417 |
(defvar forms--dyntexts nil |
(defvar forms--dyntexts nil |
418 |
"Dynamic texts (resulting from function calls) on the screen.") |
"Dynamic texts (resulting from function calls) on the screen.") |
419 |
|
|
420 |
(defvar forms--the-record-list nil |
(defvar forms--the-record-list nil |
421 |
"List of strings of the current record, as parsed from the file.") |
"List of strings of the current record, as parsed from the file.") |
422 |
|
|
423 |
(defvar forms--search-regexp nil |
(defvar forms--search-regexp nil |
445 |
(defvar forms--rw-face nil |
(defvar forms--rw-face nil |
446 |
"Face used to represent read-write data on the screen.") |
"Face used to represent read-write data on the screen.") |
447 |
|
|
448 |
;;;###autoload |
;;;###autoload |
449 |
(defun forms-mode (&optional primary) |
(defun forms-mode (&optional primary) |
450 |
"Major mode to visit files in a field-structured manner using a form. |
"Major mode to visit files in a field-structured manner using a form. |
451 |
|
|
452 |
Commands: Equivalent keys in read-only mode: |
Commands: Equivalent keys in read-only mode: |
453 |
TAB forms-next-field TAB |
TAB forms-next-field TAB |
454 |
C-c TAB forms-next-field |
C-c TAB forms-next-field |
455 |
C-c < forms-first-record < |
C-c < forms-first-record < |
456 |
C-c > forms-last-record > |
C-c > forms-last-record > |
457 |
C-c ? describe-mode ? |
C-c ? describe-mode ? |
510 |
(setq forms-new-record-filter nil) |
(setq forms-new-record-filter nil) |
511 |
(setq forms-modified-record-filter nil) |
(setq forms-modified-record-filter nil) |
512 |
|
|
513 |
;; If running Emacs 19 under X, setup faces to show read-only and |
;; If running Emacs 19 under X, setup faces to show read-only and |
514 |
;; read-write fields. |
;; read-write fields. |
515 |
(if (fboundp 'make-face) |
(if (fboundp 'make-face) |
516 |
(progn |
(progn |
521 |
;;(message "forms: processing control file...") |
;;(message "forms: processing control file...") |
522 |
;; If enable-local-eval is not set to t the user is asked first. |
;; If enable-local-eval is not set to t the user is asked first. |
523 |
(if (or (eq enable-local-eval t) |
(if (or (eq enable-local-eval t) |
524 |
(yes-or-no-p |
(yes-or-no-p |
525 |
(concat "Evaluate lisp code in buffer " |
(concat "Evaluate lisp code in buffer " |
526 |
(buffer-name) " to display forms "))) |
(buffer-name) " to display forms "))) |
527 |
(eval-current-buffer) |
(eval-current-buffer) |
529 |
|
|
530 |
;; Check if the mandatory variables make sense. |
;; Check if the mandatory variables make sense. |
531 |
(or forms-file |
(or forms-file |
532 |
(error (concat "Forms control file error: " |
(error (concat "Forms control file error: " |
533 |
"`forms-file' has not been set"))) |
"`forms-file' has not been set"))) |
534 |
|
|
535 |
;; Check forms-field-sep first, since it can be needed to |
;; Check forms-field-sep first, since it can be needed to |
554 |
(if (and (stringp forms-multi-line) |
(if (and (stringp forms-multi-line) |
555 |
(eq (length forms-multi-line) 1)) |
(eq (length forms-multi-line) 1)) |
556 |
(if (string= forms-multi-line forms-field-sep) |
(if (string= forms-multi-line forms-field-sep) |
557 |
(error (concat "Forms control file error: " |
(error (concat "Forms control file error: " |
558 |
"`forms-multi-line' is equal to 'forms-field-sep'"))) |
"`forms-multi-line' is equal to 'forms-field-sep'"))) |
559 |
(error (concat "Forms control file error: " |
(error (concat "Forms control file error: " |
560 |
"`forms-multi-line' must be nil or a one-character string")))) |
"`forms-multi-line' must be nil or a one-character string")))) |
561 |
(or (fboundp 'set-text-properties) |
(or (fboundp 'set-text-properties) |
562 |
(setq forms-use-text-properties nil)) |
(setq forms-use-text-properties nil)) |
563 |
|
|
564 |
;; Validate and process forms-format-list. |
;; Validate and process forms-format-list. |
565 |
;;(message "forms: pre-processing format list...") |
;;(message "forms: pre-processing format list...") |
566 |
(make-local-variable 'forms--elements) |
(make-local-variable 'forms--elements) |
699 |
(if (= forms--total-records 0) |
(if (= forms--total-records 0) |
700 |
;;(message "forms: proceeding setup (new file)...") |
;;(message "forms: proceeding setup (new file)...") |
701 |
(progn |
(progn |
702 |
(insert |
(insert |
703 |
"GNU Emacs Forms Mode version " forms-version "\n\n" |
"GNU Emacs Forms Mode version " forms-version "\n\n" |
704 |
(if (file-exists-p forms-file) |
(if (file-exists-p forms-file) |
705 |
(concat "No records available in file `" forms-file "'\n\n") |
(concat "No records available in file `" forms-file "'\n\n") |
736 |
;; Symbols in the list are evaluated, and consecutive strings are |
;; Symbols in the list are evaluated, and consecutive strings are |
737 |
;; concatenated. |
;; concatenated. |
738 |
;; Array `forms--elements' is constructed that contains the order |
;; Array `forms--elements' is constructed that contains the order |
739 |
;; of the fields on the display. This array is used by |
;; of the fields on the display. This array is used by |
740 |
;; `forms--parser-using-text-properties' to extract the fields data |
;; `forms--parser-using-text-properties' to extract the fields data |
741 |
;; from the form on the screen. |
;; from the form on the screen. |
742 |
;; Upon completion, `forms-format-list' is guaranteed correct, so |
;; Upon completion, `forms-format-list' is guaranteed correct, so |
759 |
(let ((the-list forms-format-list) ; the list of format elements |
(let ((the-list forms-format-list) ; the list of format elements |
760 |
(this-item 0) ; element in list |
(this-item 0) ; element in list |
761 |
(prev-item nil) |
(prev-item nil) |
762 |
(field-num 0)) ; highest field number |
(field-num 0)) ; highest field number |
763 |
|
|
764 |
(setq forms-format-list nil) ; gonna rebuild |
(setq forms-format-list nil) ; gonna rebuild |
765 |
|
|
785 |
(setq prev-item el))) |
(setq prev-item el))) |
786 |
|
|
787 |
;; Try numeric ... |
;; Try numeric ... |
788 |
((numberp el) |
((numberp el) |
789 |
|
|
790 |
;; Validate range. |
;; Validate range. |
791 |
(if (or (<= el 0) |
(if (or (<= el 0) |
862 |
(defun forms--iif-hook (begin end) |
(defun forms--iif-hook (begin end) |
863 |
"`insert-in-front-hooks' function for read-only segments." |
"`insert-in-front-hooks' function for read-only segments." |
864 |
|
|
865 |
;; Note start location. By making it a marker that points one |
;; Note start location. By making it a marker that points one |
866 |
;; character beyond the actual location, it is guaranteed to move |
;; character beyond the actual location, it is guaranteed to move |
867 |
;; correctly if text is inserted. |
;; correctly if text is inserted. |
868 |
(or forms--iif-start |
(or forms--iif-start |
869 |
(setq forms--iif-start (copy-marker (1+ (point))))) |
(setq forms--iif-start (copy-marker (1+ (point))))) |
874 |
'read-only)) |
'read-only)) |
875 |
(progn |
(progn |
876 |
;; Fetch current properties. |
;; Fetch current properties. |
877 |
(setq forms--iif-properties |
(setq forms--iif-properties |
878 |
(text-properties-at (1- forms--iif-start))) |
(text-properties-at (1- forms--iif-start))) |
879 |
|
|
880 |
;; Replace them. |
;; Replace them. |
881 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t)) |
882 |
(set-text-properties |
(set-text-properties |
883 |
(1- forms--iif-start) forms--iif-start |
(1- forms--iif-start) forms--iif-start |
884 |
(list 'face forms--rw-face 'front-sticky '(face)))) |
(list 'face forms--rw-face 'front-sticky '(face)))) |
885 |
|
|
900 |
;; Restore properties. |
;; Restore properties. |
901 |
(if forms--iif-start |
(if forms--iif-start |
902 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t)) |
903 |
(set-text-properties |
(set-text-properties |
904 |
(1- forms--iif-start) forms--iif-start |
(1- forms--iif-start) forms--iif-start |
905 |
forms--iif-properties))) |
forms--iif-properties))) |
906 |
|
|
920 |
|
|
921 |
(let ((forms--marker 0) |
(let ((forms--marker 0) |
922 |
(forms--dyntext 0)) |
(forms--dyntext 0)) |
923 |
(setq |
(setq |
924 |
forms--format |
forms--format |
925 |
(if forms-use-text-properties |
(if forms-use-text-properties |
926 |
`(lambda (arg) |
`(lambda (arg) |
927 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t)) |
928 |
,@(apply 'append |
,@(apply 'append |
957 |
;; (let ((inhibit-read-only t)) |
;; (let ((inhibit-read-only t)) |
958 |
;; |
;; |
959 |
;; ;; A string, e.g. "text: ". |
;; ;; A string, e.g. "text: ". |
960 |
;; (set-text-properties |
;; (set-text-properties |
961 |
;; (point) |
;; (point) |
962 |
;; (progn (insert "text: ") (point)) |
;; (progn (insert "text: ") (point)) |
963 |
;; (list 'face forms--ro-face |
;; (list 'face forms--ro-face |
964 |
;; 'read-only 1 |
;; 'read-only 1 |
965 |
;; 'insert-in-front-hooks 'forms--iif-hook |
;; 'insert-in-front-hooks 'forms--iif-hook |
970 |
;; (aset forms--markers 0 (point-marker)) |
;; (aset forms--markers 0 (point-marker)) |
971 |
;; (insert (elt arg 5)) |
;; (insert (elt arg 5)) |
972 |
;; (or (= (point) here) |
;; (or (= (point) here) |
973 |
;; (set-text-properties |
;; (set-text-properties |
974 |
;; here (point) |
;; here (point) |
975 |
;; (list 'face forms--rw-face |
;; (list 'face forms--rw-face |
976 |
;; 'front-sticky '(face)))) |
;; 'front-sticky '(face)))) |
1008 |
|
|
1009 |
(cond |
(cond |
1010 |
((stringp el) |
((stringp el) |
1011 |
|
|
1012 |
`((set-text-properties |
`((set-text-properties |
1013 |
(point) ; start at point |
(point) ; start at point |
1014 |
(progn ; until after insertion |
(progn ; until after insertion |
1015 |
(insert ,el) |
(insert ,el) |
1020 |
'insert-in-front-hooks '(forms--iif-hook) |
'insert-in-front-hooks '(forms--iif-hook) |
1021 |
'rear-nonsticky '(face read-only insert-in-front-hooks |
'rear-nonsticky '(face read-only insert-in-front-hooks |
1022 |
intangible))))) |
intangible))))) |
1023 |
|
|
1024 |
((numberp el) |
((numberp el) |
1025 |
`((let ((here (point))) |
`((let ((here (point))) |
1026 |
(aset forms--markers |
(aset forms--markers |
1027 |
,(prog1 forms--marker |
,(prog1 forms--marker |
1028 |
(setq forms--marker (1+ forms--marker))) |
(setq forms--marker (1+ forms--marker))) |
1029 |
(point-marker)) |
(point-marker)) |
1030 |
(insert (elt arg ,(1- el))) |
(insert (elt arg ,(1- el))) |
1031 |
(or (= (point) here) |
(or (= (point) here) |
1032 |
(set-text-properties |
(set-text-properties |
1033 |
here (point) |
here (point) |
1034 |
(list 'face forms--rw-face |
(list 'face forms--rw-face |
1035 |
'front-sticky '(face))))))) |
'front-sticky '(face))))))) |
1038 |
`((set-text-properties |
`((set-text-properties |
1039 |
(point) |
(point) |
1040 |
(progn |
(progn |
1041 |
(insert (aset forms--dyntexts |
(insert (aset forms--dyntexts |
1042 |
,(prog1 forms--dyntext |
,(prog1 forms--dyntext |
1043 |
(setq forms--dyntext (1+ forms--dyntext))) |
(setq forms--dyntext (1+ forms--dyntext))) |
1044 |
,el)) |
,el)) |
1071 |
;; (insert (aset forms--dyntexts 0 (tocol 40))) |
;; (insert (aset forms--dyntexts 0 (tocol 40))) |
1072 |
;; ... ) |
;; ... ) |
1073 |
|
|
1074 |
(cond |
(cond |
1075 |
((stringp el) |
((stringp el) |
1076 |
`((insert ,el))) |
`((insert ,el))) |
1077 |
((numberp el) |
((numberp el) |
1110 |
(let (here) |
(let (here) |
1111 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1112 |
,@(apply 'append |
,@(apply 'append |
1113 |
(mapcar |
(mapcar |
1114 |
'forms--make-parser-elt |
'forms--make-parser-elt |
1115 |
(append forms-format-list (list nil))))))))) |
(append forms-format-list (list nil))))))))) |
1116 |
|
|
1117 |
(forms--debug 'forms--parser)) |
(forms--debug 'forms--parser)) |
1128 |
(goto-char (setq here (aref forms--markers i))) |
(goto-char (setq here (aref forms--markers i))) |
1129 |
(if (get-text-property here 'read-only) |
(if (get-text-property here 'read-only) |
1130 |
(aset forms--recordv (aref forms--elements i) nil) |
(aset forms--recordv (aref forms--elements i) nil) |
1131 |
(if (setq there |
(if (setq there |
1132 |
(next-single-property-change here 'read-only)) |
(next-single-property-change here 'read-only)) |
1133 |
(aset forms--recordv (aref forms--elements i) |
(aset forms--recordv (aref forms--elements i) |
1134 |
(buffer-substring-no-properties here there)) |
(buffer-substring-no-properties here there)) |
1144 |
;; (lambda nil |
;; (lambda nil |
1145 |
;; (let (here) |
;; (let (here) |
1146 |
;; (goto-char (point-min)) |
;; (goto-char (point-min)) |
1147 |
;; |
;; |
1148 |
;; ;; "text: " |
;; ;; "text: " |
1149 |
;; (if (not (looking-at "text: ")) |
;; (if (not (looking-at "text: ")) |
1150 |
;; (error "Parse error: cannot find \"text: \"")) |
;; (error "Parse error: cannot find \"text: \"")) |
1151 |
;; (forward-char 6) ; past "text: " |
;; (forward-char 6) ; past "text: " |
1152 |
;; |
;; |
1153 |
;; ;; 6 |
;; ;; 6 |
1154 |
;; ;; "\nmore text: " |
;; ;; "\nmore text: " |
1155 |
;; (setq here (point)) |
;; (setq here (point)) |
1163 |
;; (error "Parse error: not looking at \"%s\"" forms--dyntext)) |
;; (error "Parse error: not looking at \"%s\"" forms--dyntext)) |
1164 |
;; (forward-char (length forms--dyntext)) |
;; (forward-char (length forms--dyntext)) |
1165 |
;; (setq forms--dynamic-text (cdr-safe forms--dynamic-text))) |
;; (setq forms--dynamic-text (cdr-safe forms--dynamic-text))) |
1166 |
;; ... |
;; ... |
1167 |
;; ;; final flush (due to terminator sentinel, see below) |
;; ;; final flush (due to terminator sentinel, see below) |
1168 |
;; (aset forms--recordv 7 (buffer-substring-no-properties (point) (point-max))) |
;; (aset forms--recordv 7 (buffer-substring-no-properties (point) (point-max))) |
1169 |
|
|
1233 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1234 |
(forms--get-record))) |
(forms--get-record))) |
1235 |
|
|
1236 |
;; This may be overkill, but try to avoid interference with |
;; This may be overkill, but try to avoid interference with |
1237 |
;; the normal processing. |
;; the normal processing. |
1238 |
(kill-buffer forms--file-buffer) |
(kill-buffer forms--file-buffer) |
1239 |
|
|
1260 |
(defun forms--set-keymaps () |
(defun forms--set-keymaps () |
1261 |
"Set the keymaps used in this mode." |
"Set the keymaps used in this mode." |
1262 |
|
|
1263 |
(use-local-map (if forms-read-only |
(use-local-map (if forms-read-only |
1264 |
forms-mode-ro-map |
forms-mode-ro-map |
1265 |
forms-mode-edit-map))) |
forms-mode-edit-map))) |
1266 |
|
|
1267 |
(defun forms--mode-commands () |
(defun forms--mode-commands () |
1403 |
(put 'forms-delete-record 'menu-enable '(not forms-read-only)) |
(put 'forms-delete-record 'menu-enable '(not forms-read-only)) |
1404 |
) |
) |
1405 |
|
|
1406 |
(defun forms--mode-commands1 (map) |
(defun forms--mode-commands1 (map) |
1407 |
"Helper routine to define keys." |
"Helper routine to define keys." |
1408 |
(define-key map [TAB] 'forms-next-field) |
(define-key map [TAB] 'forms-next-field) |
1409 |
(define-key map [S-tab] 'forms-prev-field) |
(define-key map [S-tab] 'forms-prev-field) |
1423 |
;; scroll-up -> forms-next-record |
;; scroll-up -> forms-next-record |
1424 |
(if forms-forms-scroll |
(if forms-forms-scroll |
1425 |
(progn |
(progn |
1426 |
(substitute-key-definition 'scroll-up 'forms-next-record |
(local-set-key [remap scroll-up] 'forms-next-record) |
1427 |
(current-local-map) |
(local-set-key [remap scroll-down] 'forms-prev-record))) |
|
(current-global-map)) |
|
|
(substitute-key-definition 'scroll-down 'forms-prev-record |
|
|
(current-local-map) |
|
|
(current-global-map)))) |
|
1428 |
;; |
;; |
1429 |
;; beginning-of-buffer -> forms-first-record |
;; beginning-of-buffer -> forms-first-record |
1430 |
;; end-of-buffer -> forms-end-record |
;; end-of-buffer -> forms-end-record |
1431 |
(if forms-forms-jump |
(if forms-forms-jump |
1432 |
(progn |
(progn |
1433 |
(substitute-key-definition 'beginning-of-buffer 'forms-first-record |
(local-set-key [remap beginning-of-buffer] 'forms-first-record) |
1434 |
(current-local-map) |
(local-set-key [remap end-of-buffer] 'forms-last-record))) |
|
(current-global-map)) |
|
|
(substitute-key-definition 'end-of-buffer 'forms-last-record |
|
|
(current-local-map) |
|
|
(current-global-map)))) |
|
1435 |
;; |
;; |
1436 |
;; Save buffer |
;; Save buffer |
1437 |
(local-set-key "\C-x\C-s" 'forms-save-buffer) |
(local-set-key "\C-x\C-s" 'forms-save-buffer) |
1526 |
(message "Warning: this record has %d fields instead of %d" |
(message "Warning: this record has %d fields instead of %d" |
1527 |
(length forms--the-record-list) forms-number-of-fields)) |
(length forms--the-record-list) forms-number-of-fields)) |
1528 |
(if (< (length forms--the-record-list) forms-number-of-fields) |
(if (< (length forms--the-record-list) forms-number-of-fields) |
1529 |
(setq forms--the-record-list |
(setq forms--the-record-list |
1530 |
(append forms--the-record-list |
(append forms--the-record-list |
1531 |
(make-list |
(make-list |
1532 |
(- forms-number-of-fields |
(- forms-number-of-fields |
1533 |
(length forms--the-record-list)) |
(length forms--the-record-list)) |
1534 |
""))))) |
""))))) |
1535 |
|
|
1549 |
"Parse contents of form into list of strings." |
"Parse contents of form into list of strings." |
1550 |
;; The contents of the form are parsed, and a new list of strings |
;; The contents of the form are parsed, and a new list of strings |
1551 |
;; is constructed. |
;; is constructed. |
1552 |
;; A vector with the strings from the original record is |
;; A vector with the strings from the original record is |
1553 |
;; constructed, which is updated with the new contents. Therefore |
;; constructed, which is updated with the new contents. Therefore |
1554 |
;; fields which were not in the form are not modified. |
;; fields which were not in the form are not modified. |
1555 |
;; Finally, the vector is transformed into a list for further processing. |
;; Finally, the vector is transformed into a list for further processing. |
1585 |
(setq forms--the-record-list (forms--parse-form)) |
(setq forms--the-record-list (forms--parse-form)) |
1586 |
(setq the-record |
(setq the-record |
1587 |
(mapconcat 'identity forms--the-record-list forms-field-sep)) |
(mapconcat 'identity forms--the-record-list forms-field-sep)) |
1588 |
|
|
1589 |
(if (string-match (regexp-quote forms-field-sep) |
(if (string-match (regexp-quote forms-field-sep) |
1590 |
(mapconcat 'identity forms--the-record-list "")) |
(mapconcat 'identity forms--the-record-list "")) |
1591 |
(error "Field separator occurs in record - update refused")) |
(error "Field separator occurs in record - update refused")) |
1592 |
|
|
1593 |
;; Handle multi-line fields, if allowed. |
;; Handle multi-line fields, if allowed. |
1594 |
(if forms-multi-line |
(if forms-multi-line |
1595 |
(forms--trans the-record "\n" forms-multi-line)) |
(forms--trans the-record "\n" forms-multi-line)) |
1713 |
As a side effect: re-calculates the number of records in the data file." |
As a side effect: re-calculates the number of records in the data file." |
1714 |
(interactive) |
(interactive) |
1715 |
(let |
(let |
1716 |
((numrec |
((numrec |
1717 |
(save-excursion |
(save-excursion |
1718 |
(set-buffer forms--file-buffer) |
(set-buffer forms--file-buffer) |
1719 |
(count-lines (point-min) (point-max))))) |
(count-lines (point-min) (point-max))))) |
1769 |
(defun forms-insert-record (arg) |
(defun forms-insert-record (arg) |
1770 |
"Create a new record before the current one. |
"Create a new record before the current one. |
1771 |
With ARG: store the record after the current one. |
With ARG: store the record after the current one. |
1772 |
If `forms-new-record-filter' contains the name of a function, |
If `forms-new-record-filter' contains the name of a function, |
1773 |
it is called to fill (some of) the fields with default values. |
it is called to fill (some of) the fields with default values. |
1774 |
If `forms-insert-after is non-nil, the default behavior is to insert |
If `forms-insert-after is non-nil, the default behavior is to insert |
1775 |
after the current record." |
after the current record." |
1808 |
(open-line 1) |
(open-line 1) |
1809 |
(insert the-record) |
(insert the-record) |
1810 |
(beginning-of-line)) |
(beginning-of-line)) |
1811 |
|
|
1812 |
(setq forms--current-record ln)) |
(setq forms--current-record ln)) |
1813 |
|
|
1814 |
(setq forms--total-records (1+ forms--total-records)) |
(setq forms--total-records (1+ forms--total-records)) |
1841 |
|
|
1842 |
(defun forms-search-forward (regexp) |
(defun forms-search-forward (regexp) |
1843 |
"Search forward for record containing REGEXP." |
"Search forward for record containing REGEXP." |
1844 |
(interactive |
(interactive |
1845 |
(list (read-string (concat "Search forward for" |
(list (read-string (concat "Search forward for" |
1846 |
(if forms--search-regexp |
(if forms--search-regexp |
1847 |
(concat " (" |
(concat " (" |
1848 |
forms--search-regexp |
forms--search-regexp |
1877 |
|
|
1878 |
(defun forms-search-backward (regexp) |
(defun forms-search-backward (regexp) |
1879 |
"Search backward for record containing REGEXP." |
"Search backward for record containing REGEXP." |
1880 |
(interactive |
(interactive |
1881 |
(list (read-string (concat "Search backward for" |
(list (read-string (concat "Search backward for" |
1882 |
(if forms--search-regexp |
(if forms--search-regexp |
1883 |
(concat " (" |
(concat " (" |
1884 |
forms--search-regexp |
forms--search-regexp |
1925 |
(set-buffer forms--file-buffer) |
(set-buffer forms--file-buffer) |
1926 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t)) |
1927 |
;; Write file hooks are run via local-write-file-hooks. |
;; Write file hooks are run via local-write-file-hooks. |
1928 |
;; (if write-file-filter |
;; (if write-file-filter |
1929 |
;; (save-excursion |
;; (save-excursion |
1930 |
;; (run-hooks 'write-file-filter))) |
;; (run-hooks 'write-file-filter))) |
1931 |
|
|
1932 |
;; If they have a write-file-filter, force the buffer to be |
;; If they have a write-file-filter, force the buffer to be |
2076 |
(setq ret (concat ret (prin1-to-string vel) "\n"))) |
(setq ret (concat ret (prin1-to-string vel) "\n"))) |
2077 |
(setq ret (concat ret "<unbound>" "\n"))) |
(setq ret (concat ret "<unbound>" "\n"))) |
2078 |
(if (fboundp el) |
(if (fboundp el) |
2079 |
(setq ret (concat ret (prin1-to-string (symbol-function el)) |
(setq ret (concat ret (prin1-to-string (symbol-function el)) |
2080 |
"\n")))))) |
"\n")))))) |
2081 |
(save-excursion |
(save-excursion |
2082 |
(set-buffer (get-buffer-create "*forms-mode debug*")) |
(set-buffer (get-buffer-create "*forms-mode debug*")) |