276
|
1 ;;; Forms Mode - A GNU Emacs Major Mode ; @(#)@ forms 1.2.2
|
|
2 ;;; Created 1989 - Johan Vromans <jv@mh.nl>
|
|
3 ;;; See the docs for a list of other contributors.
|
|
4 ;;;
|
|
5 ;;; This file is part of GNU Emacs.
|
|
6
|
|
7 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
8 ;;; but WITHOUT ANY WARRANTY. No author or distributor
|
|
9 ;;; accepts responsibility to anyone for the consequences of using it
|
|
10 ;;; or for whether it serves any particular purpose or works at all,
|
|
11 ;;; unless he says so in writing. Refer to the GNU Emacs General Public
|
|
12 ;;; License for full details.
|
|
13
|
|
14 ;;; Everyone is granted permission to copy, modify and redistribute
|
|
15 ;;; GNU Emacs, but only under the conditions described in the
|
|
16 ;;; GNU Emacs General Public License. A copy of this license is
|
|
17 ;;; supposed to have been given to you along with GNU Emacs so you
|
|
18 ;;; can know your rights and responsibilities.
|
|
19 ;;; If you don't have this copy, write to the Free Software
|
|
20 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
21 ;;;
|
|
22
|
|
23 (provide 'forms-mode)
|
|
24
|
|
25 ;;; Visit a file using a form.
|
|
26 ;;;
|
|
27 ;;; === Naming conventions
|
|
28 ;;;
|
|
29 ;;; The names of all variables and functions start with 'form-'.
|
|
30 ;;; Names which start with 'form--' are intended for internal use, and
|
|
31 ;;; should *NOT* be used from the outside.
|
|
32 ;;;
|
|
33 ;;; All variables are buffer-local, to enable multiple forms visits
|
|
34 ;;; simultaneously.
|
|
35 ;;; Variable 'forms--mode-setup' is local to *ALL* buffers, for it
|
|
36 ;;; controls if forms-mode has been enabled in a buffer.
|
|
37 ;;;
|
|
38 ;;; === How it works ===
|
|
39 ;;;
|
|
40 ;;; Forms mode means visiting a data file which is supposed to consist
|
|
41 ;;; of records each containing a number of fields. The records are
|
|
42 ;;; separated by a newline, the fields are separated by a user-defined
|
|
43 ;;; field separater (default: TAB).
|
|
44 ;;; When shown, a record is transferred to an emacs buffer and
|
|
45 ;;; presented using a user-defined form. One record is shown at a
|
|
46 ;;; time.
|
|
47 ;;;
|
|
48 ;;; Forms mode is a composite mode. It involves two files, and two
|
|
49 ;;; buffers.
|
|
50 ;;; The first file, called the control file, defines the name of the
|
|
51 ;;; data file and the forms format. This file buffer will be used to
|
|
52 ;;; present the forms.
|
|
53 ;;; The second file holds the actual data. The buffer of this file
|
|
54 ;;; will be buried, for it is never accessed directly.
|
|
55 ;;;
|
|
56 ;;; Forms mode is invoked using "forms-find-file control-file".
|
|
57 ;;; Alternativily forms-find-file-other-window can be used.
|
|
58 ;;;
|
|
59 ;;; You may also visit the control file, and switch to forms mode by hand
|
|
60 ;;; with M-x forms-mode .
|
|
61 ;;;
|
|
62 ;;; Automatic mode switching is supported, so you may use "find-file"
|
|
63 ;;; if you specify "-*- forms -*-" in the first line of the control file.
|
|
64 ;;;
|
|
65 ;;; The control file is visited, evaluated using
|
|
66 ;;; eval-current-buffer, and should set at least the following
|
|
67 ;;; variables:
|
|
68 ;;;
|
|
69 ;;; forms-file [string] the name of the data file.
|
|
70 ;;;
|
|
71 ;;; forms-number-of-fields [integer]
|
|
72 ;;; The number of fields in each record.
|
|
73 ;;;
|
|
74 ;;; forms-format-list [list] formatting instructions.
|
|
75 ;;;
|
|
76 ;;; The forms-format-list should be a list, each element containing
|
|
77 ;;;
|
|
78 ;;; - either a string, e.g. "hello" (which is inserted \"as is\"),
|
|
79 ;;;
|
|
80 ;;; - an integer, denoting a field number. The contents of the field
|
|
81 ;;; are inserted at this point.
|
|
82 ;;; The first field has number one.
|
|
83 ;;;
|
|
84 ;;; Optional variables which may be set in the control file:
|
|
85 ;;;
|
|
86 ;;; forms-field-sep [string, default TAB]
|
|
87 ;;; The field separator used to separate the
|
|
88 ;;; fields in the data file. It may be a string.
|
|
89 ;;;
|
|
90 ;;; forms-read-only [bool, default nil]
|
|
91 ;;; 't' means that the data file is visited read-only.
|
|
92 ;;; If no write access to the data file is
|
|
93 ;;; possible, read-only mode is enforced.
|
|
94 ;;;
|
|
95 ;;; forms-multi-line [string, default "^K"]
|
|
96 ;;; If non-null the records of the data file may
|
|
97 ;;; contain fields which span multiple lines in
|
|
98 ;;; the form.
|
|
99 ;;; This variable denoted the separator character
|
|
100 ;;; to be used for this purpose. Upon display, all
|
|
101 ;;; occurrencies of this character are translated
|
|
102 ;;; to newlines. Upon storage they are translated
|
|
103 ;;; back to the separator.
|
|
104 ;;;
|
|
105 ;;; forms-forms-scroll [bool, default t]
|
|
106 ;;; If non-nil: redefine scroll-up/down to perform
|
|
107 ;;; forms-next/prev-field if in forms mode.
|
|
108 ;;;
|
|
109 ;;; forms-forms-jump [bool, default t]
|
|
110 ;;; If non-nil: redefine beginning/end-of-buffer
|
|
111 ;;; to performs forms-first/last-field if in
|
|
112 ;;; forms mode.
|
|
113 ;;;
|
|
114 ;;; forms-new-record-filter [function, no default]
|
|
115 ;;; If defined: this function is called when a new
|
|
116 ;;; record is created. It can be used to fill in
|
|
117 ;;; the new record with default fields, for example.
|
|
118 ;;;
|
|
119 ;;; After evaluating the control file, its buffer is cleared and used
|
|
120 ;;; for further processing.
|
|
121 ;;; The data file (as designated by "forms-file") is visited in a buffer
|
|
122 ;;; (forms--file-buffer) which will not normally be shown.
|
|
123 ;;; Great malfunctioning may be expected if this file/buffer is modified
|
|
124 ;;; outside of this package while it's being visited!
|
|
125 ;;;
|
|
126 ;;; A record from the data file is transferred from the data file,
|
|
127 ;;; split into fields (into forms--the-record-list), and displayed using
|
|
128 ;;; the specs in forms-format-list.
|
|
129 ;;; A format routine 'forms--format' is build upon startup to format
|
|
130 ;;; the records.
|
|
131 ;;;
|
|
132 ;;; When a form is changed the record is updated as soon as this form
|
|
133 ;;; is left. The contents of the form are parsed using forms-format-list,
|
|
134 ;;; and the fields which are deduced from the form are modified. So,
|
|
135 ;;; fields not shown on the forms retain their origional values.
|
|
136 ;;; The newly formed record and replaces the contents of the
|
|
137 ;;; old record in forms--file-buffer.
|
|
138 ;;; A parse routine 'forms--parser' is build upon startup to parse
|
|
139 ;;; the records.
|
|
140 ;;;
|
|
141 ;;; Two exit functions exist: forms-exit (which saves) and forms-exit-no-save
|
|
142 ;;; (which doesn't). However, if forms-exit-no-save is executed and the file
|
|
143 ;;; buffer has been modified, emacs will ask questions.
|
|
144 ;;;
|
|
145 ;;; Other functions are:
|
|
146 ;;;
|
|
147 ;;; paging (forward, backward) by record
|
|
148 ;;; jumping (first, last, random number)
|
|
149 ;;; searching
|
|
150 ;;; creating and deleting records
|
|
151 ;;; reverting the form (NOT the file buffer)
|
|
152 ;;; switching edit <-> view mode v.v.
|
|
153 ;;; jumping from field to field
|
|
154 ;;;
|
|
155 ;;; As an documented side-effect: jumping to the last record in the
|
|
156 ;;; file (using forms-last-record) will adjust forms--total-records if
|
|
157 ;;; needed.
|
|
158 ;;;
|
|
159 ;;; Commands and keymaps:
|
|
160 ;;;
|
|
161 ;;; A local keymap 'forms-mode-map' is used in the forms buffer.
|
|
162 ;;; As conventional, this map can be accessed with C-c prefix.
|
|
163 ;;; In read-only mode, the C-c prefix must be omitted.
|
|
164 ;;;
|
|
165 ;;; Default bindings:
|
|
166 ;;;
|
|
167 ;;; \C-c forms-mode-map
|
|
168 ;;; TAB forms-next-field
|
|
169 ;;; SPC forms-next-record
|
|
170 ;;; < forms-first-record
|
|
171 ;;; > forms-last-record
|
|
172 ;;; ? describe-mode
|
|
173 ;;; d forms-delete-record
|
|
174 ;;; e forms-edit-mode
|
|
175 ;;; i forms-insert-record
|
|
176 ;;; j forms-jump-record
|
|
177 ;;; n forms-next-record
|
|
178 ;;; p forms-prev-record
|
|
179 ;;; q forms-exit
|
|
180 ;;; s forms-search
|
|
181 ;;; v forms-view-mode
|
|
182 ;;; x forms-exit-no-save
|
|
183 ;;; DEL forms-prev-record
|
|
184 ;;;
|
|
185 ;;; Standard functions scroll-up, scroll-down, beginning-of-buffer and
|
|
186 ;;; end-of-buffer are wrapped with re-definitions, which map them to
|
|
187 ;;; next/prev record and first/last record.
|
|
188 ;;; Buffer-local variables forms-forms-scroll and forms-forms-jump
|
|
189 ;;; may be used to control these redefinitions.
|
|
190 ;;;
|
|
191 ;;; Function save-buffer is also wrapped to perform a sensible action.
|
|
192 ;;; A revert-file-hook is defined to revert a forms to original.
|
|
193 ;;;
|
|
194 ;;; For convenience, TAB is always bound to forms-next-field, so you
|
|
195 ;;; don't need the C-c prefix for this command.
|
|
196 ;;;
|
|
197 ;;; Global variables and constants
|
|
198
|
|
199 (defconst forms-version "1.2.2"
|
|
200 "Version of forms-mode implementation")
|
|
201
|
|
202 (defvar forms-forms-scrolls t
|
|
203 "If non-null: redefine scroll-up/down to be used with forms-mode.")
|
|
204
|
|
205 (defvar forms-forms-jumps t
|
|
206 "If non-null: redefine beginning/end-of-buffer to be used with forms-mode.")
|
|
207
|
|
208 (defvar forms-mode-hooks nil
|
|
209 "Hook functions to be run upon entering forms mode.")
|
|
210 ;;;
|
|
211 ;;; Mandatory variables - must be set by evaluating the control file
|
|
212
|
|
213 (defvar forms-file nil
|
|
214 "Name of the file holding the data.")
|
|
215
|
|
216 (defvar forms-format-list nil
|
|
217 "Formatting specifications:
|
|
218
|
|
219 It should be a list, each element containing
|
|
220
|
|
221 - either a string, e.g. "hello" (which is inserted \"as is\"),
|
|
222
|
|
223 - an integer, denoting the number of a field which contents are
|
|
224 inserted at this point.
|
|
225 The first field has number one.
|
|
226 ")
|
|
227
|
|
228 (defvar forms-number-of-fields nil
|
|
229 "Number of fields per record.")
|
|
230
|
|
231 ;;;
|
|
232 ;;; Optional variables with default values
|
|
233
|
|
234 (defvar forms-field-sep "\t"
|
|
235 "Field separator character (default TAB)")
|
|
236
|
|
237 (defvar forms-read-only nil
|
|
238 "Read-only mode (defaults to the write access on the data file).")
|
|
239
|
|
240 (defvar forms-multi-line "\C-k"
|
|
241 "Character to separate multi-line fields (default ^K)")
|
|
242
|
|
243 (defvar forms-forms-scroll t
|
|
244 "Redefine scroll-up/down to perform forms-next/prev-record when in
|
|
245 forms mode.")
|
|
246
|
|
247 (defvar forms-forms-jump t
|
|
248 "Redefine beginning/end-of-buffer to perform forms-first/last-record
|
|
249 when in forms mode.")
|
|
250
|
|
251 ;;;
|
|
252 ;;; Internal variables.
|
|
253
|
|
254 (defvar forms--file-buffer nil
|
|
255 "Buffer which holds the file data")
|
|
256
|
|
257 (defvar forms--total-records 0
|
|
258 "Total number of records in the data file.")
|
|
259
|
|
260 (defvar forms--current-record 0
|
|
261 "Number of the record currently on the screen.")
|
|
262
|
|
263 (defvar forms-mode-map nil ; yes - this one is global
|
|
264 "Keymap for form buffer.")
|
|
265
|
|
266 (defvar forms--markers nil
|
|
267 "Field markers in the screen.")
|
|
268
|
|
269 (defvar forms--number-of-markers 0
|
|
270 "Number of fields on screen.")
|
|
271
|
|
272 (defvar forms--the-record-list nil
|
|
273 "List of strings of the current record, as parsed from the file.")
|
|
274
|
|
275 (defvar forms--search-regexp nil
|
|
276 "Last regexp used by forms-search.")
|
|
277
|
|
278 (defvar forms--format nil
|
|
279 "Formatting routine.")
|
|
280
|
|
281 (defvar forms--parser nil
|
|
282 "Forms parser routine.")
|
|
283
|
|
284 (defvar forms--mode-setup nil
|
|
285 "Internal - keeps track of forms-mode being set-up.")
|
|
286 (make-variable-buffer-local 'forms--mode-setup)
|
|
287
|
|
288 (defvar forms--new-record-filter nil
|
|
289 "Internal - set if a new record filter has been defined.")
|
|
290
|
|
291 ;;;
|
|
292 ;;; forms-mode
|
|
293 ;;;
|
|
294 ;;; This is not a simple major mode, as usual. Therefore, forms-mode
|
|
295 ;;; takes an optional argument 'primary' which is used for the initial
|
|
296 ;;; set-up. Normal use would leave 'primary' to nil.
|
|
297 ;;;
|
|
298 ;;; A global buffer-local variable 'forms--mode-setup' has the same effect
|
|
299 ;;; but makes it possible to auto-invoke forms-mode using find-file.
|
|
300 ;;;
|
|
301 ;;; Note: although it seems logical to have (make-local-variable) executed
|
|
302 ;;; where the variable is first needed, I deliberately placed all calls
|
|
303 ;;; in the forms-mode function.
|
|
304
|
|
305 (defun forms-mode (&optional primary)
|
|
306 "Major mode to visit files in a field-structured manner using a form.
|
|
307
|
|
308 Commands (prefix with C-c if not in read-only mode):
|
|
309 \\{forms-mode-map}"
|
|
310
|
|
311 (interactive) ; no - 'primary' is not prefix arg
|
|
312
|
|
313 ;; Primary set-up: evaluate buffer and check if the mandatory
|
|
314 ;; variables have been set.
|
|
315 (if (or primary (not forms--mode-setup))
|
|
316 (progn
|
|
317 (kill-all-local-variables)
|
|
318
|
|
319 ;; make mandatory variables
|
|
320 (make-local-variable 'forms-file)
|
|
321 (make-local-variable 'forms-number-of-fields)
|
|
322 (make-local-variable 'forms-format-list)
|
|
323
|
|
324 ;; make optional variables
|
|
325 (make-local-variable 'forms-field-sep)
|
|
326 (make-local-variable 'forms-read-only)
|
|
327 (make-local-variable 'forms-multi-line)
|
|
328 (make-local-variable 'forms-forms-scroll)
|
|
329 (make-local-variable 'forms-forms-jump)
|
|
330 (fmakunbound 'forms-new-record-filter)
|
|
331
|
|
332 ;; eval the buffer, should set variables
|
|
333 (eval-current-buffer)
|
|
334
|
|
335 ;; check if the mandatory variables make sense.
|
|
336 (or forms-file
|
|
337 (error "'forms-file' has not been set"))
|
|
338 (or forms-number-of-fields
|
|
339 (error "'forms-number-of-fields' has not been set"))
|
|
340 (or (> forms-number-of-fields 0)
|
|
341 (error "'forms-number-of-fields' must be > 0")
|
|
342 (or (stringp forms-field-sep))
|
|
343 (error "'forms-field-sep' is not a string"))
|
|
344 (if forms-multi-line
|
|
345 (if (and (stringp forms-multi-line)
|
|
346 (eq (length forms-multi-line) 1))
|
|
347 (if (string= forms-multi-line forms-field-sep)
|
|
348 (error "'forms-multi-line' is equal to 'forms-field-sep'"))
|
|
349 (error "'forms-multi-line' must be nil or a one-character string")))
|
|
350
|
|
351 ;; validate and process forms-format-list
|
|
352 (make-local-variable 'forms--number-of-markers)
|
|
353 (make-local-variable 'forms--markers)
|
|
354 (forms--process-format-list)
|
|
355
|
|
356 ;; build the formatter and parser
|
|
357 (make-local-variable 'forms--format)
|
|
358 (forms--make-format)
|
|
359 (make-local-variable 'forms--parser)
|
|
360 (forms--make-parser)
|
|
361
|
|
362 ;; check if a new record filter was defined
|
|
363 (make-local-variable 'forms--new-record-filter)
|
|
364 (setq forms--new-record-filter
|
|
365 (and (fboundp 'forms-new-record-filter)
|
|
366 (symbol-function 'forms-new-record-filter)))
|
|
367 (fmakunbound 'forms-new-record-filter)
|
|
368
|
|
369
|
|
370 ;; prepare this buffer for further processing
|
|
371 (setq buffer-read-only nil)
|
|
372
|
|
373 ;; prevent accidental overwrite of the control file and autosave
|
|
374 (setq buffer-file-name nil)
|
|
375 (auto-save-mode nil)
|
|
376
|
|
377 ;; and clean it
|
|
378 (erase-buffer)))
|
|
379
|
|
380 ;; make local variables
|
|
381 (make-local-variable 'forms--file-buffer)
|
|
382 (make-local-variable 'forms--total-records)
|
|
383 (make-local-variable 'forms--current-record)
|
|
384 (make-local-variable 'forms--the-record-list)
|
|
385 (make-local-variable 'forms--search-rexexp)
|
|
386
|
|
387 ;; A bug in the current Emacs release prevents a keymap
|
|
388 ;; which is buffer-local from being used by 'describe-mode'.
|
|
389 ;; Hence we'll leave it global.
|
|
390 ;;(make-local-variable 'forms-mode-map)
|
|
391 (if forms-mode-map ; already defined
|
|
392 nil
|
|
393 (setq forms-mode-map (make-keymap))
|
|
394 (forms--mode-commands forms-mode-map)
|
|
395 (forms--change-commands))
|
|
396
|
|
397 ;; find the data file
|
|
398 (setq forms--file-buffer (find-file-noselect forms-file))
|
|
399
|
|
400 ;; count the number of records, and set see if it may be modified
|
|
401 (let (ro)
|
|
402 (setq forms--total-records
|
|
403 (save-excursion
|
|
404 (set-buffer forms--file-buffer)
|
|
405 (bury-buffer (current-buffer))
|
|
406 (setq ro buffer-read-only)
|
|
407 (count-lines (point-min) (point-max))))
|
|
408 (if ro
|
|
409 (setq forms-read-only t)))
|
|
410
|
|
411 ;; set the major mode indicator
|
|
412 (setq major-mode 'forms-mode)
|
|
413 (setq mode-name "Forms")
|
|
414 (make-local-variable 'minor-mode-alist) ; needed?
|
|
415 (forms--set-minor-mode)
|
|
416 (forms--set-keymaps)
|
|
417
|
|
418 (set-buffer-modified-p nil)
|
|
419
|
|
420 ;; We have our own revert function - use it
|
|
421 (make-local-variable 'revert-buffer-function)
|
|
422 (setq revert-buffer-function 'forms-revert-buffer)
|
|
423
|
|
424 ;; setup the first (or current) record to show
|
|
425 (if (< forms--current-record 1)
|
|
426 (setq forms--current-record 1))
|
|
427 (forms-jump-record forms--current-record)
|
|
428
|
|
429 ;; user customising
|
|
430 (run-hooks 'forms-mode-hooks)
|
|
431
|
|
432 ;; be helpful
|
|
433 (forms--help)
|
|
434
|
|
435 ;; initialization done
|
|
436 (setq forms--mode-setup t))
|
|
437
|
|
438 ;;;
|
|
439 ;;; forms-process-format-list
|
|
440 ;;;
|
|
441 ;;; Validates forms-format-list.
|
|
442 ;;;
|
|
443 ;;; Sets forms--number-of-markers and forms--markers.
|
|
444
|
|
445 (defun forms--process-format-list ()
|
|
446 "Validate forms-format-list and set some global variables."
|
|
447
|
|
448 ;; it must be non-nil
|
|
449 (or forms-format-list
|
|
450 (error "'forms-format-list' has not been set"))
|
|
451 ;; it must be a list ...
|
|
452 (or (listp forms-format-list)
|
|
453 (error "'forms-format-list' is not a list"))
|
|
454
|
|
455 (setq forms--number-of-markers 0)
|
|
456
|
|
457 (let ((the-list forms-format-list) ; the list of format elements
|
|
458 (field-num 0)) ; highest field number
|
|
459
|
|
460 (while the-list
|
|
461
|
|
462 (let ((el (car-safe the-list))
|
|
463 (rem (cdr-safe the-list)))
|
|
464
|
|
465 (cond
|
|
466
|
|
467 ;; try string ...
|
|
468 ((stringp el)) ; string is OK
|
|
469
|
|
470 ;; try int ...
|
|
471 ((numberp el) ; check it
|
|
472
|
|
473 (if (or (<= el 0)
|
|
474 (> el forms-number-of-fields))
|
|
475 (error
|
|
476 "forms error: field number %d out of range 1..%d"
|
|
477 el forms-number-of-fields))
|
|
478
|
|
479 (setq forms--number-of-markers (1+ forms--number-of-markers))
|
|
480 (if (> el field-num)
|
|
481 (setq field-num el)))
|
|
482
|
|
483 ;; else
|
|
484 (t
|
|
485 (error "invalid element in 'forms-format-list': %s"
|
|
486 (prin1-to-string el)))
|
|
487
|
|
488 ;; dead code - we'll need it in the future
|
|
489 ((consp el) ; check it
|
|
490
|
|
491 (let ((str (car-safe el))
|
|
492 (idx (cdr-safe el)))
|
|
493
|
|
494 (cond
|
|
495
|
|
496 ;; car must be string
|
|
497 ((not (stringp str))
|
|
498 (error "forms error: car of cons %s must be string"
|
|
499 (prin1-to-string el)))
|
|
500
|
|
501 ;; cdr must be number, > zero
|
|
502 ((or (not (numberp idx))
|
|
503 (<= idx 0)
|
|
504 (> idx forms-number-of-fields))
|
|
505 (error
|
|
506 "forms error: cdr of cons %s must be a number between 1 and %d"
|
|
507 (prin1-to-string el)
|
|
508 forms-number-of-fields)))
|
|
509
|
|
510 ;; passed the test - handle it
|
|
511 (setq forms--number-of-markers (1+ forms--number-of-markers))
|
|
512 (if (> idx field-num)
|
|
513 (setq field-num idx)))))
|
|
514
|
|
515 ;; advance to next element of the list
|
|
516 (setq the-list rem))))
|
|
517
|
|
518 (setq forms--markers (make-vector forms--number-of-markers nil)))
|
|
519
|
|
520
|
|
521 ;;;
|
|
522 ;;; Build the format routine from forms-format-list.
|
|
523 ;;;
|
|
524 ;;; The format routine (forms--format) will look like
|
|
525 ;;;
|
|
526 ;;; (lambda (arg)
|
|
527 ;;;
|
|
528 ;;; ;; "text: "
|
|
529 ;;; (insert "text: ")
|
|
530 ;;; ;; 6
|
|
531 ;;; (aset forms--markers 0 (point-marker))
|
|
532 ;;; (insert (elt arg 5))
|
|
533 ;;; ;; "\nmore text: "
|
|
534 ;;; (insert "\nmore text: ")
|
|
535 ;;; ;; 9
|
|
536 ;;; (aset forms--markers 1 (point-marker))
|
|
537 ;;; (insert (elt arg 8))
|
|
538 ;;;
|
|
539 ;;; ... )
|
|
540 ;;;
|
|
541
|
|
542 (defun forms--make-format ()
|
|
543 "Generate parser function for forms"
|
|
544 (setq forms--format (forms--format-maker forms-format-list)))
|
|
545
|
|
546 (defun forms--format-maker (the-format-list)
|
|
547 "Returns the parser function for forms"
|
|
548 (let ((the-marker 0))
|
|
549 (` (lambda (arg)
|
|
550 (,@ (apply 'append
|
|
551 (mapcar 'forms--make-format-elt
|
|
552 (forms--concat-adjacent the-format-list))))))))
|
|
553
|
|
554 (defun forms--make-format-elt (el)
|
|
555 (cond ((stringp el)
|
|
556 (` ((insert (, el)))))
|
|
557 ((numberp el)
|
|
558 (prog1
|
|
559 (` ((aset forms--markers (, the-marker) (point-marker))
|
|
560 (insert (elt arg (, (1- el))))))
|
|
561 (setq the-marker (1+ the-marker))))))
|
|
562
|
|
563
|
|
564 (defun forms--concat-adjacent (the-list)
|
|
565 "Concatenate adjacent strings in the-list and return the resulting list"
|
|
566 (if (consp the-list)
|
|
567 (let ((the-rest (forms--concat-adjacent (cdr the-list))))
|
|
568 (if (and (stringp (car the-list)) (stringp (car the-rest)))
|
|
569 (cons (concat (car the-list) (car the-rest))
|
|
570 (cdr the-rest))
|
|
571 (cons (car the-list) the-rest)))
|
|
572 the-list))
|
|
573 ;;;
|
|
574 ;;; forms--make-parser.
|
|
575 ;;;
|
|
576 ;;; Generate parse routine from forms-format-list.
|
|
577 ;;;
|
|
578 ;;; The parse routine (forms--parser) will look like (give or take
|
|
579 ;;; a few " " .
|
|
580 ;;;
|
|
581 ;;; (lambda nil
|
|
582 ;;; (let (here)
|
|
583 ;;; (goto-char (point-min))
|
|
584 ;;;
|
|
585 ;;; ;; "text: "
|
|
586 ;;; (if (not (looking-at "text: "))
|
|
587 ;;; (error "parse error: cannot find \"text: \""))
|
|
588 ;;; (forward-char 6) ; past "text: "
|
|
589 ;;;
|
|
590 ;;; ;; 6
|
|
591 ;;; ;; "\nmore text: "
|
|
592 ;;; (setq here (point))
|
|
593 ;;; (if (not (search-forward "\nmore text: " nil t nil))
|
|
594 ;;; (error "parse error: cannot find \"\\nmore text: \""))
|
|
595 ;;; (aset the-recordv 5 (buffer-substring here (- (point) 12)))
|
|
596 ;;; ...
|
|
597 ;;; ...
|
|
598 ;;; ;; final flush (due to terminator sentinel, see below)
|
|
599 ;;; (aset the-recordv 7 (buffer-substring (point) (point-max)))
|
|
600 ;;;
|
|
601
|
|
602 (defun forms--make-parser ()
|
|
603 "Generate parser function for forms"
|
|
604 (setq forms--parser (forms--parser-maker forms-format-list)))
|
|
605
|
|
606 (defun forms--parser-maker (the-format-list)
|
|
607 "Returns the parser function for forms"
|
|
608 (let ((the-field nil)
|
|
609 (seen-text nil)
|
|
610 the--format-list)
|
|
611 ;; concat adjacent strings and add a terminator sentinel
|
|
612 (setq the--format-list
|
|
613 (append (forms--concat-adjacent the-format-list) (list nil)))
|
|
614 (` (lambda nil
|
|
615 (let (here)
|
|
616 (goto-char (point-min))
|
|
617 (,@ (apply 'append
|
|
618 (mapcar 'forms--make-parser-elt the--format-list))))))))
|
|
619
|
|
620 (defun forms--make-parser-elt (el)
|
|
621 (cond ((stringp el)
|
|
622 (prog1
|
|
623 (if the-field
|
|
624 (` ((setq here (point))
|
|
625 (if (not (search-forward (, el) nil t nil))
|
|
626 (error "Parse error: cannot find %s" (, el)))
|
|
627 (aset the-recordv (, (1- the-field))
|
|
628 (buffer-substring here
|
|
629 (- (point) (, (length el)))))))
|
|
630 (` ((if (not (looking-at (, (regexp-quote el))))
|
|
631 (error "Parse error: not looking at %s" (, el)))
|
|
632 (forward-char (, (length el))))))
|
|
633 (setq seen-text t)
|
|
634 (setq the-field nil)))
|
|
635 ((numberp el)
|
|
636 (if the-field
|
|
637 (error "Cannot parse adjacent fields %d and %d"
|
|
638 the-field el)
|
|
639 (setq the-field el)
|
|
640 nil))
|
|
641 ((null el)
|
|
642 (if the-field
|
|
643 (` ((aset the-recordv (, (1- the-field))
|
|
644 (buffer-substring (point) (point-max)))))))))
|
|
645 ;;;
|
|
646
|
|
647 (defun forms--set-minor-mode ()
|
|
648 (setq minor-mode-alist
|
|
649 (if forms-read-only
|
|
650 " View"
|
|
651 nil)))
|
|
652
|
|
653 (defun forms--set-keymaps ()
|
|
654 "Set the keymaps used in this mode."
|
|
655
|
|
656 (if forms-read-only
|
|
657 (use-local-map forms-mode-map)
|
|
658 (use-local-map (make-sparse-keymap))
|
|
659 (define-key (current-local-map) "\C-c" forms-mode-map)
|
|
660 (define-key (current-local-map) "\t" 'forms-next-field)))
|
|
661
|
|
662 (defun forms--mode-commands (map)
|
|
663 "Fill map with all commands."
|
|
664 (define-key map "\t" 'forms-next-field)
|
|
665 (define-key map " " 'forms-next-record)
|
|
666 (define-key map "d" 'forms-delete-record)
|
|
667 (define-key map "e" 'forms-edit-mode)
|
|
668 (define-key map "i" 'forms-insert-record)
|
|
669 (define-key map "j" 'forms-jump-record)
|
|
670 (define-key map "n" 'forms-next-record)
|
|
671 (define-key map "p" 'forms-prev-record)
|
|
672 (define-key map "q" 'forms-exit)
|
|
673 (define-key map "s" 'forms-search)
|
|
674 (define-key map "v" 'forms-view-mode)
|
|
675 (define-key map "x" 'forms-exit-no-save)
|
|
676 (define-key map "<" 'forms-first-record)
|
|
677 (define-key map ">" 'forms-last-record)
|
|
678 (define-key map "?" 'describe-mode)
|
|
679 (define-key map "\177" 'forms-prev-record)
|
|
680 ; (define-key map "\C-c" map)
|
|
681 (define-key map "\e" 'ESC-prefix)
|
|
682 (define-key map "\C-x" ctl-x-map)
|
|
683 (define-key map "\C-u" 'universal-argument)
|
|
684 (define-key map "\C-h" help-map)
|
|
685 )
|
|
686 ;;;
|
|
687 ;;; Changed functions
|
|
688 ;;;
|
|
689 ;;; Emacs (as of 18.55) lacks the functionality of buffer-local
|
|
690 ;;; funtions. Therefore we save the original meaning of some handy
|
|
691 ;;; functions, and replace them with a wrapper.
|
|
692
|
|
693 (defun forms--change-commands ()
|
|
694 "Localize some commands."
|
|
695 ;;
|
|
696 ;; scroll-down -> forms-prev-record
|
|
697 ;;
|
|
698 (if (fboundp 'forms--scroll-down)
|
|
699 nil
|
|
700 (fset 'forms--scroll-down (symbol-function 'scroll-down))
|
|
701 (fset 'scroll-down
|
|
702 '(lambda (arg)
|
|
703 (interactive "P")
|
|
704 (if (and forms--mode-setup
|
|
705 forms-forms-scroll)
|
|
706 (forms-prev-record arg)
|
|
707 (forms--scroll-down arg)))))
|
|
708 ;;
|
|
709 ;; scroll-up -> forms-next-record
|
|
710 ;;
|
|
711 (if (fboundp 'forms--scroll-up)
|
|
712 nil
|
|
713 (fset 'forms--scroll-up (symbol-function 'scroll-up))
|
|
714 (fset 'scroll-up
|
|
715 '(lambda (arg)
|
|
716 (interactive "P")
|
|
717 (if (and forms--mode-setup
|
|
718 forms-forms-scroll)
|
|
719 (forms-next-record arg)
|
|
720 (forms--scroll-up arg)))))
|
|
721 ;;
|
|
722 ;; beginning-of-buffer -> forms-first-record
|
|
723 ;;
|
|
724 (if (fboundp 'forms--beginning-of-buffer)
|
|
725 nil
|
|
726 (fset 'forms--beginning-of-buffer (symbol-function 'beginning-of-buffer))
|
|
727 (fset 'beginning-of-buffer
|
|
728 '(lambda ()
|
|
729 (interactive)
|
|
730 (if (and forms--mode-setup
|
|
731 forms-forms-jump)
|
|
732 (forms-first-record)
|
|
733 (forms--beginning-of-buffer)))))
|
|
734 ;;
|
|
735 ;; end-of-buffer -> forms-end-record
|
|
736 ;;
|
|
737 (if (fboundp 'forms--end-of-buffer)
|
|
738 nil
|
|
739 (fset 'forms--end-of-buffer (symbol-function 'end-of-buffer))
|
|
740 (fset 'end-of-buffer
|
|
741 '(lambda ()
|
|
742 (interactive)
|
|
743 (if (and forms--mode-setup
|
|
744 forms-forms-jump)
|
|
745 (forms-last-record)
|
|
746 (forms--end-of-buffer)))))
|
|
747 ;;
|
|
748 ;; save-buffer -> forms--save-buffer
|
|
749 ;;
|
|
750 (if (fboundp 'forms--save-buffer)
|
|
751 nil
|
|
752 (fset 'forms--save-buffer (symbol-function 'save-buffer))
|
|
753 (fset 'save-buffer
|
|
754 '(lambda (&optional arg)
|
|
755 (interactive "p")
|
|
756 (if forms--mode-setup
|
|
757 (progn
|
|
758 (forms--checkmod)
|
|
759 (save-excursion
|
|
760 (set-buffer forms--file-buffer)
|
|
761 (forms--save-buffer arg)))
|
|
762 (forms--save-buffer arg)))))
|
|
763 ;;
|
|
764 )
|
|
765
|
|
766 (defun forms--help ()
|
|
767 "Initial help."
|
|
768 ;; We should use
|
|
769 ;;(message (substitute-command-keys (concat
|
|
770 ;;"\\[forms-next-record]:next"
|
|
771 ;;" \\[forms-prev-record]:prev"
|
|
772 ;;" \\[forms-first-record]:first"
|
|
773 ;;" \\[forms-last-record]:last"
|
|
774 ;;" \\[describe-mode]:help"
|
|
775 ;;" \\[forms-exit]:exit")))
|
|
776 ;; but it's too slow ....
|
|
777 (if forms-read-only
|
|
778 (message "SPC:next DEL:prev <:first >:last ?:help q:exit")
|
|
779 (message "C-c n:next C-c p:prev C-c <:first C-c >:last C-c ?:help C-c q:exit")))
|
|
780
|
|
781 (defun forms--trans (subj arg rep)
|
|
782 "Translate in SUBJ all chars ARG into char REP. ARG and REP should
|
|
783 be single-char strings."
|
|
784 (let ((i 0)
|
|
785 (x (length subj))
|
|
786 (re (regexp-quote arg))
|
|
787 (k (string-to-char rep)))
|
|
788 (while (setq i (string-match re subj i))
|
|
789 (aset subj i k)
|
|
790 (setq i (1+ i)))))
|
|
791
|
|
792 (defun forms--exit (query &optional save)
|
|
793 (let ((buf (buffer-name forms--file-buffer)))
|
|
794 (forms--checkmod)
|
|
795 (if (and save
|
|
796 (buffer-modified-p forms--file-buffer))
|
|
797 (save-excursion
|
|
798 (set-buffer forms--file-buffer)
|
|
799 (save-buffer)))
|
|
800 (save-excursion
|
|
801 (set-buffer forms--file-buffer)
|
|
802 (delete-auto-save-file-if-necessary)
|
|
803 (kill-buffer (current-buffer)))
|
|
804 (if (get-buffer buf) ; not killed???
|
|
805 (if save
|
|
806 (progn
|
|
807 (beep)
|
|
808 (message "Problem saving buffers?")))
|
|
809 (delete-auto-save-file-if-necessary)
|
|
810 (kill-buffer (current-buffer)))))
|
|
811
|
|
812 (defun forms--get-record ()
|
|
813 "Fetch the current record from the file buffer."
|
|
814 ;;
|
|
815 ;; This function is executed in the context of the forms--file-buffer.
|
|
816 ;;
|
|
817 (or (bolp)
|
|
818 (beginning-of-line nil))
|
|
819 (let ((here (point)))
|
|
820 (prog2
|
|
821 (end-of-line)
|
|
822 (buffer-substring here (point))
|
|
823 (goto-char here))))
|
|
824
|
|
825 (defun forms--show-record (the-record)
|
|
826 "Format THE-RECORD according to forms-format-list,
|
|
827 and display it in the current buffer."
|
|
828
|
|
829 ;; split the-record
|
|
830 (let (the-result
|
|
831 (start-pos 0)
|
|
832 found-pos
|
|
833 (field-sep-length (length forms-field-sep)))
|
|
834 (if forms-multi-line
|
|
835 (forms--trans the-record forms-multi-line "\n"))
|
|
836 ;; add an extra separator (makes splitting easy)
|
|
837 (setq the-record (concat the-record forms-field-sep))
|
|
838 (while (setq found-pos (string-match forms-field-sep the-record start-pos))
|
|
839 (let ((ent (substring the-record start-pos found-pos)))
|
|
840 (setq the-result
|
|
841 (append the-result (list ent)))
|
|
842 (setq start-pos (+ field-sep-length found-pos))))
|
|
843 (setq forms--the-record-list the-result))
|
|
844
|
|
845 (setq buffer-read-only nil)
|
|
846 (erase-buffer)
|
|
847
|
|
848 ;; verify the number of fields, extend forms--the-record-list if needed
|
|
849 (if (= (length forms--the-record-list) forms-number-of-fields)
|
|
850 nil
|
|
851 (beep)
|
|
852 (message "Record has %d fields instead of %d."
|
|
853 (length forms--the-record-list) forms-number-of-fields)
|
|
854 (if (< (length forms--the-record-list) forms-number-of-fields)
|
|
855 (setq forms--the-record-list
|
|
856 (append forms--the-record-list
|
|
857 (make-list
|
|
858 (- forms-number-of-fields
|
|
859 (length forms--the-record-list))
|
|
860 "")))))
|
|
861
|
|
862 ;; call the formatter function
|
|
863 (funcall forms--format forms--the-record-list)
|
|
864
|
|
865 ;; prepare
|
|
866 (goto-char (point-min))
|
|
867 (set-buffer-modified-p nil)
|
|
868 (setq buffer-read-only forms-read-only)
|
|
869 (setq mode-line-process
|
|
870 (concat " " forms--current-record "/" forms--total-records)))
|
|
871
|
|
872 (defun forms--parse-form ()
|
|
873 "Parse contents of form into list of strings."
|
|
874 ;; The contents of the form are parsed, and a new list of strings
|
|
875 ;; is constructed.
|
|
876 ;; A vector with the strings from the original record is
|
|
877 ;; constructed, which is updated with the new contents. Therefore
|
|
878 ;; fields which were not in the form are not modified.
|
|
879 ;; Finally, the vector is transformed into a list for further processing.
|
|
880
|
|
881 (let (the-recordv)
|
|
882
|
|
883 ;; build the vector
|
|
884 (setq the-recordv (vconcat forms--the-record-list))
|
|
885
|
|
886 ;; parse the form and update the vector
|
|
887 (funcall forms--parser)
|
|
888
|
|
889 ;; transform to a list and return
|
|
890 (append the-recordv nil)))
|
|
891
|
|
892 (defun forms--update ()
|
|
893 "Update current record with contents of form. As a side effect: sets
|
|
894 forms--the-record-list ."
|
|
895 (if forms-read-only
|
|
896 (progn
|
|
897 (message "Read-only buffer!")
|
|
898 (beep))
|
|
899
|
|
900 (let (the-record)
|
|
901 ;; build new record
|
|
902 (setq forms--the-record-list (forms--parse-form))
|
|
903 (setq the-record
|
|
904 (mapconcat 'identity forms--the-record-list forms-field-sep))
|
|
905
|
|
906 ;; handle multi-line fields, if allowed
|
|
907 (if forms-multi-line
|
|
908 (forms--trans the-record "\n" forms-multi-line))
|
|
909
|
|
910 ;; a final sanity check before updating
|
|
911 (if (string-match "\n" the-record)
|
|
912 (progn
|
|
913 (message "Multi-line fields in this record - update refused!")
|
|
914 (beep))
|
|
915
|
|
916 (save-excursion
|
|
917 (set-buffer forms--file-buffer)
|
|
918 ;; Insert something before kill-line is called. See kill-line
|
|
919 ;; doc. Bugfix provided by Ignatios Souvatzis.
|
|
920 (insert "*")
|
|
921 (beginning-of-line)
|
|
922 (kill-line nil)
|
|
923 (insert the-record)
|
|
924 (beginning-of-line))))))
|
|
925
|
|
926 (defun forms--checkmod ()
|
|
927 "Check if this form has been modified, and call forms--update if so."
|
|
928 (if (buffer-modified-p nil)
|
|
929 (let ((here (point)))
|
|
930 (forms--update)
|
|
931 (set-buffer-modified-p nil)
|
|
932 (goto-char here))))
|
|
933
|
|
934 ;;;
|
|
935 ;;; Start and exit
|
|
936 (defun forms-find-file (fn)
|
|
937 "Visit file FN in forms mode"
|
|
938 (interactive "fForms file: ")
|
|
939 (find-file-read-only fn)
|
|
940 (or forms--mode-setup (forms-mode t)))
|
|
941
|
|
942 (defun forms-find-file-other-window (fn)
|
|
943 "Visit file FN in form mode in other window"
|
|
944 (interactive "fFbrowse file in other window: ")
|
|
945 (find-file-other-window fn)
|
|
946 (eval-current-buffer)
|
|
947 (or forms--mode-setup (forms-mode t)))
|
|
948
|
|
949 (defun forms-exit (query)
|
|
950 "Normal exit. Modified buffers are saved."
|
|
951 (interactive "P")
|
|
952 (forms--exit query t))
|
|
953
|
|
954 (defun forms-exit-no-save (query)
|
|
955 "Exit without saving buffers."
|
|
956 (interactive "P")
|
|
957 (forms--exit query nil))
|
|
958
|
|
959 ;;;
|
|
960 ;;; Navigating commands
|
|
961
|
|
962 (defun forms-next-record (arg)
|
|
963 "Advance to the ARGth following record."
|
|
964 (interactive "P")
|
|
965 (forms-jump-record (+ forms--current-record (prefix-numeric-value arg)) t))
|
|
966
|
|
967 (defun forms-prev-record (arg)
|
|
968 "Advance to the ARGth previous record."
|
|
969 (interactive "P")
|
|
970 (forms-jump-record (- forms--current-record (prefix-numeric-value arg)) t))
|
|
971
|
|
972 (defun forms-jump-record (arg &optional relative)
|
|
973 "Jump to a random record."
|
|
974 (interactive "NRecord number: ")
|
|
975
|
|
976 ;; verify that the record number is within range
|
|
977 (if (or (> arg forms--total-records)
|
|
978 (<= arg 0))
|
|
979 (progn
|
|
980 (beep)
|
|
981 ;; don't give the message if just paging
|
|
982 (if (not relative)
|
|
983 (message "Record number %d out of range 1..%d"
|
|
984 arg forms--total-records))
|
|
985 )
|
|
986
|
|
987 ;; flush
|
|
988 (forms--checkmod)
|
|
989
|
|
990 ;; calculate displacement
|
|
991 (let ((disp (- arg forms--current-record))
|
|
992 (cur forms--current-record))
|
|
993
|
|
994 ;; forms--show-record needs it now
|
|
995 (setq forms--current-record arg)
|
|
996
|
|
997 ;; get the record and show it
|
|
998 (forms--show-record
|
|
999 (save-excursion
|
|
1000 (set-buffer forms--file-buffer)
|
|
1001 (beginning-of-line)
|
|
1002
|
|
1003 ;; move, and adjust the amount if needed (shouldn't happen)
|
|
1004 (if relative
|
|
1005 (if (zerop disp)
|
|
1006 nil
|
|
1007 (setq cur (+ cur disp (- (forward-line disp)))))
|
|
1008 (setq cur (+ cur disp (- (goto-line arg)))))
|
|
1009
|
|
1010 (forms--get-record)))
|
|
1011
|
|
1012 ;; this shouldn't happen
|
|
1013 (if (/= forms--current-record cur)
|
|
1014 (progn
|
|
1015 (setq forms--current-record cur)
|
|
1016 (beep)
|
|
1017 (message "Stuck at record %d." cur))))))
|
|
1018
|
|
1019 (defun forms-first-record ()
|
|
1020 "Jump to first record."
|
|
1021 (interactive)
|
|
1022 (forms-jump-record 1))
|
|
1023
|
|
1024 (defun forms-last-record ()
|
|
1025 "Jump to last record. As a side effect: re-calculates the number
|
|
1026 of records in the data file."
|
|
1027 (interactive)
|
|
1028 (let
|
|
1029 ((numrec
|
|
1030 (save-excursion
|
|
1031 (set-buffer forms--file-buffer)
|
|
1032 (count-lines (point-min) (point-max)))))
|
|
1033 (if (= numrec forms--total-records)
|
|
1034 nil
|
|
1035 (beep)
|
|
1036 (setq forms--total-records numrec)
|
|
1037 (message "Number of records reset to %d." forms--total-records)))
|
|
1038 (forms-jump-record forms--total-records))
|
|
1039
|
|
1040 ;;;
|
|
1041 ;;; Other commands
|
|
1042 (defun forms-view-mode ()
|
|
1043 "Visit buffer read-only."
|
|
1044 (interactive)
|
|
1045 (if forms-read-only
|
|
1046 nil
|
|
1047 (forms--checkmod) ; sync
|
|
1048 (setq forms-read-only t)
|
|
1049 (forms-mode)))
|
|
1050
|
|
1051 (defun forms-edit-mode ()
|
|
1052 "Make form suitable for editing, if possible."
|
|
1053 (interactive)
|
|
1054 (let ((ro forms-read-only))
|
|
1055 (if (save-excursion
|
|
1056 (set-buffer forms--file-buffer)
|
|
1057 buffer-read-only)
|
|
1058 (progn
|
|
1059 (setq forms-read-only t)
|
|
1060 (message "No write access to \"%s\"" forms-file)
|
|
1061 (beep))
|
|
1062 (setq forms-read-only nil))
|
|
1063 (if (equal ro forms-read-only)
|
|
1064 nil
|
|
1065 (forms-mode))))
|
|
1066
|
|
1067 ;; Sample:
|
|
1068 ;; (defun forms-new-record-filter (the-fields)
|
|
1069 ;; ;; numbers are relative to 1
|
|
1070 ;; (aset the-fields 4 (current-time-string))
|
|
1071 ;; (aset the-fields 6 (user-login-name))
|
|
1072 ;; the-list)
|
|
1073
|
|
1074 (defun forms-insert-record (arg)
|
|
1075 "Create a new record before the current one. With ARG: store the
|
|
1076 record after the current one.
|
|
1077 If a function forms-new-record-filter is defined, is is called to
|
|
1078 fill (some of) the fields with default values."
|
|
1079 ; The above doc is not true, but for documentary purposes only
|
|
1080
|
|
1081 (interactive "P")
|
|
1082
|
|
1083 (let ((ln (if arg (1+ forms--current-record) forms--current-record))
|
|
1084 the-list the-record)
|
|
1085
|
|
1086 (forms--checkmod)
|
|
1087 (if forms--new-record-filter
|
|
1088 ;; As a service to the user, we add a zeroth element so she
|
|
1089 ;; can use the same indices as in the forms definition.
|
|
1090 (let ((the-fields (make-vector (1+ forms-number-of-fields) "")))
|
|
1091 (setq the-fields (funcall forms--new-record-filter the-fields))
|
|
1092 (setq the-list (cdr (append the-fields nil))))
|
|
1093 (setq the-list (make-list forms-number-of-fields "")))
|
|
1094
|
|
1095 (setq the-record
|
|
1096 (mapconcat
|
|
1097 'identity
|
|
1098 the-list
|
|
1099 forms-field-sep))
|
|
1100
|
|
1101 (save-excursion
|
|
1102 (set-buffer forms--file-buffer)
|
|
1103 (goto-line ln)
|
|
1104 (open-line 1)
|
|
1105 (insert the-record)
|
|
1106 (beginning-of-line))
|
|
1107
|
|
1108 (setq forms--current-record ln))
|
|
1109
|
|
1110 (setq forms--total-records (1+ forms--total-records))
|
|
1111 (forms-jump-record forms--current-record))
|
|
1112
|
|
1113 (defun forms-delete-record (arg)
|
|
1114 "Deletes a record. With ARG: don't ask."
|
|
1115 (interactive "P")
|
|
1116 (forms--checkmod)
|
|
1117 (if (or arg
|
|
1118 (y-or-n-p "Really delete this record? "))
|
|
1119 (let ((ln forms--current-record))
|
|
1120 (save-excursion
|
|
1121 (set-buffer forms--file-buffer)
|
|
1122 (goto-line ln)
|
|
1123 (kill-line 1))
|
|
1124 (setq forms--total-records (1- forms--total-records))
|
|
1125 (if (> forms--current-record forms--total-records)
|
|
1126 (setq forms--current-record forms--total-records))
|
|
1127 (forms-jump-record forms--current-record)))
|
|
1128 (message ""))
|
|
1129
|
|
1130 (defun forms-search (regexp)
|
|
1131 "Search REGEXP in file buffer."
|
|
1132 (interactive
|
|
1133 (list (read-string (concat "Search for"
|
|
1134 (if forms--search-regexp
|
|
1135 (concat " ("
|
|
1136 forms--search-regexp
|
|
1137 ")"))
|
|
1138 ": "))))
|
|
1139 (if (equal "" regexp)
|
|
1140 (setq regexp forms--search-regexp))
|
|
1141 (forms--checkmod)
|
|
1142
|
|
1143 (let (the-line the-record here
|
|
1144 (fld-sep forms-field-sep))
|
|
1145 (if (save-excursion
|
|
1146 (set-buffer forms--file-buffer)
|
|
1147 (setq here (point))
|
|
1148 (end-of-line)
|
|
1149 (if (null (re-search-forward regexp nil t))
|
|
1150 (progn
|
|
1151 (goto-char here)
|
|
1152 (message (concat "\"" regexp "\" not found."))
|
|
1153 nil)
|
|
1154 (setq the-record (forms--get-record))
|
|
1155 (setq the-line (1+ (count-lines (point-min) (point))))))
|
|
1156 (progn
|
|
1157 (setq forms--current-record the-line)
|
|
1158 (forms--show-record the-record)
|
|
1159 (re-search-forward regexp nil t))))
|
|
1160 (setq forms--search-regexp regexp))
|
|
1161
|
|
1162 (defun forms-revert-buffer (&optional arg noconfirm)
|
|
1163 "Reverts current form to un-modified."
|
|
1164 (interactive "P")
|
|
1165 (if (or noconfirm
|
|
1166 (yes-or-no-p "Revert form to unmodified? "))
|
|
1167 (progn
|
|
1168 (set-buffer-modified-p nil)
|
|
1169 (forms-jump-record forms--current-record))))
|
|
1170
|
|
1171 (defun forms-next-field (arg)
|
|
1172 "Jump to ARG-th next field."
|
|
1173 (interactive "p")
|
|
1174
|
|
1175 (let ((i 0)
|
|
1176 (here (point))
|
|
1177 there
|
|
1178 (cnt 0))
|
|
1179
|
|
1180 (if (zerop arg)
|
|
1181 (setq cnt 1)
|
|
1182 (setq cnt (+ cnt arg)))
|
|
1183
|
|
1184 (if (catch 'done
|
|
1185 (while (< i forms--number-of-markers)
|
|
1186 (if (or (null (setq there (aref forms--markers i)))
|
|
1187 (<= there here))
|
|
1188 nil
|
|
1189 (if (<= (setq cnt (1- cnt)) 0)
|
|
1190 (progn
|
|
1191 (goto-char there)
|
|
1192 (throw 'done t))))
|
|
1193 (setq i (1+ i))))
|
|
1194 nil
|
|
1195 (goto-char (aref forms--markers 0)))))
|