Mercurial > hg > xemacs-beta

comparison lisp/utils/forms.el @ 4:b82b59fe008d r19-15b3

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