aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1993-09-27 02:19:46 +0000
committerRichard M. Stallman1993-09-27 02:19:46 +0000
commit2cc27dd3d24573bbd673768c2182a73be599b313 (patch)
tree62442c5feb9004c57c3b139b50b52d603d781215
parent8dff74b7f67583444230734a9f775d8f6d3b8f65 (diff)
downloademacs-2cc27dd3d24573bbd673768c2182a73be599b313.tar.gz
emacs-2cc27dd3d24573bbd673768c2182a73be599b313.zip
Version 2.3.
Documentation: `forms-forms-scroll' and `forms-forms-jump' now default to nil. `forms-new-record-filter' and `forms-modified-record-filter' cannot be redefined as functions. Commands and keymaps are changed. Add function key defs. (forms-version): Docstring includes full RCS id. (forms-forms-scroll): Defaults to nil. (forms-forms-jump): Defaults to nil. (forms-mode-edit-map, forms-mode-ro-map): Additional keymaps for edit mode and read-only mode. (forms--new-record-filter, forms--modified-record-filter): Deleted. (forms-mode): Docstring now includes the key bindings, since both edit mode and read-only mode must be supported. Changed `forms-new-record-filter' and `forms-modified-record-filter' semantics: the variable must point to a function and may not be defined as a function anymore. Use three keymaps: `forms-mode-map' (C-c commands), `forms-mode-edit-map' (normal mode) and `forms-mode-ro-map' (read-only mode). The maps are not buffer local. Changed the text of error messages to be more descriptive, and onsistent with the documentation. Moved setting up write-file-hooks and revert-buffer-function to function `forms--change-commands'. (forms--process-format-list): Changed error messages to be more descriptive. (forms--set-keymaps): Setup the three keymaps. (forms--mode-commands): Use new command key bindings. (forms--mode-commands1): New helper function for `forms--mode-commands'. (forms--change-commands): Handle setup of local-write-file-hooks and revert-buffer-function. (forms--help): Show new command bindings. (forms--show-record): Replaced `forms--modified-record-filter' by `forms-modified-record-filter'. (forms-jump-record): Changed error message. (forms-toggle-read-only): New function, replaces `forms-view-mode' and `forms-edit-mode'. (forms-view-mode, forms-edit-mode): Deleted. (forms-insert-record): Replaced `forms--new-record-filter' by `forms-new-record-filter'. (forms-insert-record, forms-delete-record): Disallow in read-only mode. (forms-prev-field): New function.
-rw-r--r--lisp/forms.el442
1 files changed, 268 insertions, 174 deletions
diff --git a/lisp/forms.el b/lisp/forms.el
index 5094b79773a..a2a296d78a1 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -2,7 +2,7 @@
2;;; Copyright (C) 1991, 1993 Free Software Foundation, Inc. 2;;; Copyright (C) 1991, 1993 Free Software Foundation, Inc.
3 3
4;; Author: Johan Vromans <jv@mh.nl> 4;; Author: Johan Vromans <jv@mh.nl>
5;; Version: 2.2 5;; Version: $Revision: 2.3 $
6 6
7;; This file is part of GNU Emacs. 7;; This file is part of GNU Emacs.
8 8
@@ -113,32 +113,28 @@
113;;; to newlines. Upon storage they are translated 113;;; to newlines. Upon storage they are translated
114;;; back to the separator character. 114;;; back to the separator character.
115;;; 115;;;
116;;; forms-forms-scroll [bool, default t] 116;;; forms-forms-scroll [bool, default nil]
117;;; Non-nil means: rebind locally the commands that 117;;; Non-nil means: rebind locally the commands that
118;;; perform `scroll-up' or `scroll-down' to use 118;;; perform `scroll-up' or `scroll-down' to use
119;;; `forms-next-field' resp. `forms-prev-field'. 119;;; `forms-next-field' resp. `forms-prev-field'.
120;;; 120;;;
121;;; forms-forms-jump [bool, default t] 121;;; forms-forms-jump [bool, default nil]
122;;; Non-nil means: rebind locally the commands that 122;;; Non-nil means: rebind locally the commands that
123;;; perform `beginning-of-buffer' or `end-of-buffer' 123;;; perform `beginning-of-buffer' or `end-of-buffer'
124;;; to perform `forms-first-field' resp. `forms-last-field'. 124;;; to perform `forms-first-field' resp. `forms-last-field'.
125;;; 125;;;
126;;; forms-new-record-filter [symbol, no default] 126;;; forms-new-record-filter [symbol, default nil]
127;;; If defined: this should be the name of a 127;;; If not nil: this should be the name of a
128;;; function that is called when a new 128;;; function that is called when a new
129;;; record is created. It can be used to fill in 129;;; record is created. It can be used to fill in
130;;; the new record with default fields, for example. 130;;; the new record with default fields, for example.
131;;; Instead of the name of the function, it may
132;;; be the function itself.
133;;; 131;;;
134;;; forms-modified-record-filter [symbol, no default] 132;;; forms-modified-record-filter [symbol, default nil]
135;;; If defined: this should be the name of a 133;;; If not nil: this should be the name of a
136;;; function that is called when a record has 134;;; function that is called when a record has
137;;; been modified. It is called after the fields 135;;; been modified. It is called after the fields
138;;; are parsed. It can be used to register 136;;; are parsed. It can be used to register
139;;; modification dates, for example. 137;;; modification dates, for example.
140;;; Instead of the name of the function, it may
141;;; be the function itself.
142;;; 138;;;
143;;; forms-use-text-properties [bool, see text for default] 139;;; forms-use-text-properties [bool, see text for default]
144;;; This variable controls if forms mode should use 140;;; This variable controls if forms mode should use
@@ -206,39 +202,56 @@
206;;; file (using forms-last-record) will adjust forms--total-records if 202;;; file (using forms-last-record) will adjust forms--total-records if
207;;; needed. 203;;; needed.
208;;; 204;;;
209;;; Commands and keymaps: 205;;; The forms buffer can be in on eof two modes: edit mode or view
206;;; mode. View mode is a read-only mode, you cannot modify the
207;;; contents of the buffer.
210;;; 208;;;
211;;; A local keymap `forms-mode-map' is used in the forms buffer. 209;;; Edit mode commands:
212;;; If the forms is in view mode, this keymap is used so all forms mode 210;;;
213;;; functions are accessible. 211;;; TAB forms-next-field
214;;; If the forms is in edit mode, this map can be accessed with C-c prefix. 212;;; \C-c TAB forms-next-field
215;;; 213;;; \C-c < forms-first-record
216;;; Default bindings: 214;;; \C-c > forms-last-record
217;;; 215;;; \C-c ? describe-mode
218;;; \C-c forms-mode-map 216;;; \C-c \C-k forms-delete-record
219;;; TAB forms-next-field 217;;; \C-c \C-q forms-toggle-read-only
220;;; SPC forms-next-record 218;;; \C-c \C-o forms-insert-record
221;;; < forms-first-record 219;;; \C-c \C-l forms-jump-record
222;;; > forms-last-record 220;;; \C-c \C-n forms-next-record
223;;; ? describe-mode 221;;; \C-c \C-p forms-prev-record
224;;; d forms-delete-record 222;;; \C-c \C-s forms-search
225;;; e forms-edit-mode 223;;; \C-c \C-x forms-exit
226;;; i forms-insert-record 224;;;
227;;; j forms-jump-record 225;;; Read-only mode commands:
228;;; n forms-next-record 226;;;
229;;; p forms-prev-record 227;;; SPC forms-next-record
230;;; q forms-exit 228;;; DEL forms-prev-record
231;;; s forms-search 229;;; ? describe-mode
232;;; v forms-view-mode 230;;; \C-q forms-toggle-read-only
233;;; x forms-exit-no-save 231;;; l forms-jump-record
234;;; DEL forms-prev-record 232;;; n forms-next-record
233;;; p forms-prev-record
234;;; s forms-search
235;;; x forms-exit
236;;;
237;;; Of course, it is also possible to use the \C-c prefix to obtain the
238;;; same command keys as in edit mode.
239;;;
240;;; The following bindings are available, independent of the mode:
241;;;
242;;; [next] forms-next-record
243;;; [prior] forms-prev-record
244;;; [begin] forms-first-record
245;;; [end] forms-last-record
246;;; [S-TAB] forms-prev-field
247;;; [backtab] forms-prev-field
235;;; 248;;;
236;;; For convenience, TAB is always bound to `forms-next-field', so you 249;;; For convenience, TAB is always bound to `forms-next-field', so you
237;;; don't need the C-c prefix for this command. 250;;; don't need the C-c prefix for this command.
238;;; 251;;;
239;;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump') 252;;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump')
240;;; the bindings of standard functions `scroll-up', `scroll-down', 253;;; the bindings of standard functions `scroll-up', `scroll-down',
241;;; `beginning-of-buffer' and `end-of-buffer' are locally replaced with 254;;; `beginning-of-buffer' and `end-of-buffer' can be locally replaced with
242;;; forms mode functions next/prev record and first/last 255;;; forms mode functions next/prev record and first/last
243;;; record. 256;;; record.
244;;; 257;;;
@@ -253,8 +266,10 @@
253(provide 'forms) ;;; official 266(provide 'forms) ;;; official
254(provide 'forms-mode) ;;; for compatibility 267(provide 'forms-mode) ;;; for compatibility
255 268
256(defconst forms-version "2.2" 269(defconst forms-version (substring "$Revision: 2.3 $" 11 -2)
257 "Version of forms-mode implementation.") 270 "The version number of forms-mode (as string). The complete RCS id is:
271
272 $Id: forms.el,v 2.3 1993/09/26 14:07:12 jv Exp $")
258 273
259(defvar forms-mode-hooks nil 274(defvar forms-mode-hooks nil
260 "Hook functions to be run upon entering Forms mode.") 275 "Hook functions to be run upon entering Forms mode.")
@@ -282,11 +297,11 @@
282(defvar forms-multi-line "\C-k" 297(defvar forms-multi-line "\C-k"
283 "If not nil: use this character to separate multi-line fields (default C-k).") 298 "If not nil: use this character to separate multi-line fields (default C-k).")
284 299
285(defvar forms-forms-scroll t 300(defvar forms-forms-scroll nil
286 "*Non-nil means replace scroll-up/down commands in Forms mode. 301 "*Non-nil means replace scroll-up/down commands in Forms mode.
287The replacement commands performs forms-next/prev-record.") 302The replacement commands performs forms-next/prev-record.")
288 303
289(defvar forms-forms-jump t 304(defvar forms-forms-jump nil
290 "*Non-nil means redefine beginning/end-of-buffer in Forms mode. 305 "*Non-nil means redefine beginning/end-of-buffer in Forms mode.
291The replacement commands performs forms-first/last-record.") 306The replacement commands performs forms-first/last-record.")
292 307
@@ -322,8 +337,12 @@ Defaults to t if this emacs is capable of handling text properties.")
322(defvar forms--current-record 0 337(defvar forms--current-record 0
323 "Number of the record currently on the screen.") 338 "Number of the record currently on the screen.")
324 339
325(defvar forms-mode-map nil ; yes - this one is global 340(defvar forms-mode-map nil
326 "Keymap for form buffer.") 341 "Keymap for form buffer.")
342(defvar forms-mode-ro-map nil
343 "Keymap for form buffer in view mode.")
344(defvar forms-mode-edit-map nil
345 "Keymap for form buffer in edit mode.")
327 346
328(defvar forms--markers nil 347(defvar forms--markers nil
329 "Field markers in the screen.") 348 "Field markers in the screen.")
@@ -347,12 +366,6 @@ Defaults to t if this emacs is capable of handling text properties.")
347 "To keep track of forms-mode being set-up.") 366 "To keep track of forms-mode being set-up.")
348(make-variable-buffer-local 'forms--mode-setup) 367(make-variable-buffer-local 'forms--mode-setup)
349 368
350(defvar forms--new-record-filter nil
351 "Set if a new record filter has been defined.")
352
353(defvar forms--modified-record-filter nil
354 "Set if a modified record filter has been defined.")
355
356(defvar forms--dynamic-text nil 369(defvar forms--dynamic-text nil
357 "Array that holds dynamic texts to insert between fields.") 370 "Array that holds dynamic texts to insert between fields.")
358 371
@@ -369,10 +382,22 @@ Defaults to t if this emacs is capable of handling text properties.")
369(defun forms-mode (&optional primary) 382(defun forms-mode (&optional primary)
370 "Major mode to visit files in a field-structured manner using a form. 383 "Major mode to visit files in a field-structured manner using a form.
371 384
372Commands (prefix with C-c if not in read-only mode): 385Commands: Equivalent keys in read-only mode:
373\\{forms-mode-map}" 386 TAB forms-next-field TAB
374 387 \\C-c TAB forms-next-field
375 (interactive) ; no - 'primary' is not prefix arg 388 \\C-c < forms-first-record <
389 \\C-c > forms-last-record >
390 \\C-c ? describe-mode ?
391 \\C-c \\C-k forms-delete-record
392 \\C-c \\C-q forms-toggle-read-only q
393 \\C-c \\C-o forms-insert-record
394 \\C-c \\C-l forms-jump-record l
395 \\C-c \\C-n forms-next-record n
396 \\C-c \\C-p forms-prev-record p
397 \\C-c \\C-s forms-search s
398 \\C-c \\C-x forms-exit x
399"
400 (interactive)
376 401
377 ;; This is not a simple major mode, as usual. Therefore, forms-mode 402 ;; This is not a simple major mode, as usual. Therefore, forms-mode
378 ;; takes an optional argument `primary' which is used for the 403 ;; takes an optional argument `primary' which is used for the
@@ -403,12 +428,12 @@ Commands (prefix with C-c if not in read-only mode):
403 (make-local-variable 'forms-forms-scroll) 428 (make-local-variable 'forms-forms-scroll)
404 (make-local-variable 'forms-forms-jump) 429 (make-local-variable 'forms-forms-jump)
405 (make-local-variable 'forms-use-text-properties) 430 (make-local-variable 'forms-use-text-properties)
406 (make-local-variable 'forms--new-record-filter) 431 (make-local-variable 'forms-new-record-filter)
407 (make-local-variable 'forms--modified-record-filter) 432 (make-local-variable 'forms-modified-record-filter)
408 433
409 ;; Make sure no filters exist. 434 ;; Make sure no filters exist.
410 (fmakunbound 'forms-new-record-filter) 435 (setq forms-new-record-filter nil)
411 (fmakunbound 'forms-modified-record-filter) 436 (setq forms-modified-record-filter nil)
412 437
413 ;; If running Emacs 19 under X, setup faces to show read-only and 438 ;; If running Emacs 19 under X, setup faces to show read-only and
414 ;; read-write fields. 439 ;; read-write fields.
@@ -423,19 +448,26 @@ Commands (prefix with C-c if not in read-only mode):
423 448
424 ;; check if the mandatory variables make sense. 449 ;; check if the mandatory variables make sense.
425 (or forms-file 450 (or forms-file
426 (error "'forms-file' has not been set")) 451 (error (concat "Forms control file error: "
452 "'forms-file' has not been set")))
427 (or forms-number-of-fields 453 (or forms-number-of-fields
428 (error "'forms-number-of-fields' has not been set")) 454 (error (concat "Forms control file error: "
429 (or (> forms-number-of-fields 0) 455 "'forms-number-of-fields' has not been set")))
430 (error "'forms-number-of-fields' must be > 0") 456 (or (and (numberp forms-number-of-fields)
431 (or (stringp forms-field-sep)) 457 (> forms-number-of-fields 0))
432 (error "'forms-field-sep' is not a string")) 458 (error (concat "Forms control file error: "
459 "'forms-number-of-fields' must be a number > 0")))
460 (or (stringp forms-field-sep)
461 (error (concat "Forms control file error: "
462 "'forms-field-sep' is not a string")))
433 (if forms-multi-line 463 (if forms-multi-line
434 (if (and (stringp forms-multi-line) 464 (if (and (stringp forms-multi-line)
435 (eq (length forms-multi-line) 1)) 465 (eq (length forms-multi-line) 1))
436 (if (string= forms-multi-line forms-field-sep) 466 (if (string= forms-multi-line forms-field-sep)
437 (error "'forms-multi-line' is equal to 'forms-field-sep'")) 467 (error (concat "Forms control file error: "
438 (error "'forms-multi-line' must be nil or a one-character string"))) 468 "'forms-multi-line' is equal to 'forms-field-sep'")))
469 (error (concat "Forms control file error: "
470 "'forms-multi-line' must be nil or a one-character string"))))
439 (or (fboundp 'set-text-properties) 471 (or (fboundp 'set-text-properties)
440 (setq forms-use-text-properties nil)) 472 (setq forms-use-text-properties nil))
441 473
@@ -456,22 +488,15 @@ Commands (prefix with C-c if not in read-only mode):
456 ;;(message "forms: building parser... done.") 488 ;;(message "forms: building parser... done.")
457 489
458 ;; Check if record filters are defined. 490 ;; Check if record filters are defined.
459 (setq forms--new-record-filter 491 (if (and forms-new-record-filter
460 (cond 492 (not (fboundp forms-new-record-filter)))
461 ((fboundp 'forms-new-record-filter) 493 (error (concat "Forms control file error: "
462 (symbol-function 'forms-new-record-filter)) 494 "'forms-new-record-filter' is not a function")))
463 ((and (boundp 'forms-new-record-filter) 495
464 (fboundp forms-new-record-filter)) 496 (if (and forms-modified-record-filter
465 forms-new-record-filter))) 497 (not (fboundp forms-modified-record-filter)))
466 (fmakunbound 'forms-new-record-filter) 498 (error (concat "Forms control file error: "
467 (setq forms--modified-record-filter 499 "'forms-modified-record-filter' is not a function")))
468 (cond
469 ((fboundp 'forms-modified-record-filter)
470 (symbol-function 'forms-modified-record-filter))
471 ((and (boundp 'forms-modified-record-filter)
472 (fboundp forms-modified-record-filter))
473 forms-modified-record-filter)))
474 (fmakunbound 'forms-modified-record-filter)
475 500
476 ;; The filters acces the contents of the forms using `forms-fields'. 501 ;; The filters acces the contents of the forms using `forms-fields'.
477 (make-local-variable 'forms-fields) 502 (make-local-variable 'forms-fields)
@@ -509,15 +534,14 @@ Commands (prefix with C-c if not in read-only mode):
509 (make-local-variable 'forms--the-record-list) 534 (make-local-variable 'forms--the-record-list)
510 (make-local-variable 'forms--search-regexp) 535 (make-local-variable 'forms--search-regexp)
511 536
512 ;; A bug in the current Emacs release prevents a keymap 537 ; The keymaps are global, so multiple forms mode buffers can share them.
513 ;; which is buffer-local from being used by 'describe-mode'. 538 ;(make-local-variable 'forms-mode-map)
514 ;; Hence we'll leave it global. 539 ;(make-local-variable 'forms-mode-ro-map)
515 ;;(make-local-variable 'forms-mode-map) 540 ;(make-local-variable 'forms-mode-edit-map)
516 (if forms-mode-map ; already defined 541 (if forms-mode-map ; already defined
517 nil 542 nil
518 ;;(message "forms: building keymap...") 543 ;;(message "forms: building keymap...")
519 (setq forms-mode-map (make-keymap)) 544 (forms--mode-commands)
520 (forms--mode-commands forms-mode-map)
521 ;;(message "forms: building keymap... done.") 545 ;;(message "forms: building keymap... done.")
522 ) 546 )
523 547
@@ -549,17 +573,12 @@ Commands (prefix with C-c if not in read-only mode):
549 (forms--set-minor-mode) 573 (forms--set-minor-mode)
550 ;;(message "forms: proceeding setup (keymaps)...") 574 ;;(message "forms: proceeding setup (keymaps)...")
551 (forms--set-keymaps) 575 (forms--set-keymaps)
552 (make-local-variable 'local-write-file-hooks)
553 ;;(message "forms: proceeding setup (commands)...") 576 ;;(message "forms: proceeding setup (commands)...")
554 (forms--change-commands) 577 (forms--change-commands)
555 578
556 ;;(message "forms: proceeding setup (buffer)...") 579 ;;(message "forms: proceeding setup (buffer)...")
557 (set-buffer-modified-p nil) 580 (set-buffer-modified-p nil)
558 581
559 ;; We have our own revert function - use it
560 (make-local-variable 'revert-buffer-function)
561 (setq revert-buffer-function 'forms-revert-buffer)
562
563 ;; setup the first (or current) record to show 582 ;; setup the first (or current) record to show
564 (if (< forms--current-record 1) 583 (if (< forms--current-record 1)
565 (setq forms--current-record 1)) 584 (setq forms--current-record 1))
@@ -590,10 +609,12 @@ Commands (prefix with C-c if not in read-only mode):
590 609
591 ;; Verify that `forms-format-list' is not nil. 610 ;; Verify that `forms-format-list' is not nil.
592 (or forms-format-list 611 (or forms-format-list
593 (error "'forms-format-list' has not been set")) 612 (error (concat "Forms control file error: "
613 "'forms-format-list' has not been set")))
594 ;; It must be a list. 614 ;; It must be a list.
595 (or (listp forms-format-list) 615 (or (listp forms-format-list)
596 (error "'forms-format-list' is not a list")) 616 (error (concat "Forms control file error: "
617 "'forms-format-list' is not a list")))
597 618
598 ;; Assume every field is painted once. 619 ;; Assume every field is painted once.
599 ;; `forms--elements' will grow if needed. 620 ;; `forms--elements' will grow if needed.
@@ -633,9 +654,9 @@ Commands (prefix with C-c if not in read-only mode):
633 ;; Validate range. 654 ;; Validate range.
634 (if (or (<= el 0) 655 (if (or (<= el 0)
635 (> el forms-number-of-fields)) 656 (> el forms-number-of-fields))
636 (error 657 (error (concat "Forms format error: "
637 "Forms error: field number %d out of range 1..%d" 658 "field number %d out of range 1..%d")
638 el forms-number-of-fields)) 659 el forms-number-of-fields))
639 660
640 ;; Store forms order. 661 ;; Store forms order.
641 (if (> field-num (length forms--elements)) 662 (if (> field-num (length forms--elements))
@@ -653,9 +674,9 @@ Commands (prefix with C-c if not in read-only mode):
653 674
654 ;; Validate. 675 ;; Validate.
655 (or (fboundp (car-safe el)) 676 (or (fboundp (car-safe el))
656 (error 677 (error (concat "Forms format error: "
657 "Forms error: not a function: %s" 678 "not a function "
658 (prin1-to-string (car-safe el)))) 679 (prin1-to-string (car-safe el)))))
659 680
660 ;; Shift. 681 ;; Shift.
661 (if prev-item 682 (if prev-item
@@ -665,8 +686,9 @@ Commands (prefix with C-c if not in read-only mode):
665 686
666 ;; else 687 ;; else
667 (t 688 (t
668 (error "Forms error: invalid element %s" 689 (error (concat "Forms format error: "
669 (prin1-to-string el)))) 690 "invalid element "
691 (prin1-to-string el)))))
670 692
671 ;; Advance to next element of the list. 693 ;; Advance to next element of the list.
672 (setq the-list rem))) 694 (setq the-list rem)))
@@ -1058,36 +1080,62 @@ Commands (prefix with C-c if not in read-only mode):
1058(defun forms--set-keymaps () 1080(defun forms--set-keymaps ()
1059 "Set the keymaps used in this mode." 1081 "Set the keymaps used in this mode."
1060 1082
1061 (if forms-read-only 1083 (use-local-map (if forms-read-only
1062 (use-local-map forms-mode-map) 1084 forms-mode-ro-map
1063 (use-local-map (make-sparse-keymap)) 1085 forms-mode-edit-map)))
1064 (define-key (current-local-map) "\C-c" forms-mode-map) 1086
1065 (define-key (current-local-map) "\t" 'forms-next-field))) 1087(defun forms--mode-commands ()
1066 1088 "Fill the Forms mode keymaps."
1067(defun forms--mode-commands (map) 1089
1068 "Fill map with all Forms mode commands." 1090 ;; `forms-mode-map' is always accessible via \C-c prefix.
1069 1091 (setq forms-mode-map (make-keymap))
1070 (define-key map "\t" 'forms-next-field) 1092 (define-key forms-mode-map "\t" 'forms-next-field)
1071 (define-key map " " 'forms-next-record) 1093 (define-key forms-mode-map "\C-k" 'forms-delete-record)
1072 (define-key map "d" 'forms-delete-record) 1094 (define-key forms-mode-map "\C-q" 'forms-toggle-read-only)
1073 (define-key map "e" 'forms-edit-mode) 1095 (define-key forms-mode-map "\C-o" 'forms-insert-record)
1074 (define-key map "i" 'forms-insert-record) 1096 (define-key forms-mode-map "\C-l" 'forms-jump-record)
1075 (define-key map "j" 'forms-jump-record) 1097 (define-key forms-mode-map "\C-n" 'forms-next-record)
1076 (define-key map "n" 'forms-next-record) 1098 (define-key forms-mode-map "\C-p" 'forms-prev-record)
1077 (define-key map "p" 'forms-prev-record) 1099 (define-key forms-mode-map "\C-s" 'forms-search)
1078 (define-key map "q" 'forms-exit) 1100 (define-key forms-mode-map "\C-x" 'forms-exit)
1079 (define-key map "s" 'forms-search) 1101 (define-key forms-mode-map "<" 'forms-first-record)
1080 (define-key map "v" 'forms-view-mode) 1102 (define-key forms-mode-map ">" 'forms-last-record)
1081 (define-key map "x" 'forms-exit-no-save) 1103 (define-key forms-mode-map "?" 'describe-mode)
1082 (define-key map "<" 'forms-first-record) 1104 (define-key forms-mode-map "\C-?" 'forms-prev-record)
1083 (define-key map ">" 'forms-last-record) 1105
1084 (define-key map "?" 'describe-mode) 1106 ;; `forms-mode-ro-map' replaces the local map when in read-only mode.
1085 (define-key map "\177" 'forms-prev-record) 1107 (setq forms-mode-ro-map (make-keymap))
1086 ;(define-key map "\C-c" map) 1108 (suppress-keymap forms-mode-ro-map)
1087 ;(define-key map "\e" 'ESC-prefix) 1109 (define-key forms-mode-ro-map "\C-c" forms-mode-map)
1088 ;(define-key map "\C-x" ctl-x-map) 1110 (define-key forms-mode-ro-map "\t" 'forms-next-field)
1089 ;(define-key map "\C-u" 'universal-argument) 1111 (define-key forms-mode-ro-map "q" 'forms-toggle-read-only)
1090 ;(define-key map "\C-h" help-map) 1112 (define-key forms-mode-ro-map "l" 'forms-jump-record)
1113 (define-key forms-mode-ro-map "n" 'forms-next-record)
1114 (define-key forms-mode-ro-map "p" 'forms-prev-record)
1115 (define-key forms-mode-ro-map "s" 'forms-search)
1116 (define-key forms-mode-ro-map "x" 'forms-exit)
1117 (define-key forms-mode-ro-map "<" 'forms-first-record)
1118 (define-key forms-mode-ro-map ">" 'forms-last-record)
1119 (define-key forms-mode-ro-map "?" 'describe-mode)
1120 (define-key forms-mode-ro-map " " 'forms-next-record)
1121 (forms--mode-commands1 forms-mode-ro-map)
1122
1123 ;; This is the normal, local map.
1124 (setq forms-mode-edit-map (make-keymap))
1125 (define-key forms-mode-edit-map "\t" 'forms-next-field)
1126 (define-key forms-mode-edit-map "\C-c" forms-mode-map)
1127 (forms--mode-commands1 forms-mode-edit-map)
1128 )
1129
1130(defun forms--mode-commands1 (map)
1131 "Helper routine to define keys."
1132 (define-key map [TAB] 'forms-next-field)
1133 (define-key map [S-tab] 'forms-prev-field)
1134 (define-key map [next] 'forms-next-record)
1135 (define-key map [prior] 'forms-prev-record)
1136 (define-key map [begin] 'forms-first-record)
1137 (define-key map [last] 'forms-last-record)
1138 (define-key map [backtab] 'forms-prev-field)
1091 ) 1139 )
1092 1140
1093;;; Changed functions 1141;;; Changed functions
@@ -1118,6 +1166,7 @@ Commands (prefix with C-c if not in read-only mode):
1118 (current-global-map)))) 1166 (current-global-map))))
1119 ;; 1167 ;;
1120 ;; save-buffer -> forms--save-buffer 1168 ;; save-buffer -> forms--save-buffer
1169 (make-local-variable 'local-write-file-hooks)
1121 (add-hook 'local-write-file-hooks 1170 (add-hook 'local-write-file-hooks
1122 (function 1171 (function
1123 (lambda (nil) 1172 (lambda (nil)
@@ -1125,22 +1174,27 @@ Commands (prefix with C-c if not in read-only mode):
1125 (save-excursion 1174 (save-excursion
1126 (set-buffer forms--file-buffer) 1175 (set-buffer forms--file-buffer)
1127 (save-buffer)) 1176 (save-buffer))
1128 t)))) 1177 t)))
1178 ;; We have our own revert function - use it
1179 (make-local-variable 'revert-buffer-function)
1180 (setq revert-buffer-function 'forms-revert-buffer)
1181
1182 t)
1129 1183
1130(defun forms--help () 1184(defun forms--help ()
1131 "Initial help for Forms mode." 1185 "Initial help for Forms mode."
1132 ;; We should use 1186 ;; We should use
1133 ;;(message (substitute-command-keys (concat 1187 (message (substitute-command-keys (concat
1134 ;;"\\[forms-next-record]:next" 1188 "\\[forms-next-record]:next"
1135 ;;" \\[forms-prev-record]:prev" 1189 " \\[forms-prev-record]:prev"
1136 ;;" \\[forms-first-record]:first" 1190 " \\[forms-first-record]:first"
1137 ;;" \\[forms-last-record]:last" 1191 " \\[forms-last-record]:last"
1138 ;;" \\[describe-mode]:help" 1192 " \\[describe-mode]:help"))))
1139 ;;" \\[forms-exit]:exit"))) 1193 ; but it's too slow ....
1140 ;; but it's too slow .... 1194; (if forms-read-only
1141 (if forms-read-only 1195; (message "SPC:next DEL:prev <:first >:last ?:help q:exit")
1142 (message "SPC:next DEL:prev <:first >:last ?:help q:exit") 1196; (message "C-c n:next C-c p:prev C-c <:first C-c >:last C-c ?:help C-c q:exit"))
1143 (message "C-c n:next C-c p:prev C-c <:first C-c >:last C-c ?:help C-c q:exit"))) 1197; )
1144 1198
1145(defun forms--trans (subj arg rep) 1199(defun forms--trans (subj arg rep)
1146 "Translate in SUBJ all chars ARG into char REP. ARG and REP should 1200 "Translate in SUBJ all chars ARG into char REP. ARG and REP should
@@ -1217,7 +1271,7 @@ Commands (prefix with C-c if not in read-only mode):
1217 (if (= (length forms--the-record-list) forms-number-of-fields) 1271 (if (= (length forms--the-record-list) forms-number-of-fields)
1218 nil 1272 nil
1219 (beep) 1273 (beep)
1220 (message "Record has %d fields instead of %d." 1274 (message "Warning: this record has %d fields instead of %d"
1221 (length forms--the-record-list) forms-number-of-fields) 1275 (length forms--the-record-list) forms-number-of-fields)
1222 (if (< (length forms--the-record-list) forms-number-of-fields) 1276 (if (< (length forms--the-record-list) forms-number-of-fields)
1223 (setq forms--the-record-list 1277 (setq forms--the-record-list
@@ -1256,11 +1310,11 @@ Commands (prefix with C-c if not in read-only mode):
1256 (let ((forms--dynamic-text forms--dynamic-text)) 1310 (let ((forms--dynamic-text forms--dynamic-text))
1257 (funcall forms--parser)) 1311 (funcall forms--parser))
1258 1312
1259 (if forms--modified-record-filter 1313 (if forms-modified-record-filter
1260 ;; As a service to the user, we add a zeroth element so she 1314 ;; As a service to the user, we add a zeroth element so she
1261 ;; can use the same indices as in the forms definition. 1315 ;; can use the same indices as in the forms definition.
1262 (let ((the-fields (vconcat [nil] forms--recordv))) 1316 (let ((the-fields (vconcat [nil] forms--recordv)))
1263 (setq the-fields (funcall forms--modified-record-filter the-fields)) 1317 (setq the-fields (funcall forms-modified-record-filter the-fields))
1264 (cdr (append the-fields nil))) 1318 (cdr (append the-fields nil)))
1265 1319
1266 ;; Transform to a list and return. 1320 ;; Transform to a list and return.
@@ -1392,7 +1446,7 @@ As a side effect: sets `forms--the-record-list'."
1392 (progn 1446 (progn
1393 (setq forms--current-record cur) 1447 (setq forms--current-record cur)
1394 (beep) 1448 (beep)
1395 (message "Stuck at record %d." cur)))))) 1449 (message "Stuck at record %d" cur))))))
1396 1450
1397(defun forms-first-record () 1451(defun forms-first-record ()
1398 "Jump to first record." 1452 "Jump to first record."
@@ -1412,34 +1466,43 @@ As a side effect: re-calculates the number of records in the data file."
1412 nil 1466 nil
1413 (beep) 1467 (beep)
1414 (setq forms--total-records numrec) 1468 (setq forms--total-records numrec)
1415 (message "Number of records reset to %d." forms--total-records))) 1469 (message "Warning: number of records changed to %d" forms--total-records)))
1416 (forms-jump-record forms--total-records)) 1470 (forms-jump-record forms--total-records))
1417 1471
1418;;; Other commands 1472;;; Other commands
1419 1473
1420(defun forms-view-mode () 1474(defun forms-toggle-read-only (arg)
1421 "Visit buffer read-only." 1475 "Toggles read-only mode of a forms mode buffer.
1422 (interactive) 1476With an argument, enables read-only mode if the argument is positive.
1423 (if forms-read-only 1477Otherwise enables edit mode if the visited file is writeable."
1424 nil
1425 (forms--checkmod) ; sync
1426 (setq forms-read-only t)
1427 (forms-mode)))
1428 1478
1429(defun forms-edit-mode () 1479 (interactive "P")
1430 "Make form suitable for editing, if possible." 1480
1431 (interactive) 1481 (if (if arg
1432 (let ((ro forms-read-only)) 1482 ;; Negative arg means switch it off.
1433 (if (save-excursion 1483 (<= (prefix-numeric-value arg) 0)
1434 (set-buffer forms--file-buffer) 1484 ;; No arg means toggle.
1435 buffer-read-only) 1485 forms-read-only)
1436 (progn 1486
1437 (setq forms-read-only t) 1487 ;; Enable edit mode, if possible.
1438 (message "No write access to \"%s\"" forms-file) 1488 (let ((ro forms-read-only))
1439 (beep)) 1489 (if (save-excursion
1440 (setq forms-read-only nil)) 1490 (set-buffer forms--file-buffer)
1441 (if (equal ro forms-read-only) 1491 buffer-read-only)
1492 (progn
1493 (setq forms-read-only t)
1494 (message "No write access to \"%s\"" forms-file)
1495 (beep))
1496 (setq forms-read-only nil))
1497 (if (equal ro forms-read-only)
1498 nil
1499 (forms-mode)))
1500
1501 ;; Enable view mode.
1502 (if forms-read-only
1442 nil 1503 nil
1504 (forms--checkmod) ; sync
1505 (setq forms-read-only t)
1443 (forms-mode)))) 1506 (forms-mode))))
1444 1507
1445;; Sample: 1508;; Sample:
@@ -1453,22 +1516,23 @@ As a side effect: re-calculates the number of records in the data file."
1453(defun forms-insert-record (arg) 1516(defun forms-insert-record (arg)
1454 "Create a new record before the current one. 1517 "Create a new record before the current one.
1455With ARG: store the record after the current one. 1518With ARG: store the record after the current one.
1456If a function `forms-new-record-filter' is defined, or 1519If `forms-new-record-filter' contains the name of a function,
1457`forms-new-record-filter' contains the name of a function,
1458it is called to fill (some of) the fields with default values." 1520it is called to fill (some of) the fields with default values."
1459 ; The above doc is not true, but for documentary purposes only
1460 1521
1461 (interactive "P") 1522 (interactive "P")
1462 1523
1524 (if forms-read-only
1525 (error ""))
1526
1463 (let ((ln (if arg (1+ forms--current-record) forms--current-record)) 1527 (let ((ln (if arg (1+ forms--current-record) forms--current-record))
1464 the-list the-record) 1528 the-list the-record)
1465 1529
1466 (forms--checkmod) 1530 (forms--checkmod)
1467 (if forms--new-record-filter 1531 (if forms-new-record-filter
1468 ;; As a service to the user, we add a zeroth element so she 1532 ;; As a service to the user, we add a zeroth element so she
1469 ;; can use the same indices as in the forms definition. 1533 ;; can use the same indices as in the forms definition.
1470 (let ((the-fields (make-vector (1+ forms-number-of-fields) ""))) 1534 (let ((the-fields (make-vector (1+ forms-number-of-fields) "")))
1471 (setq the-fields (funcall forms--new-record-filter the-fields)) 1535 (setq the-fields (funcall forms-new-record-filter the-fields))
1472 (setq the-list (cdr (append the-fields nil)))) 1536 (setq the-list (cdr (append the-fields nil))))
1473 (setq the-list (make-list forms-number-of-fields ""))) 1537 (setq the-list (make-list forms-number-of-fields "")))
1474 1538
@@ -1493,6 +1557,10 @@ it is called to fill (some of) the fields with default values."
1493(defun forms-delete-record (arg) 1557(defun forms-delete-record (arg)
1494 "Deletes a record. With a prefix argument: don't ask." 1558 "Deletes a record. With a prefix argument: don't ask."
1495 (interactive "P") 1559 (interactive "P")
1560
1561 (if forms-read-only
1562 (error ""))
1563
1496 (forms--checkmod) 1564 (forms--checkmod)
1497 (if (or arg 1565 (if (or arg
1498 (y-or-n-p "Really delete this record? ")) 1566 (y-or-n-p "Really delete this record? "))
@@ -1577,6 +1645,31 @@ it is called to fill (some of) the fields with default values."
1577 nil 1645 nil
1578 (goto-char (aref forms--markers 0))))) 1646 (goto-char (aref forms--markers 0)))))
1579 1647
1648(defun forms-prev-field (arg)
1649 "Jump to ARG-th previous field."
1650 (interactive "p")
1651
1652 (let ((i (length forms--markers))
1653 (here (point))
1654 there
1655 (cnt 0))
1656
1657 (if (zerop arg)
1658 (setq cnt 1)
1659 (setq cnt (+ cnt arg)))
1660
1661 (if (catch 'done
1662 (while (> i 0)
1663 (setq i ( 1- i))
1664 (if (or (null (setq there (aref forms--markers i)))
1665 (>= there here))
1666 nil
1667 (if (<= (setq cnt (1- cnt)) 0)
1668 (progn
1669 (goto-char there)
1670 (throw 'done t))))))
1671 nil
1672 (goto-char (aref forms--markers (1- (length forms--markers)))))))
1580;;; 1673;;;
1581;;; Special service 1674;;; Special service
1582;;; 1675;;;
@@ -1627,3 +1720,4 @@ Usage: (setq forms-number-of-fields
1627 (insert ret))))) 1720 (insert ret)))))
1628 1721
1629;;; forms.el ends here. 1722;;; forms.el ends here.
1723