Mercurial > hg > xemacs-beta

comparison lisp/utils/forms.el @ 72:b9518feda344 r20-0b31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b31
author cvs
date Mon, 13 Aug 2007 09:03:46 +0200
parents 131b0175ea99
children 9ad43877534d
comparison
equal deleted inserted replaced
71:bae944334fa4 72:b9518feda344
1 ;;; forms.el --- Forms mode: edit a file as a form to fill in. 1 ;;; forms.el --- Forms mode: edit a file as a form to fill in
2 2
3 ;;; Copyright (C) 1991, 1993 Free Software Foundation, Inc. 3 ;; Copyright (C) 1991, 1994, 1995, 1996 Free Software Foundation, Inc.
4 4
5 ;; Author: Johan Vromans <jv@nl.net> 5 ;; Author: Johan Vromans <jvromans@squirrel.nl>
6 ;; Version: Revision: 2.10 6 ;; Version: Revision: 2.10
7 ;; Keywords: extensions 7 ;; Keywords: extensions
8 ;; hacked on by jwz for XEmacs 8 ;; hacked on by jwz for XEmacs
9 9
10 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details. 20 ;; General Public License for more details.
21 21
22 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 ;; Boston, MA 02111-1307, USA. 25 ;; 02111-1307, USA.
26 26
27 ;;; Synched up with: FSF 19.28. 27 ;;; Synched up with: FSF 19.34.
28 28
29 ;;; Commentary: 29 ;;; Commentary:
30 30
31 ;;; Visit a file using a form. 31 ;; Visit a file using a form.
32 ;;; 32 ;;
33 ;;; === Naming conventions 33 ;; === Naming conventions
34 ;;; 34 ;;
35 ;;; The names of all variables and functions start with 'forms-'. 35 ;; The names of all variables and functions start with 'forms-'.
36 ;;; Names which start with 'forms--' are intended for internal use, and 36 ;; Names which start with 'forms--' are intended for internal use, and
37 ;;; should *NOT* be used from the outside. 37 ;; should *NOT* be used from the outside.
38 ;;; 38 ;;
39 ;;; All variables are buffer-local, to enable multiple forms visits 39 ;; All variables are buffer-local, to enable multiple forms visits
40 ;;; simultaneously. 40 ;; simultaneously.
41 ;;; Variable `forms--mode-setup' is local to *ALL* buffers, for it 41 ;; Variable `forms--mode-setup' is local to *ALL* buffers, for it
42 ;;; controls if forms-mode has been enabled in a buffer. 42 ;; controls if forms-mode has been enabled in a buffer.
43 ;;; 43 ;;
44 ;;; === How it works === 44 ;; === How it works ===
45 ;;; 45 ;;
46 ;;; Forms mode means visiting a data file which is supposed to consist 46 ;; Forms mode means visiting a data file which is supposed to consist
47 ;;; of records each containing a number of fields. The records are 47 ;; of records each containing a number of fields. The records are
48 ;;; separated by a newline, the fields are separated by a user-defined 48 ;; separated by a newline, the fields are separated by a user-defined
49 ;;; field separater (default: TAB). 49 ;; field separator (default: TAB).
50 ;;; When shown, a record is transferred to an Emacs buffer and 50 ;; When shown, a record is transferred to an Emacs buffer and
51 ;;; presented using a user-defined form. One record is shown at a 51 ;; presented using a user-defined form. One record is shown at a
52 ;;; time. 52 ;; time.
53 ;;; 53 ;;
54 ;;; Forms mode is a composite mode. It involves two files, and two 54 ;; Forms mode is a composite mode. It involves two files, and two
55 ;;; buffers. 55 ;; buffers.
56 ;;; The first file, called the control file, defines the name of the 56 ;; The first file, called the control file, defines the name of the
57 ;;; data file and the forms format. This file buffer will be used to 57 ;; data file and the forms format. This file buffer will be used to
58 ;;; present the forms. 58 ;; present the forms.
59 ;;; The second file holds the actual data. The buffer of this file 59 ;; The second file holds the actual data. The buffer of this file
60 ;;; will be buried, for it is never accessed directly. 60 ;; will be buried, for it is never accessed directly.
61 ;;; 61 ;;
62 ;;; Forms mode is invoked using M-x forms-find-file control-file . 62 ;; Forms mode is invoked using M-x forms-find-file control-file .
63 ;;; Alternativily `forms-find-file-other-window' can be used. 63 ;; Alternatively `forms-find-file-other-window' can be used.
64 ;;; 64 ;;
65 ;;; You may also visit the control file, and switch to forms mode by hand 65 ;; You may also visit the control file, and switch to forms mode by hand
66 ;;; with M-x forms-mode . 66 ;; with M-x forms-mode .
67 ;;; 67 ;;
68 ;;; Automatic mode switching is supported if you specify 68 ;; Automatic mode switching is supported if you specify
69 ;;; "-*- forms -*-" in the first line of the control file. 69 ;; "-*- forms -*-" in the first line of the control file.
70 ;;; 70 ;;
71 ;;; The control file is visited, evaluated using `eval-current-buffer', 71 ;; The control file is visited, evaluated using `eval-current-buffer',
72 ;;; and should set at least the following variables: 72 ;; and should set at least the following variables:
73 ;;; 73 ;;
74 ;;; forms-file [string] 74 ;; forms-file [string]
75 ;;; The name of the data file. 75 ;; The name of the data file.
76 ;;; 76 ;;
77 ;;; forms-number-of-fields [integer] 77 ;; forms-number-of-fields [integer]
78 ;;; The number of fields in each record. 78 ;; The number of fields in each record.
79 ;;; 79 ;;
80 ;;; forms-format-list [list] 80 ;; forms-format-list [list]
81 ;;; Formatting instructions. 81 ;; Formatting instructions.
82 ;;; 82 ;;
83 ;;; `forms-format-list' should be a list, each element containing 83 ;; `forms-format-list' should be a list, each element containing
84 ;;; 84 ;;
85 ;;; - a string, e.g. "hello". The string is inserted in the forms 85 ;; - a string, e.g. "hello". The string is inserted in the forms
86 ;;; "as is". 86 ;; "as is".
87 ;;; 87 ;;
88 ;;; - an integer, denoting a field number. 88 ;; - an integer, denoting a field number.
89 ;;; The contents of this field are inserted at this point. 89 ;; The contents of this field are inserted at this point.
90 ;;; Fields are numbered starting with number one. 90 ;; Fields are numbered starting with number one.
91 ;;; 91 ;;
92 ;;; - a function call, e.g. (insert "text"). 92 ;; - a function call, e.g. (insert "text").
93 ;;; This function call is dynamically evaluated and should return a 93 ;; This function call is dynamically evaluated and should return a
94 ;;; string. It should *NOT* have side-effects on the forms being 94 ;; string. It should *NOT* have side-effects on the forms being
95 ;;; constructed. The current fields are available to the function 95 ;; constructed. The current fields are available to the function
96 ;;; in the variable `forms-fields', they should *NOT* be modified. 96 ;; in the variable `forms-fields', they should *NOT* be modified.
97 ;;; 97 ;;
98 ;;; - a lisp symbol, that must evaluate to one of the above. 98 ;; - a lisp symbol, that must evaluate to one of the above.
99 ;;; 99 ;;
100 ;;; Optional variables which may be set in the control file: 100 ;; Optional variables which may be set in the control file:
101 ;;; 101 ;;
102 ;;; forms-field-sep [string, default TAB] 102 ;; forms-field-sep [string, default TAB]
103 ;;; The field separator used to separate the 103 ;; The field separator used to separate the
104 ;;; fields in the data file. It may be a string. 104 ;; fields in the data file. It may be a string.
105 ;;; 105 ;;
106 ;;; forms-read-only [bool, default nil] 106 ;; forms-read-only [bool, default nil]
107 ;;; Non-nil means that the data file is visited 107 ;; Non-nil means that the data file is visited
108 ;;; read-only (view mode) as opposed to edit mode. 108 ;; read-only (view mode) as opposed to edit mode.
109 ;;; If no write access to the data file is 109 ;; If no write access to the data file is
110 ;;; possible, view mode is enforced. 110 ;; possible, view mode is enforced.
111 ;;; 111 ;;
112 ;;; forms-multi-line [string, default "^K"] 112 ;; forms-check-number-of-fields [bool, default t]
113 ;;; If non-null the records of the data file may 113 ;; If non-nil, a warning will be issued whenever
114 ;;; contain fields that can span multiple lines in 114 ;; a record is found that does not have the number
115 ;;; the form. 115 ;; of fields specified by `forms-number-of-fields'.
116 ;;; This variable denotes the separator character 116 ;;
117 ;;; to be used for this purpose. Upon display, all 117 ;; forms-multi-line [string, default "^K"]
118 ;;; occurrencies of this character are translated 118 ;; If non-null the records of the data file may
119 ;;; to newlines. Upon storage they are translated 119 ;; contain fields that can span multiple lines in
120 ;;; back to the separator character. 120 ;; the form.
121 ;;; 121 ;; This variable denotes the separator character
122 ;;; forms-forms-scroll [bool, default nil] 122 ;; to be used for this purpose. Upon display, all
123 ;;; Non-nil means: rebind locally the commands that 123 ;; occurrences of this character are translated
124 ;;; perform `scroll-up' or `scroll-down' to use 124 ;; to newlines. Upon storage they are translated
125 ;;; `forms-next-field' resp. `forms-prev-field'. 125 ;; back to the separator character.
126 ;;; 126 ;;
127 ;;; forms-forms-jump [bool, default nil] 127 ;; forms-forms-scroll [bool, default nil]
128 ;;; Non-nil means: rebind locally the commands that 128 ;; Non-nil means: rebind locally the commands that
129 ;;; perform `beginning-of-buffer' or `end-of-buffer' 129 ;; perform `scroll-up' or `scroll-down' to use
130 ;;; to perform `forms-first-field' resp. `forms-last-field'. 130 ;; `forms-next-field' resp. `forms-prev-field'.
131 ;;; 131 ;;
132 ;;; forms-read-file-filter [symbol, default nil] 132 ;; forms-forms-jump [bool, default nil]
133 ;;; If not nil: this should be the name of a 133 ;; Non-nil means: rebind locally the commands that
134 ;;; function that is called after the forms data file 134 ;; perform `beginning-of-buffer' or `end-of-buffer'
135 ;;; has been read. It can be used to transform 135 ;; to perform `forms-first-field' and `forms-last-field'.
136 ;;; the contents of the file into a format more suitable 136 ;;
137 ;;; for forms-mode processing. 137 ;; forms-insert-after [bool, default nil]
138 ;;; 138 ;; Non-nil means: inserts of new records go after
139 ;;; forms-write-file-filter [symbol, default nil] 139 ;; current record, also initial position is at last
140 ;;; If not nil: this should be the name of a 140 ;; record.
141 ;;; function that is called before the forms data file 141 ;;
142 ;;; is written (saved) to disk. It can be used to undo 142 ;; forms-read-file-filter [symbol, default nil]
143 ;;; the effects of `forms-read-file-filter', if any. 143 ;; If not nil: this should be the name of a
144 ;;; 144 ;; function that is called after the forms data file
145 ;;; forms-new-record-filter [symbol, default nil] 145 ;; has been read. It can be used to transform
146 ;;; If not nil: this should be the name of a 146 ;; the contents of the file into a format more suitable
147 ;;; function that is called when a new 147 ;; for forms-mode processing.
148 ;;; record is created. It can be used to fill in 148 ;;
149 ;;; the new record with default fields, for example. 149 ;; forms-write-file-filter [symbol, default nil]
150 ;;; 150 ;; If not nil: this should be the name of a
151 ;;; forms-modified-record-filter [symbol, default nil] 151 ;; function that is called before the forms data file
152 ;;; If not nil: this should be the name of a 152 ;; is written (saved) to disk. It can be used to undo
153 ;;; function that is called when a record has 153 ;; the effects of `forms-read-file-filter', if any.
154 ;;; been modified. It is called after the fields 154 ;;
155 ;;; are parsed. It can be used to register 155 ;; forms-new-record-filter [symbol, default nil]
156 ;;; modification dates, for example. 156 ;; If not nil: this should be the name of a
157 ;;; 157 ;; function that is called when a new
158 ;;; forms-use-extents [bool, see text for default] 158 ;; record is created. It can be used to fill in
159 ;;; forms-use-text-properties [bool, see text for default] 159 ;; the new record with default fields, for example.
160 ;;; These variables control if forms mode should use 160 ;;
161 ;;; text properties or extents to protect the form text 161 ;; forms-modified-record-filter [symbol, default nil]
162 ;;; from being modified (using text-property `read-only'). 162 ;; If not nil: this should be the name of a
163 ;;; Also, the read-write fields are shown using a 163 ;; function that is called when a record has
164 ;;; distinct face, if possible. 164 ;; been modified. It is called after the fields
165 ;;; One of these variables defaults to t if running 165 ;; are parsed. It can be used to register
166 ;;; FSF or Lucid Emacs 19. 166 ;; modification dates, for example.
167 ;;; 167 ;;
168 ;;; forms-ro-face [symbol, default 'default] 168 ;; forms-use-extents [bool, see text for default]
169 ;;; This is the face that is used to show 169 ;; forms-use-text-properties [bool, see text for default]
170 ;;; read-only text on the screen.If used, this 170 ;; These variables control if forms mode should use
171 ;;; variable should be set to a symbol that is a 171 ;; text properties or extents to protect the form text
172 ;;; valid face. 172 ;; from being modified (using text-property `read-only').
173 ;;; E.g. 173 ;; Also, the read-write fields are shown using a
174 ;;; (make-face 'my-face) 174 ;; distinct face, if possible.
175 ;;; (setq forms-ro-face 'my-face) 175 ;; As of emacs 19.29, the `intangible' text property
176 ;;; 176 ;; is used to prevent moving into read-only fields.
177 ;;; forms-rw-face [symbol, default 'region] 177 ;; This variable defaults to t if running Emacs 19
178 ;;; This is the face that is used to show 178 ;; with text properties.
179 ;;; read-write text on the screen. 179 ;; The default face to show read-write fields is
180 ;;; 180 ;; copied from face `region'.
181 ;;; After evaluating the control file, its buffer is cleared and used 181 ;;
182 ;;; for further processing. 182 ;; forms-ro-face [symbol, default 'default]
183 ;;; The data file (as designated by `forms-file') is visited in a buffer 183 ;; This is the face that is used to show
184 ;;; `forms--file-buffer' which will not normally be shown. 184 ;; read-only text on the screen.If used, this
185 ;;; Great malfunctioning may be expected if this file/buffer is modified 185 ;; variable should be set to a symbol that is a
186 ;;; outside of this package while it is being visited! 186 ;; valid face.
187 ;;; 187 ;; E.g.
188 ;;; Normal operation is to transfer one line (record) from the data file, 188 ;; (make-face 'my-face)
189 ;;; split it into fields (into `forms--the-record-list'), and display it 189 ;; (setq forms-ro-face 'my-face)
190 ;;; using the specs in `forms-format-list'. 190 ;;
191 ;;; A format routine `forms--format' is built upon startup to format 191 ;; forms-rw-face [symbol, default 'region]
192 ;;; the records according to `forms-format-list'. 192 ;; This is the face that is used to show
193 ;;; 193 ;; read-write text on the screen.
194 ;;; When a form is changed the record is updated as soon as this form 194 ;;
195 ;;; is left. The contents of the form are parsed using information 195 ;; After evaluating the control file, its buffer is cleared and used
196 ;;; obtained from `forms-format-list', and the fields which are 196 ;; for further processing.
197 ;;; deduced from the form are modified. Fields not shown on the forms 197 ;; The data file (as designated by `forms-file') is visited in a buffer
198 ;;; retain their origional values. The newly formed record then 198 ;; `forms--file-buffer' which will not normally be shown.
199 ;;; replaces the contents of the old record in `forms--file-buffer'. 199 ;; Great malfunctioning may be expected if this file/buffer is modified
200 ;;; A parse routine `forms--parser' is built upon startup to parse 200 ;; outside of this package while it is being visited!
201 ;;; the records. 201 ;;
202 ;;; 202 ;; Normal operation is to transfer one line (record) from the data file,
203 ;;; Two exit functions exist: `forms-exit' and `forms-exit-no-save'. 203 ;; split it into fields (into `forms--the-record-list'), and display it
204 ;;; `forms-exit' saves the data to the file, if modified. 204 ;; using the specs in `forms-format-list'.
205 ;;; `forms-exit-no-save` does not. However, if `forms-exit-no-save' 205 ;; A format routine `forms--format' is built upon startup to format
206 ;;; is executed and the file buffer has been modified, Emacs will ask 206 ;; the records according to `forms-format-list'.
207 ;;; questions anyway. 207 ;;
208 ;;; 208 ;; When a form is changed the record is updated as soon as this form
209 ;;; Other functions provided by forms mode are: 209 ;; is left. The contents of the form are parsed using information
210 ;;; 210 ;; obtained from `forms-format-list', and the fields which are
211 ;;; paging (forward, backward) by record 211 ;; deduced from the form are modified. Fields not shown on the forms
212 ;;; jumping (first, last, random number) 212 ;; retain their original values. The newly formed record then
213 ;;; searching 213 ;; replaces the contents of the old record in `forms--file-buffer'.
214 ;;; creating and deleting records 214 ;; A parse routine `forms--parser' is built upon startup to parse
215 ;;; reverting the form (NOT the file buffer) 215 ;; the records.
216 ;;; switching edit <-> view mode v.v. 216 ;;
217 ;;; jumping from field to field 217 ;; Two exit functions exist: `forms-exit' and `forms-exit-no-save'.
218 ;;; 218 ;; `forms-exit' saves the data to the file, if modified.
219 ;;; As an documented side-effect: jumping to the last record in the 219 ;; `forms-exit-no-save` does not. However, if `forms-exit-no-save'
220 ;;; file (using forms-last-record) will adjust forms--total-records if 220 ;; is executed and the file buffer has been modified, Emacs will ask
221 ;;; needed. 221 ;; questions anyway.
222 ;;; 222 ;;
223 ;;; The forms buffer can be in on eof two modes: edit mode or view 223 ;; Other functions provided by forms mode are:
224 ;;; mode. View mode is a read-only mode, you cannot modify the 224 ;;
225 ;;; contents of the buffer. 225 ;; paging (forward, backward) by record
226 ;;; 226 ;; jumping (first, last, random number)
227 ;;; Edit mode commands: 227 ;; searching
228 ;;; 228 ;; creating and deleting records
229 ;;; TAB forms-next-field 229 ;; reverting the form (NOT the file buffer)
230 ;;; \C-c TAB forms-next-field 230 ;; switching edit <-> view mode v.v.
231 ;;; \C-c < forms-first-record 231 ;; jumping from field to field
232 ;;; \C-c > forms-last-record 232 ;;
233 ;;; \C-c ? describe-mode 233 ;; As an documented side-effect: jumping to the last record in the
234 ;;; \C-c \C-k forms-delete-record 234 ;; file (using forms-last-record) will adjust forms--total-records if
235 ;;; \C-c \C-q forms-toggle-read-only 235 ;; needed.
236 ;;; \C-c \C-o forms-insert-record 236 ;;
237 ;;; \C-c \C-l forms-jump-record 237 ;; The forms buffer can be in on eof two modes: edit mode or view
238 ;;; \C-c \C-n forms-next-record 238 ;; mode. View mode is a read-only mode, you cannot modify the
239 ;;; \C-c \C-p forms-prev-record 239 ;; contents of the buffer.
240 ;;; \C-c \C-s forms-search 240 ;;
241 ;;; \C-c \C-x forms-exit 241 ;; Edit mode commands:
242 ;;; 242 ;;
243 ;;; Read-only mode commands: 243 ;; TAB forms-next-field
244 ;;; 244 ;; \C-c TAB forms-next-field
245 ;;; SPC forms-next-record 245 ;; \C-c < forms-first-record
246 ;;; DEL forms-prev-record 246 ;; \C-c > forms-last-record
247 ;;; ? describe-mode 247 ;; \C-c ? describe-mode
248 ;;; \C-q forms-toggle-read-only 248 ;; \C-c \C-k forms-delete-record
249 ;;; l forms-jump-record 249 ;; \C-c \C-q forms-toggle-read-only
250 ;;; n forms-next-record 250 ;; \C-c \C-o forms-insert-record
251 ;;; p forms-prev-record 251 ;; \C-c \C-l forms-jump-record
252 ;;; s forms-search 252 ;; \C-c \C-n forms-next-record
253 ;;; x forms-exit 253 ;; \C-c \C-p forms-prev-record
254 ;;; 254 ;; \C-c \C-r forms-search-backward
255 ;;; Of course, it is also possible to use the \C-c prefix to obtain the 255 ;; \C-c \C-s forms-search-forward
256 ;;; same command keys as in edit mode. 256 ;; \C-c \C-x forms-exit
257 ;;; 257 ;;
258 ;;; The following bindings are available, independent of the mode: 258 ;; Read-only mode commands:
259 ;;; 259 ;;
260 ;;; [next] forms-next-record 260 ;; SPC forms-next-record
261 ;;; [prior] forms-prev-record 261 ;; DEL forms-prev-record
262 ;;; [begin] forms-first-record 262 ;; ? describe-mode
263 ;;; [end] forms-last-record 263 ;; \C-q forms-toggle-read-only
264 ;;; [S-TAB] forms-prev-field 264 ;; l forms-jump-record
265 ;;; [backtab] forms-prev-field 265 ;; n forms-next-record
266 ;;; 266 ;; p forms-prev-record
267 ;;; For convenience, TAB is always bound to `forms-next-field', so you 267 ;; r forms-search-backward
268 ;;; don't need the C-c prefix for this command. 268 ;; s forms-search-forward
269 ;;; 269 ;; x forms-exit
270 ;;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump') 270 ;;
271 ;;; the bindings of standard functions `scroll-up', `scroll-down', 271 ;; Of course, it is also possible to use the \C-c prefix to obtain the
272 ;;; `beginning-of-buffer' and `end-of-buffer' can be locally replaced with 272 ;; same command keys as in edit mode.
273 ;;; forms mode functions next/prev record and first/last 273 ;;
274 ;;; record. 274 ;; The following bindings are available, independent of the mode:
275 ;;; 275 ;;
276 ;;; `local-write-file hook' is defined to save the actual data file 276 ;; [next] forms-next-record
277 ;;; instead of the buffer data, `revert-file-hook' is defined to 277 ;; [prior] forms-prev-record
278 ;;; revert a forms to original. 278 ;; [begin] forms-first-record
279 ;; [end] forms-last-record
280 ;; [S-TAB] forms-prev-field
281 ;; [backtab] forms-prev-field
282 ;;
283 ;; For convenience, TAB is always bound to `forms-next-field', so you
284 ;; don't need the C-c prefix for this command.
285 ;;
286 ;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump')
287 ;; the bindings of standard functions `scroll-up', `scroll-down',
288 ;; `beginning-of-buffer' and `end-of-buffer' can be locally replaced with
289 ;; forms mode functions next/prev record and first/last
290 ;; record.
291 ;;
292 ;; `local-write-file hook' is defined to save the actual data file
293 ;; instead of the buffer data, `revert-file-hook' is defined to
294 ;; revert a forms to original.
279 295
280 ;;; Code: 296 ;;; Code:
281 297
282 ;;; Global variables and constants: 298 ;;; Global variables and constants:
283 299
284 (provide 'forms) ;;; official 300 (provide 'forms) ;;; official
285 (provide 'forms-mode) ;;; for compatibility 301 (provide 'forms-mode) ;;; for compatibility
286 302
287 (defconst forms-version (substring "!Revision: 2.10 !" 11 -2) 303 (defconst forms-version (substring "$Revision: 1.1.1.2 $" 11 -2)
288 "The version number of forms-mode (as string). The complete RCS id is: 304 "The version number of forms-mode (as string). The complete RCS id is:
289 305
290 !Id: forms.el,v 2.10 1994/07/26 21:31:13 rms Exp !") 306 $Id: forms.el,v 1.1.1.2 1996/12/18 22:51:25 steve Exp $")
291 307
292 (defvar forms-mode-hooks nil 308 (defvar forms-mode-hooks nil
293 "Hook functions to be run upon entering Forms mode.") 309 "Hook functions to be run upon entering Forms mode.")
294 310
295 ;;; Mandatory variables - must be set by evaluating the control file. 311 ;;; Mandatory variables - must be set by evaluating the control file.
303 (defvar forms-number-of-fields nil 319 (defvar forms-number-of-fields nil
304 "Number of fields per record.") 320 "Number of fields per record.")
305 321
306 ;;; Optional variables with default values. 322 ;;; Optional variables with default values.
307 323
324 (defvar forms-check-number-of-fields t
325 "*If non-nil, warn about records with wrong number of fields.")
326
308 (defvar forms-field-sep "\t" 327 (defvar forms-field-sep "\t"
309 "Field separator character (default TAB).") 328 "Field separator character (default TAB).")
310 329
311 (defvar forms-read-only nil 330 (defvar forms-read-only nil
312 "Non-nil means: visit the file in view (read-only) mode. 331 "Non-nil means: visit the file in view (read-only) mode.
346 (defvar forms-use-extents (fboundp 'set-extent-property) ; XEmacs 19.9+ 365 (defvar forms-use-extents (fboundp 'set-extent-property) ; XEmacs 19.9+
347 "*Non-nil means: use XEmacs/Lucid Emacs extents. 366 "*Non-nil means: use XEmacs/Lucid Emacs extents.
348 Defaults to t if this emacs is capable of handling text properties.") 367 Defaults to t if this emacs is capable of handling text properties.")
349 368
350 (defvar forms-use-text-properties (and (fboundp 'set-text-properties) 369 (defvar forms-use-text-properties (and (fboundp 'set-text-properties)
351 (not forms-use-extents)) 370 (not forms-use-extents)) ; XEmacs
352 "*Non-nil means: use emacs-19 text properties. 371 "*Non-nil means: use emacs-19 text properties.
353 Defaults to t if this emacs is capable of handling text properties.") 372 Defaults to t if this emacs is capable of handling text properties.")
373
374 (defvar forms-insert-after nil
375 "*Non-nil means: inserts of new records go after current record.
376 Also, initial position is at last record.")
354 377
355 (defvar forms-ro-face (if (string-match "XEmacs" emacs-version) 378 (defvar forms-ro-face (if (string-match "XEmacs" emacs-version)
356 'forms-label-face 379 'forms-label-face
357 'default) 380 'default)
358 "The face (a symbol) that is used to display read-only text on the screen.") 381 "The face (a symbol) that is used to display read-only text on the screen.")
390 413
391 (defvar forms--the-record-list nil 414 (defvar forms--the-record-list nil
392 "List of strings of the current record, as parsed from the file.") 415 "List of strings of the current record, as parsed from the file.")
393 416
394 (defvar forms--search-regexp nil 417 (defvar forms--search-regexp nil
395 "Last regexp used by forms-search.") 418 "Last regexp used by forms-search functions.")
396 419
397 (defvar forms--format nil 420 (defvar forms--format nil
398 "Formatting routine.") 421 "Formatting routine.")
399 422
400 (defvar forms--parser nil 423 (defvar forms--parser nil
413 (defvar forms--ro-face nil 436 (defvar forms--ro-face nil
414 "Face used to represent read-only data on the screen.") 437 "Face used to represent read-only data on the screen.")
415 438
416 (defvar forms--rw-face nil 439 (defvar forms--rw-face nil
417 "Face used to represent read-write data on the screen.") 440 "Face used to represent read-write data on the screen.")
418
419 441
420 ;;;###autoload 442 ;;;###autoload
421 (defun forms-mode (&optional primary) 443 (defun forms-mode (&optional primary)
422 "Major mode to visit files in a field-structured manner using a form. 444 "Major mode to visit files in a field-structured manner using a form.
423 445
424 Commands: Equivalent keys in read-only mode: 446 Commands: Equivalent keys in read-only mode:
425 447 TAB forms-next-field TAB
426 TAB forms-next-field TAB 448 \\C-c TAB forms-next-field
427 C-c TAB forms-next-field 449 \\C-c < forms-first-record <
428 C-c < forms-first-record < 450 \\C-c > forms-last-record >
429 C-c > forms-last-record > 451 \\C-c ? describe-mode ?
430 C-c ? describe-mode ? 452 \\C-c \\C-k forms-delete-record
431 C-c C-k forms-delete-record 453 \\C-c \\C-q forms-toggle-read-only q
432 C-c C-q forms-toggle-read-only q 454 \\C-c \\C-o forms-insert-record
433 C-c C-o forms-insert-record 455 \\C-c \\C-l forms-jump-record l
434 C-c C-l forms-jump-record l 456 \\C-c \\C-n forms-next-record n
435 C-c C-n forms-next-record n 457 \\C-c \\C-p forms-prev-record p
436 C-c C-p forms-prev-record p 458 \\C-c \\C-r forms-search-backward r
437 C-c C-s forms-search s 459 \\C-c \\C-s forms-search-forward s
438 C-c C-x forms-exit x" 460 \\C-c \\C-x forms-exit x
461 "
439 (interactive) 462 (interactive)
440 463
441 ;; This is not a simple major mode, as usual. Therefore, forms-mode 464 ;; This is not a simple major mode, as usual. Therefore, forms-mode
442 ;; takes an optional argument `primary' which is used for the 465 ;; takes an optional argument `primary' which is used for the
443 ;; initial set-up. Normal use would leave `primary' to nil. 466 ;; initial set-up. Normal use would leave `primary' to nil.
464 (make-local-variable 'forms-field-sep) 487 (make-local-variable 'forms-field-sep)
465 (make-local-variable 'forms-read-only) 488 (make-local-variable 'forms-read-only)
466 (make-local-variable 'forms-multi-line) 489 (make-local-variable 'forms-multi-line)
467 (make-local-variable 'forms-forms-scroll) 490 (make-local-variable 'forms-forms-scroll)
468 (make-local-variable 'forms-forms-jump) 491 (make-local-variable 'forms-forms-jump)
492 (make-local-variable 'forms-insert-after)
469 ;; (make-local-variable 'forms-use-text-properties) 493 ;; (make-local-variable 'forms-use-text-properties)
470 494
471 ;; Filter functions. 495 ;; Filter functions.
472 (make-local-variable 'forms-read-file-filter) 496 (make-local-variable 'forms-read-file-filter)
473 (make-local-variable 'forms-write-file-filter) 497 (make-local-variable 'forms-write-file-filter)
478 (setq forms-read-file-filter nil) 502 (setq forms-read-file-filter nil)
479 (setq forms-write-file-filter nil) 503 (setq forms-write-file-filter nil)
480 (setq forms-new-record-filter nil) 504 (setq forms-new-record-filter nil)
481 (setq forms-modified-record-filter nil) 505 (setq forms-modified-record-filter nil)
482 506
483 (if forms--lemacs-p 507 (if forms--lemacs-p ; XEmacs
484 (progn 508 (progn
485 ;; forms-field-face defaults to bold. 509 ;; forms-field-face defaults to bold.
486 ;; forms-label-face defaults to no attributes 510 ;; forms-label-face defaults to no attributes
487 ;; (inherit from default.) 511 ;; (inherit from default.)
488 (make-face 'forms-field-face) 512 (make-face 'forms-field-face)
576 600
577 ;; Dynamic text support. 601 ;; Dynamic text support.
578 (make-local-variable 'forms--dynamic-text) 602 (make-local-variable 'forms--dynamic-text)
579 603
580 ;; Prevent accidental overwrite of the control file and autosave. 604 ;; Prevent accidental overwrite of the control file and autosave.
581 (setq buffer-file-name nil) 605 (set-visited-file-name nil)
582 (auto-save-mode nil)
583 606
584 ;; Prepare this buffer for further processing. 607 ;; Prepare this buffer for further processing.
585 (setq buffer-read-only nil) 608 (setq buffer-read-only nil)
586 (erase-buffer) 609 (erase-buffer)
587 610
619 ;;(message "forms: building keymap...") 642 ;;(message "forms: building keymap...")
620 (forms--mode-commands) 643 (forms--mode-commands)
621 ;;(message "forms: building keymap... done.") 644 ;;(message "forms: building keymap... done.")
622 ) 645 )
623 646
647 ;; set the major mode indicator
648 (setq major-mode 'forms-mode)
649 (setq mode-name "Forms")
650
624 ;; find the data file 651 ;; find the data file
625 (setq forms--file-buffer (find-file-noselect forms-file)) 652 (setq forms--file-buffer (find-file-noselect forms-file))
626 653
627 ;; Pre-transform. 654 ;; Pre-transform.
628 (let ((read-file-filter forms-read-file-filter) 655 (let ((read-file-filter forms-read-file-filter)
629 (write-file-filter forms-write-file-filter)) 656 (write-file-filter forms-write-file-filter))
630 (if read-file-filter 657 (if read-file-filter
631 (save-excursion 658 (save-excursion
632 (set-buffer forms--file-buffer) 659 (set-buffer forms--file-buffer)
633 (let ((inhibit-read-only t)) 660 (let ((inhibit-read-only t)
634 (run-hooks 'read-file-filter)) 661 (file-modified (buffer-modified-p)))
635 (set-buffer-modified-p nil) 662 (run-hooks 'read-file-filter)
663 (if (not file-modified) (set-buffer-modified-p nil)))
636 (if write-file-filter 664 (if write-file-filter
637 (progn 665 (progn
638 (make-variable-buffer-local 'local-write-file-hooks) 666 (make-variable-buffer-local 'local-write-file-hooks)
639 (setq local-write-file-hooks (list write-file-filter))))) 667 (setq local-write-file-hooks (list write-file-filter)))))
640 (if write-file-filter 668 (if write-file-filter
641 (save-excursion 669 (save-excursion
642 (set-buffer forms--file-buffer) 670 (set-buffer forms--file-buffer)
643 (make-variable-buffer-local 'local-write-file-hooks) 671 (make-variable-buffer-local 'local-write-file-hooks)
644 (setq local-write-file-hooks write-file-filter))))) 672 ;; (setq local-write-file-hooks (list write-file-filter))))))
673 (add-hook 'local-write-file-hooks 'write-file-filter)))))
645 674
646 ;; count the number of records, and set see if it may be modified 675 ;; count the number of records, and set see if it may be modified
647 (let (ro) 676 (let (ro)
648 (setq forms--total-records 677 (setq forms--total-records
649 (save-excursion 678 (save-excursion
658 ))) 687 )))
659 (if ro 688 (if ro
660 (setq forms-read-only t))) 689 (setq forms-read-only t)))
661 690
662 ;;(message "forms: proceeding setup...") 691 ;;(message "forms: proceeding setup...")
663 ;; set the major mode indicator
664 (setq major-mode 'forms-mode)
665 (setq mode-name "Forms")
666 692
667 ;; Since we aren't really implementing a minor mode, we hack the modeline 693 ;; Since we aren't really implementing a minor mode, we hack the modeline
668 ;; directly to get the text " View " into forms-read-only form buffers. For 694 ;; directly to get the text " View " into forms-read-only form buffers. For
669 ;; that reason, this variable must be buffer only. 695 ;; that reason, this variable must be buffer only.
670 (make-local-variable 'minor-mode-alist) 696 (make-local-variable 'minor-mode-alist)
682 ;;(message "forms: proceeding setup (new file)...") 708 ;;(message "forms: proceeding setup (new file)...")
683 (progn 709 (progn
684 (insert 710 (insert
685 "GNU Emacs Forms Mode version " forms-version "\n\n" 711 "GNU Emacs Forms Mode version " forms-version "\n\n"
686 (if (file-exists-p forms-file) 712 (if (file-exists-p forms-file)
687 (concat "No records available in file \"" forms-file "\".\n\n") 713 (concat "No records available in file `" forms-file "'\n\n")
688 (format "Creating new file \"%s\"\nwith %d field%s per record.\n\n" 714 (format "Creating new file `%s'\nwith %d field%s per record\n\n"
689 forms-file forms-number-of-fields 715 forms-file forms-number-of-fields
690 (if (= 1 forms-number-of-fields) "" "s"))) 716 (if (= 1 forms-number-of-fields) "" "s")))
691 "Use " (substitute-command-keys "\\[forms-insert-record]") 717 "Use " (substitute-command-keys "\\[forms-insert-record]")
692 " to create new records.\n") 718 " to create new records.\n")
693 (setq forms--current-record 1) 719 (setq forms--current-record 1)
697 ;; setup the first (or current) record to show 723 ;; setup the first (or current) record to show
698 (if (< forms--current-record 1) 724 (if (< forms--current-record 1)
699 (setq forms--current-record 1)) 725 (setq forms--current-record 1))
700 (forms-jump-record forms--current-record) 726 (forms-jump-record forms--current-record)
701 ) 727 )
728
729 (if forms-insert-after
730 (forms-last-record)
731 (forms-first-record))
702 732
703 ;; user customising 733 ;; user customising
704 ;;(message "forms: proceeding setup (user hooks)...") 734 ;;(message "forms: proceeding setup (user hooks)...")
705 (run-hooks 'forms-mode-hooks) 735 (run-hooks 'forms-mode-hooks)
706 ;;(message "forms: setting up... done.") 736 ;;(message "forms: setting up... done.")
715 ;; concatenated. 745 ;; concatenated.
716 ;; Array `forms--elements' is constructed that contains the order 746 ;; Array `forms--elements' is constructed that contains the order
717 ;; of the fields on the display. This array is used by 747 ;; of the fields on the display. This array is used by
718 ;; `forms--parser-using-text-properties' to extract the fields data 748 ;; `forms--parser-using-text-properties' to extract the fields data
719 ;; from the form on the screen. 749 ;; from the form on the screen.
720 ;; Upon completion, `forms-format-list' is garanteed correct, so 750 ;; Upon completion, `forms-format-list' is guaranteed correct, so
721 ;; `forms--make-format' and `forms--make-parser' do not need to perform 751 ;; `forms--make-format' and `forms--make-parser' do not need to perform
722 ;; any checks. 752 ;; any checks.
723 753
724 ;; Verify that `forms-format-list' is not nil. 754 ;; Verify that `forms-format-list' is not nil.
725 (or forms-format-list 755 (or forms-format-list
787 ((listp el) 817 ((listp el)
788 818
789 ;; Validate. 819 ;; Validate.
790 (or (fboundp (car-safe el)) 820 (or (fboundp (car-safe el))
791 (error (concat "Forms format error: " 821 (error (concat "Forms format error: "
792 "not a function " 822 "not a function %S")
793 (prin1-to-string (car-safe el))))) 823 (car-safe el)))
794 824
795 ;; Shift. 825 ;; Shift.
796 (if prev-item 826 (if prev-item
797 (setq forms-format-list 827 (setq forms-format-list
798 (append forms-format-list (list prev-item) nil))) 828 (append forms-format-list (list prev-item) nil)))
799 (setq prev-item el)) 829 (setq prev-item el))
800 830
801 ;; else 831 ;; else
802 (t 832 (t
803 (error (concat "Forms format error: " 833 (error (concat "Forms format error: "
804 "invalid element " 834 "invalid element %S")
805 (prin1-to-string el))))) 835 el)))
806 836
807 ;; Advance to next element of the list. 837 ;; Advance to next element of the list.
808 (setq the-list rem))) 838 (setq the-list rem)))
809 839
810 ;; Append last item. 840 ;; Append last item.
908 forms-format-list))) 938 forms-format-list)))
909 ;; Prevent insertion before the first text. 939 ;; Prevent insertion before the first text.
910 (,@ (if (numberp (car forms-format-list)) 940 (,@ (if (numberp (car forms-format-list))
911 nil 941 nil
912 '((add-text-properties (point-min) (1+ (point-min)) 942 '((add-text-properties (point-min) (1+ (point-min))
913 '(front-sticky (read-only)))))) 943 '(front-sticky (read-only intangible))))))
914 ;; Prevent insertion after the last text. 944 ;; Prevent insertion after the last text.
915 (remove-text-properties (1- (point)) (point) 945 (remove-text-properties (1- (point)) (point)
916 '(rear-nonsticky))) 946 '(rear-nonsticky)))
917 (setq forms--iif-start nil))) 947 (setq forms--iif-start nil)))
918 (if forms-use-extents 948 (if forms-use-extents ; XEmacs version
919 (` (lambda (arg) 949 (` (lambda (arg)
920 (,@ (apply 'append 950 (,@ (apply 'append
921 (mapcar 'forms--make-format-elt-using-extents 951 (mapcar 'forms--make-format-elt-using-extents
922 forms-format-list))) 952 forms-format-list)))
923 953
1036 (progn ; until after insertion 1066 (progn ; until after insertion
1037 (insert (, el)) 1067 (insert (, el))
1038 (point)) 1068 (point))
1039 (list 'face forms--ro-face ; read-only appearance 1069 (list 'face forms--ro-face ; read-only appearance
1040 'read-only (,@ (list (1+ forms--marker))) 1070 'read-only (,@ (list (1+ forms--marker)))
1071 'intangible t
1041 'insert-in-front-hooks '(forms--iif-hook) 1072 'insert-in-front-hooks '(forms--iif-hook)
1042 'rear-nonsticky '(face read-only insert-in-front-hooks)))))) 1073 'rear-nonsticky '(face read-only insert-in-front-hooks
1074 intangible))))))
1043 1075
1044 ((numberp el) 1076 ((numberp el)
1045 (` ((let ((here (point))) 1077 (` ((let ((here (point)))
1046 (aset forms--markers 1078 (aset forms--markers
1047 (, (prog1 forms--marker 1079 (, (prog1 forms--marker
1063 (setq forms--dyntext (1+ forms--dyntext)))) 1095 (setq forms--dyntext (1+ forms--dyntext))))
1064 (, el))) 1096 (, el)))
1065 (point)) 1097 (point))
1066 (list 'face forms--ro-face 1098 (list 'face forms--ro-face
1067 'read-only (,@ (list (1+ forms--marker))) 1099 'read-only (,@ (list (1+ forms--marker)))
1100 'intangible t
1068 'insert-in-front-hooks '(forms--iif-hook) 1101 'insert-in-front-hooks '(forms--iif-hook)
1069 'rear-nonsticky '(read-only face insert-in-front-hooks)))))) 1102 'rear-nonsticky '(read-only face insert-in-front-hooks
1103 intangible))))))
1070 1104
1071 ;; end of cond 1105 ;; end of cond
1072 )) 1106 ))
1073 1107
1108 ;; XEmacs
1074 (defun forms--make-format-elt-using-extents (el) 1109 (defun forms--make-format-elt-using-extents (el)
1075 "Helper routine to generate format function." 1110 "Helper routine to generate format function."
1076 1111
1077 ;; The format routine `forms--format' will look like 1112 ;; The format routine `forms--format' will look like
1078 ;; 1113 ;;
1236 (if (get-text-property here 'read-only) 1271 (if (get-text-property here 'read-only)
1237 (aset forms--recordv (aref forms--elements i) nil) 1272 (aset forms--recordv (aref forms--elements i) nil)
1238 (if (setq there 1273 (if (setq there
1239 (next-single-property-change here 'read-only)) 1274 (next-single-property-change here 'read-only))
1240 (aset forms--recordv (aref forms--elements i) 1275 (aset forms--recordv (aref forms--elements i)
1241 (buffer-substring here there)) 1276 (buffer-substring-no-properties here there))
1242 (aset forms--recordv (aref forms--elements i) 1277 (aset forms--recordv (aref forms--elements i)
1243 (buffer-substring here (point-max))))) 1278 (buffer-substring-no-properties here (point-max)))))
1244 (setq i (1+ i))))) 1279 (setq i (1+ i)))))
1245 1280
1246 (defun forms--make-parser-elt (el) 1281 (defun forms--make-parser-elt (el)
1247 "Helper routine to generate forms parser function." 1282 "Helper routine to generate forms parser function."
1248 1283
1260 ;; ;; 6 1295 ;; ;; 6
1261 ;; ;; "\nmore text: " 1296 ;; ;; "\nmore text: "
1262 ;; (setq here (point)) 1297 ;; (setq here (point))
1263 ;; (if (not (search-forward "\nmore text: " nil t nil)) 1298 ;; (if (not (search-forward "\nmore text: " nil t nil))
1264 ;; (error "Parse error: cannot find \"\\nmore text: \"")) 1299 ;; (error "Parse error: cannot find \"\\nmore text: \""))
1265 ;; (aset forms--recordv 5 (buffer-substring here (- (point) 12))) 1300 ;; (aset forms--recordv 5 (buffer-substring-no-properties here (- (point) 12)))
1266 ;; 1301 ;;
1267 ;; ;; (tocol 40) 1302 ;; ;; (tocol 40)
1268 ;; (let ((forms--dyntext (car-safe forms--dynamic-text))) 1303 ;; (let ((forms--dyntext (car-safe forms--dynamic-text)))
1269 ;; (if (not (looking-at (regexp-quote forms--dyntext))) 1304 ;; (if (not (looking-at (regexp-quote forms--dyntext)))
1270 ;; (error "Parse error: not looking at \"%s\"" forms--dyntext)) 1305 ;; (error "Parse error: not looking at \"%s\"" forms--dyntext))
1271 ;; (forward-char (length forms--dyntext)) 1306 ;; (forward-char (length forms--dyntext))
1272 ;; (setq forms--dynamic-text (cdr-safe forms--dynamic-text))) 1307 ;; (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))
1273 ;; ... 1308 ;; ...
1274 ;; ;; final flush (due to terminator sentinel, see below) 1309 ;; ;; final flush (due to terminator sentinel, see below)
1275 ;; (aset forms--recordv 7 (buffer-substring (point) (point-max))) 1310 ;; (aset forms--recordv 7 (buffer-substring-no-properties (point) (point-max)))
1276 1311
1277 (cond 1312 (cond
1278 ((stringp el) 1313 ((stringp el)
1279 (prog1 1314 (prog1
1280 (if forms--field 1315 (if forms--field
1296 (setq forms--field el) 1331 (setq forms--field el)
1297 nil)) 1332 nil))
1298 ((null el) 1333 ((null el)
1299 (if forms--field 1334 (if forms--field
1300 (` ((aset forms--recordv (, (1- forms--field)) 1335 (` ((aset forms--recordv (, (1- forms--field))
1301 (buffer-substring (point) (point-max))))))) 1336 (buffer-substring-no-properties (point) (point-max)))))))
1302 ((listp el) 1337 ((listp el)
1303 (prog1 1338 (prog1
1304 (if forms--field 1339 (if forms--field
1305 (` ((let ((here (point)) 1340 (` ((let ((here (point))
1306 (forms--dyntext (aref forms--dyntexts (, forms--dyntext)))) 1341 (forms--dyntext (aref forms--dyntexts (, forms--dyntext))))
1307 (if (not (search-forward forms--dyntext nil t nil)) 1342 (if (not (search-forward forms--dyntext nil t nil))
1308 (error "Parse error: cannot find \"%s\"" forms--dyntext)) 1343 (error "Parse error: cannot find \"%s\"" forms--dyntext))
1309 (aset forms--recordv (, (1- forms--field)) 1344 (aset forms--recordv (, (1- forms--field))
1310 (buffer-substring here 1345 (buffer-substring-no-properties here
1311 (- (point) (length forms--dyntext))))))) 1346 (- (point) (length forms--dyntext)))))))
1312 (` ((let ((forms--dyntext (aref forms--dyntexts (, forms--dyntext)))) 1347 (` ((let ((forms--dyntext (aref forms--dyntexts (, forms--dyntext))))
1313 (if (not (looking-at (regexp-quote forms--dyntext))) 1348 (if (not (looking-at (regexp-quote forms--dyntext)))
1314 (error "Parse error: not looking at \"%s\"" forms--dyntext)) 1349 (error "Parse error: not looking at \"%s\"" forms--dyntext))
1315 (forward-char (length forms--dyntext)))))) 1350 (forward-char (length forms--dyntext))))))
1381 (define-key forms-mode-map "\C-q" 'forms-toggle-read-only) 1416 (define-key forms-mode-map "\C-q" 'forms-toggle-read-only)
1382 (define-key forms-mode-map "\C-o" 'forms-insert-record) 1417 (define-key forms-mode-map "\C-o" 'forms-insert-record)
1383 (define-key forms-mode-map "\C-l" 'forms-jump-record) 1418 (define-key forms-mode-map "\C-l" 'forms-jump-record)
1384 (define-key forms-mode-map "\C-n" 'forms-next-record) 1419 (define-key forms-mode-map "\C-n" 'forms-next-record)
1385 (define-key forms-mode-map "\C-p" 'forms-prev-record) 1420 (define-key forms-mode-map "\C-p" 'forms-prev-record)
1386 (define-key forms-mode-map "\C-s" 'forms-search) 1421 (define-key forms-mode-map "\C-r" 'forms-search-backward)
1422 (define-key forms-mode-map "\C-s" 'forms-search-forward)
1387 (define-key forms-mode-map "\C-x" 'forms-exit) 1423 (define-key forms-mode-map "\C-x" 'forms-exit)
1388 (define-key forms-mode-map "<" 'forms-first-record) 1424 (define-key forms-mode-map "<" 'forms-first-record)
1389 (define-key forms-mode-map ">" 'forms-last-record) 1425 (define-key forms-mode-map ">" 'forms-last-record)
1390 (define-key forms-mode-map "?" 'describe-mode) 1426 (define-key forms-mode-map "?" 'describe-mode) ; XEmacs
1391 (define-key forms-mode-map "\C-?" 'forms-prev-record) 1427 (define-key forms-mode-map "\C-?" 'forms-prev-record)
1392 1428
1393 ;; `forms-mode-ro-map' replaces the local map when in read-only mode. 1429 ;; `forms-mode-ro-map' replaces the local map when in read-only mode.
1394 (setq forms-mode-ro-map (make-keymap)) 1430 (setq forms-mode-ro-map (make-keymap))
1395 (suppress-keymap forms-mode-ro-map) 1431 (suppress-keymap forms-mode-ro-map)
1397 (define-key forms-mode-ro-map "\t" 'forms-next-field) 1433 (define-key forms-mode-ro-map "\t" 'forms-next-field)
1398 (define-key forms-mode-ro-map "q" 'forms-toggle-read-only) 1434 (define-key forms-mode-ro-map "q" 'forms-toggle-read-only)
1399 (define-key forms-mode-ro-map "l" 'forms-jump-record) 1435 (define-key forms-mode-ro-map "l" 'forms-jump-record)
1400 (define-key forms-mode-ro-map "n" 'forms-next-record) 1436 (define-key forms-mode-ro-map "n" 'forms-next-record)
1401 (define-key forms-mode-ro-map "p" 'forms-prev-record) 1437 (define-key forms-mode-ro-map "p" 'forms-prev-record)
1402 (define-key forms-mode-ro-map "s" 'forms-search) 1438 (define-key forms-mode-ro-map "r" 'forms-search-backward)
1439 (define-key forms-mode-ro-map "s" 'forms-search-forward)
1403 (define-key forms-mode-ro-map "x" 'forms-exit) 1440 (define-key forms-mode-ro-map "x" 'forms-exit)
1404 (define-key forms-mode-ro-map "<" 'forms-first-record) 1441 (define-key forms-mode-ro-map "<" 'forms-first-record)
1405 (define-key forms-mode-ro-map ">" 'forms-last-record) 1442 (define-key forms-mode-ro-map ">" 'forms-last-record)
1406 (define-key forms-mode-ro-map "?" 'describe-mode) 1443 (define-key forms-mode-ro-map "?" 'describe-mode)
1407 (define-key forms-mode-ro-map " " 'forms-next-record) 1444 (define-key forms-mode-ro-map " " 'forms-next-record)
1408 (forms--mode-commands1 forms-mode-ro-map) 1445 (forms--mode-commands1 forms-mode-ro-map)
1446 (forms--mode-menu-ro forms-mode-ro-map)
1409 1447
1410 ;; This is the normal, local map. 1448 ;; This is the normal, local map.
1411 (setq forms-mode-edit-map (make-keymap)) 1449 (setq forms-mode-edit-map (make-keymap))
1412 (define-key forms-mode-edit-map "\t" 'forms-next-field) 1450 (define-key forms-mode-edit-map "\t" 'forms-next-field)
1413 (define-key forms-mode-edit-map "\C-c" forms-mode-map) 1451 (define-key forms-mode-edit-map "\C-c" forms-mode-map)
1414 (forms--mode-commands1 forms-mode-edit-map) 1452 (forms--mode-commands1 forms-mode-edit-map)
1453 (forms--mode-menu-edit forms-mode-edit-map)
1415 ) 1454 )
1416 1455
1417 (defun forms--mode-commands1 (map) 1456 (defun forms--mode-menu-ro (map)
1457 ;;; Menu initialisation
1458 ; (define-key map [menu-bar] (make-sparse-keymap))
1459 (define-key map [menu-bar forms]
1460 (cons "Forms" (make-sparse-keymap "Forms")))
1461 (define-key map [menu-bar forms menu-forms-exit]
1462 '("Exit Forms Mode" . forms-exit))
1463 (define-key map [menu-bar forms menu-forms-sep1]
1464 '("----"))
1465 (define-key map [menu-bar forms menu-forms-save]
1466 '("Save Data" . forms-save-buffer))
1467 (define-key map [menu-bar forms menu-forms-print]
1468 '("Print Data" . forms-print))
1469 (define-key map [menu-bar forms menu-forms-describe]
1470 '("Describe Mode" . describe-mode))
1471 (define-key map [menu-bar forms menu-forms-toggle-ro]
1472 '("Toggle View/Edit" . forms-toggle-read-only))
1473 (define-key map [menu-bar forms menu-forms-jump-record]
1474 '("Jump" . forms-jump-record))
1475 (define-key map [menu-bar forms menu-forms-search-backward]
1476 '("Search Backward" . forms-search-backward))
1477 (define-key map [menu-bar forms menu-forms-search-forward]
1478 '("Search Forward" . forms-search-forward))
1479 (define-key map [menu-bar forms menu-forms-delete-record]
1480 '("Delete" . forms-delete-record))
1481 (define-key map [menu-bar forms menu-forms-insert-record]
1482 '("Insert" . forms-insert-record))
1483 (define-key map [menu-bar forms menu-forms-sep2]
1484 '("----"))
1485 (define-key map [menu-bar forms menu-forms-last-record]
1486 '("Last Record" . forms-last-record))
1487 (define-key map [menu-bar forms menu-forms-first-record]
1488 '("First Record" . forms-first-record))
1489 (define-key map [menu-bar forms menu-forms-prev-record]
1490 '("Previous Record" . forms-prev-record))
1491 (define-key map [menu-bar forms menu-forms-next-record]
1492 '("Next Record" . forms-next-record))
1493 (define-key map [menu-bar forms menu-forms-sep3]
1494 '("----"))
1495 (define-key map [menu-bar forms menu-forms-prev-field]
1496 '("Previous Field" . forms-prev-field))
1497 (define-key map [menu-bar forms menu-forms-next-field]
1498 '("Next Field" . forms-next-field))
1499 (put 'forms-insert-record 'menu-enable '(not forms-read-only))
1500 (put 'forms-delete-record 'menu-enable '(not forms-read-only))
1501 )
1502 (defun forms--mode-menu-edit (map)
1503 ;;; Menu initialisation
1504 ; (define-key map [menu-bar] (make-sparse-keymap))
1505 (define-key map [menu-bar forms]
1506 (cons "Forms" (make-sparse-keymap "Forms")))
1507 (define-key map [menu-bar forms menu-forms-edit--exit]
1508 '("Exit" . forms-exit))
1509 (define-key map [menu-bar forms menu-forms-edit-sep1]
1510 '("----"))
1511 (define-key map [menu-bar forms menu-forms-edit-save]
1512 '("Save Data" . forms-save-buffer))
1513 (define-key map [menu-bar forms menu-forms-edit-print]
1514 '("Print Data" . forms-print))
1515 (define-key map [menu-bar forms menu-forms-edit-describe]
1516 '("Describe Mode" . describe-mode))
1517 (define-key map [menu-bar forms menu-forms-edit-toggle-ro]
1518 '("Toggle View/Edit" . forms-toggle-read-only))
1519 (define-key map [menu-bar forms menu-forms-edit-jump-record]
1520 '("Jump" . forms-jump-record))
1521 (define-key map [menu-bar forms menu-forms-edit-search-backward]
1522 '("Search Backward" . forms-search-backward))
1523 (define-key map [menu-bar forms menu-forms-edit-search-forward]
1524 '("Search Forward" . forms-search-forward))
1525 (define-key map [menu-bar forms menu-forms-edit-delete-record]
1526 '("Delete" . forms-delete-record))
1527 (define-key map [menu-bar forms menu-forms-edit-insert-record]
1528 '("Insert" . forms-insert-record))
1529 (define-key map [menu-bar forms menu-forms-edit-sep2]
1530 '("----"))
1531 (define-key map [menu-bar forms menu-forms-edit-last-record]
1532 '("Last Record" . forms-last-record))
1533 (define-key map [menu-bar forms menu-forms-edit-first-record]
1534 '("First Record" . forms-first-record))
1535 (define-key map [menu-bar forms menu-forms-edit-prev-record]
1536 '("Previous Record" . forms-prev-record))
1537 (define-key map [menu-bar forms menu-forms-edit-next-record]
1538 '("Next Record" . forms-next-record))
1539 (define-key map [menu-bar forms menu-forms-edit-sep3]
1540 '("----"))
1541 (define-key map [menu-bar forms menu-forms-edit-prev-field]
1542 '("Previous Field" . forms-prev-field))
1543 (define-key map [menu-bar forms menu-forms-edit-next-field]
1544 '("Next Field" . forms-next-field))
1545 (put 'forms-insert-record 'menu-enable '(not forms-read-only))
1546 (put 'forms-delete-record 'menu-enable '(not forms-read-only))
1547 )
1548
1549 (defun forms--mode-commands1 (map)
1418 "Helper routine to define keys." 1550 "Helper routine to define keys."
1419 (if forms--lemacs-p 1551 (if forms--lemacs-p ; XEmacs
1420 (progn 1552 (progn
1421 (define-key map [tab] 'forms-next-field) 1553 (define-key map [tab] 'forms-next-field)
1422 (define-key map [(shift tab)] 'forms-prev-field)) 1554 (define-key map [(shift tab)] 'forms-prev-field))
1423 (define-key map [TAB] 'forms-next-field) 1555 (define-key map [TAB] 'forms-next-field)
1424 (define-key map [S-tab] 'forms-prev-field)) 1556 (define-key map [S-tab] 'forms-prev-field))
1438 ;; scroll-up -> forms-next-record 1570 ;; scroll-up -> forms-next-record
1439 (if forms-forms-scroll 1571 (if forms-forms-scroll
1440 (progn 1572 (progn
1441 (substitute-key-definition 'scroll-up 'forms-next-record 1573 (substitute-key-definition 'scroll-up 'forms-next-record
1442 (current-local-map) 1574 (current-local-map)
1443 ;;(current-global-map) 1575 ;;(current-global-map) ; FSF
1444 ) 1576 )
1445 (substitute-key-definition 'scroll-down 'forms-prev-record 1577 (substitute-key-definition 'scroll-down 'forms-prev-record
1446 (current-local-map) 1578 (current-local-map)
1447 ;;(current-global-map) 1579 ;;(current-global-map) ; FSF
1448 ))) 1580 )))
1449 ;; 1581 ;;
1450 ;; beginning-of-buffer -> forms-first-record 1582 ;; beginning-of-buffer -> forms-first-record
1451 ;; end-of-buffer -> forms-end-record 1583 ;; end-of-buffer -> forms-end-record
1452 (if forms-forms-jump 1584 (if forms-forms-jump
1453 (progn 1585 (progn
1454 (substitute-key-definition 'beginning-of-buffer 'forms-first-record 1586 (substitute-key-definition 'beginning-of-buffer 'forms-first-record
1455 (current-local-map) 1587 (current-local-map)
1456 ;;(current-global-map) 1588 ;;(current-global-map) ; FSF
1457 ) 1589 )
1458 (substitute-key-definition 'end-of-buffer 'forms-last-record 1590 (substitute-key-definition 'end-of-buffer 'forms-last-record
1459 (current-local-map) 1591 (current-local-map)
1460 ;;(current-global-map) 1592 ;;(current-global-map) ;FSF
1461 ))) 1593 )))
1462 ;; 1594 ;;
1463 ;; Save buffer 1595 ;; Save buffer
1464 (local-set-key "\C-x\C-s" 'forms-save-buffer) 1596 (local-set-key "\C-x\C-s" 'forms-save-buffer)
1465 ;; 1597 ;;
1469 1601
1470 t) 1602 t)
1471 1603
1472 (defun forms--help () 1604 (defun forms--help ()
1473 "Initial help for Forms mode." 1605 "Initial help for Forms mode."
1474 (message (substitute-command-keys (concat 1606 (message "%s" (substitute-command-keys (concat
1475 "\\[forms-next-record]:next" 1607 "\\[forms-next-record]:next"
1476 " \\[forms-prev-record]:prev" 1608 " \\[forms-prev-record]:prev"
1477 " \\[forms-first-record]:first" 1609 " \\[forms-first-record]:first"
1478 " \\[forms-last-record]:last" 1610 " \\[forms-last-record]:last"
1479 " \\[describe-mode]:help")))) 1611 " \\[describe-mode]:help"))))
1517 (or (bolp) 1649 (or (bolp)
1518 (beginning-of-line nil)) 1650 (beginning-of-line nil))
1519 (let ((here (point))) 1651 (let ((here (point)))
1520 (prog2 1652 (prog2
1521 (end-of-line) 1653 (end-of-line)
1522 (buffer-substring here (point)) 1654 (buffer-substring-no-properties here (point))
1523 (goto-char here)))) 1655 (goto-char here))))
1524 1656
1525 (defun forms--show-record (the-record) 1657 (defun forms--show-record (the-record)
1526 "Format THE-RECORD and display it in the current buffer." 1658 "Format THE-RECORD and display it in the current buffer."
1527 1659
1548 (erase-buffer) 1680 (erase-buffer)
1549 1681
1550 ;; Verify the number of fields, extend forms--the-record-list if needed. 1682 ;; Verify the number of fields, extend forms--the-record-list if needed.
1551 (if (= (length forms--the-record-list) forms-number-of-fields) 1683 (if (= (length forms--the-record-list) forms-number-of-fields)
1552 nil 1684 nil
1553 (beep) 1685 (if (null forms-check-number-of-fields)
1554 (message "Warning: this record has %d fields instead of %d" 1686 nil
1555 (length forms--the-record-list) forms-number-of-fields) 1687 (beep)
1688 (message "Warning: this record has %d fields instead of %d"
1689 (length forms--the-record-list) forms-number-of-fields))
1556 (if (< (length forms--the-record-list) forms-number-of-fields) 1690 (if (< (length forms--the-record-list) forms-number-of-fields)
1557 (setq forms--the-record-list 1691 (setq forms--the-record-list
1558 (append forms--the-record-list 1692 (append forms--the-record-list
1559 (make-list 1693 (make-list
1560 (- forms-number-of-fields 1694 (- forms-number-of-fields
1568 ;; Prepare. 1702 ;; Prepare.
1569 (goto-char (point-min)) 1703 (goto-char (point-min))
1570 (set-buffer-modified-p nil) 1704 (set-buffer-modified-p nil)
1571 (setq buffer-read-only forms-read-only) 1705 (setq buffer-read-only forms-read-only)
1572 (setq mode-line-process 1706 (setq mode-line-process
1573 (format " %d/%d" forms--current-record forms--total-records))) 1707 (concat " " forms--current-record "/" forms--total-records)))
1574 1708
1575 (defun forms--parse-form () 1709 (defun forms--parse-form ()
1576 "Parse contents of form into list of strings." 1710 "Parse contents of form into list of strings."
1577 ;; The contents of the form are parsed, and a new list of strings 1711 ;; The contents of the form are parsed, and a new list of strings
1578 ;; is constructed. 1712 ;; is constructed.
1759 ;;; Other commands 1893 ;;; Other commands
1760 1894
1761 (defun forms-toggle-read-only (arg) 1895 (defun forms-toggle-read-only (arg)
1762 "Toggles read-only mode of a forms mode buffer. 1896 "Toggles read-only mode of a forms mode buffer.
1763 With an argument, enables read-only mode if the argument is positive. 1897 With an argument, enables read-only mode if the argument is positive.
1764 Otherwise enables edit mode if the visited file is writeable." 1898 Otherwise enables edit mode if the visited file is writable."
1765 1899
1766 (interactive "P") 1900 (interactive "P")
1767 1901
1768 (if (if arg 1902 (if (if arg
1769 ;; Negative arg means switch it off. 1903 ;; Negative arg means switch it off.
1776 (if (save-excursion 1910 (if (save-excursion
1777 (set-buffer forms--file-buffer) 1911 (set-buffer forms--file-buffer)
1778 buffer-read-only) 1912 buffer-read-only)
1779 (progn 1913 (progn
1780 (setq forms-read-only t) 1914 (setq forms-read-only t)
1781 (message "No write access to \"%s\"" forms-file) 1915 (message "No write access to `%s'" forms-file)
1782 (beep)) 1916 (beep))
1783 (setq forms-read-only nil)) 1917 (setq forms-read-only nil))
1784 (if (equal ro forms-read-only) 1918 (if (equal ro forms-read-only)
1785 nil 1919 nil
1786 (forms-mode))) 1920 (forms-mode)))
1802 1936
1803 (defun forms-insert-record (arg) 1937 (defun forms-insert-record (arg)
1804 "Create a new record before the current one. 1938 "Create a new record before the current one.
1805 With ARG: store the record after the current one. 1939 With ARG: store the record after the current one.
1806 If `forms-new-record-filter' contains the name of a function, 1940 If `forms-new-record-filter' contains the name of a function,
1807 it is called to fill (some of) the fields with default values." 1941 it is called to fill (some of) the fields with default values.
1942 If `forms-insert-after is non-nil, the default behavior is to insert
1943 after the current record."
1808 1944
1809 (interactive "P") 1945 (interactive "P")
1810 1946
1811 (if forms-read-only 1947 (if forms-read-only
1812 (error "")) 1948 (error ""))
1813 1949
1814 (let ((ln (if arg (1+ forms--current-record) forms--current-record)) 1950 (let (ln the-list the-record)
1815 the-list the-record) 1951
1952 (if (or (and arg forms-insert-after)
1953 (and (not arg) (not forms-insert-after)))
1954 (setq ln forms--current-record)
1955 (setq ln (1+ forms--current-record)))
1816 1956
1817 (forms--checkmod) 1957 (forms--checkmod)
1818 (if forms-new-record-filter 1958 (if forms-new-record-filter
1819 ;; As a service to the user, we add a zeroth element so she 1959 ;; As a service to the user, we add a zeroth element so she
1820 ;; can use the same indices as in the forms definition. 1960 ;; can use the same indices as in the forms definition.
1863 (if (> forms--current-record forms--total-records) 2003 (if (> forms--current-record forms--total-records)
1864 (setq forms--current-record forms--total-records)) 2004 (setq forms--current-record forms--total-records))
1865 (forms-jump-record forms--current-record))) 2005 (forms-jump-record forms--current-record)))
1866 (message "")) 2006 (message ""))
1867 2007
1868 (defun forms-search (regexp) 2008 (defun forms-search-forward (regexp)
1869 "Search REGEXP in file buffer." 2009 "Search forward for record containing REGEXP."
1870 (interactive 2010 (interactive
1871 (list (read-string (concat "Search for" 2011 (list (read-string (concat "Search forward for"
1872 (if forms--search-regexp 2012 (if forms--search-regexp
1873 (concat " (" 2013 (concat " ("
1874 forms--search-regexp 2014 forms--search-regexp
1875 ")")) 2015 ")"))
1876 ": ")))) 2016 ": "))))
1885 (setq here (point)) 2025 (setq here (point))
1886 (end-of-line) 2026 (end-of-line)
1887 (if (null (re-search-forward regexp nil t)) 2027 (if (null (re-search-forward regexp nil t))
1888 (progn 2028 (progn
1889 (goto-char here) 2029 (goto-char here)
1890 (message (concat "\"" regexp "\" not found.")) 2030 (message "\"%s\" not found" regexp)
2031 nil)
2032 (setq the-record (forms--get-record))
2033 (setq the-line (1+ (count-lines (point-min) (point))))))
2034 (progn
2035 (setq forms--current-record the-line)
2036 (forms--show-record the-record)
2037 (re-search-forward regexp nil t))))
2038 (setq forms--search-regexp regexp))
2039
2040 (defun forms-search-backward (regexp)
2041 "Search backward for record containing REGEXP."
2042 (interactive
2043 (list (read-string (concat "Search backward for"
2044 (if forms--search-regexp
2045 (concat " ("
2046 forms--search-regexp
2047 ")"))
2048 ": "))))
2049 (if (equal "" regexp)
2050 (setq regexp forms--search-regexp))
2051 (forms--checkmod)
2052
2053 (let (the-line the-record here
2054 (fld-sep forms-field-sep))
2055 (if (save-excursion
2056 (set-buffer forms--file-buffer)
2057 (setq here (point))
2058 (beginning-of-line)
2059 (if (null (re-search-backward regexp nil t))
2060 (progn
2061 (goto-char here)
2062 (message "\"%s\" not found" regexp)
1891 nil) 2063 nil)
1892 (setq the-record (forms--get-record)) 2064 (setq the-record (forms--get-record))
1893 (setq the-line (1+ (count-lines (point-min) (point)))))) 2065 (setq the-line (1+ (count-lines (point-min) (point))))))
1894 (progn 2066 (progn
1895 (setq forms--current-record the-line) 2067 (setq forms--current-record the-line)
1927 (interactive "p") 2099 (interactive "p")
1928 2100
1929 (let ((i 0) 2101 (let ((i 0)
1930 (here (point)) 2102 (here (point))
1931 there 2103 there
1932 (cnt 0)) 2104 (cnt 0)
2105 (inhibit-point-motion-hooks t))
1933 2106
1934 (if (zerop arg) 2107 (if (zerop arg)
1935 (setq cnt 1) 2108 (setq cnt 1)
1936 (setq cnt (+ cnt arg))) 2109 (setq cnt (+ cnt arg)))
1937 2110
1953 (interactive "p") 2126 (interactive "p")
1954 2127
1955 (let ((i (length forms--markers)) 2128 (let ((i (length forms--markers))
1956 (here (point)) 2129 (here (point))
1957 there 2130 there
1958 (cnt 0)) 2131 (cnt 0)
2132 (inhibit-point-motion-hooks t))
1959 2133
1960 (if (zerop arg) 2134 (if (zerop arg)
1961 (setq cnt 1) 2135 (setq cnt 1)
1962 (setq cnt (+ cnt arg))) 2136 (setq cnt (+ cnt arg)))
1963 2137
1971 (progn 2145 (progn
1972 (goto-char there) 2146 (goto-char there)
1973 (throw 'done t)))))) 2147 (throw 'done t))))))
1974 nil 2148 nil
1975 (goto-char (aref forms--markers (1- (length forms--markers))))))) 2149 (goto-char (aref forms--markers (1- (length forms--markers)))))))
2150
2151 (defun forms-print ()
2152 "Send the records to the printer with 'print-buffer', one record per page."
2153 (interactive)
2154 (let ((inhibit-read-only t)
2155 (save-record forms--current-record)
2156 (nb-record 1)
2157 (record nil))
2158 (while (<= nb-record forms--total-records)
2159 (forms-jump-record nb-record)
2160 (setq record (buffer-string))
2161 (save-excursion
2162 (set-buffer (get-buffer-create "*forms-print*"))
2163 (goto-char (buffer-end 1))
2164 (insert record)
2165 (setq buffer-read-only nil)
2166 (if (< nb-record forms--total-records)
2167 (insert "\n \n")))
2168 (setq nb-record (1+ nb-record)))
2169 (save-excursion
2170 (set-buffer "*forms-print*")
2171 (print-buffer)
2172 (set-buffer-modified-p nil)
2173 (kill-buffer (current-buffer)))
2174 (forms-jump-record save-record)))
2175
1976 ;;; 2176 ;;;
1977 ;;; Special service 2177 ;;; Special service
1978 ;;; 2178 ;;;
1979 (defun forms-enumerate (the-fields) 2179 (defun forms-enumerate (the-fields)
1980 "Take a quoted list of symbols, and set their values to sequential numbers. 2180 "Take a quoted list of symbols, and set their values to sequential numbers.
1981 The first symbol gets number 1, the second 2 and so on. 2181 The first symbol gets number 1, the second 2 and so on.
1982 It returns the higest number. 2182 It returns the highest number.
1983 2183
1984 Usage: (setq forms-number-of-fields 2184 Usage: (setq forms-number-of-fields
1985 (forms-enumerate 2185 (forms-enumerate
1986 '(field1 field2 field2 ...)))" 2186 '(field1 field2 field2 ...)))"
1987 2187