/[emacs]/emacs/lisp/forms.el
ViewVC logotype

Diff of /emacs/lisp/forms.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.2.43  
changed lines
  Added in v.2.43.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26