comparison lisp/forms.el @ 4723:6a3f5f51897b

Change typos in comments. (forms-delete-record, forms--update): Use `delete-region' instead of `kill-line' to avoid messing around with the kill ring. Release 2.1 for Emacs 19.19. (forms--process-format-list): No need to prepend a text item anymore. (forms--ro-modification-start): Renamed to `forms--iif-start. (forms--ro-properties): Renamed to `forms--iif-properties'. (forms--romh): Renamed to `forms--iif-hook'. Rewritten to use `insert-in-front-hooks' instead of `modification-hooks'. (forms--romh-post-command-hook): Renamed to `forms--iif-post-command-hook'. Rewritten to use `insert-in-front-hooks' instead of `modification-hooks'. (forms--make-format, forms--make-format-elt-using-text-properties): Use `insert-in-front-hooks' instead of `modification-hooks'. Remove `forms--electric' code. Use `front-sticky' and `rear-nonsticky' text properties to control the insertion of text between read-only fields. (forms--show-record): Remove `forms--electric' code.

4722:1b0ce8ac1c81

;;; forms.el -- Forms mode: edit a file as a form to fill in.
;;; Copyright (C) 1991, 1993 Free Software Foundation, Inc.

;; Author: Johan Vromans <[e-mail]>
;; Version: 2.0

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;;; Visit a file using a form.
;;;
;;; === Naming conventions
;;;
;;; The names of all variables and functions start with 'form-'.
;;; Names which start with 'form--' are intended for internal use, and
;;; should *NOT* be used from the outside.
;;;
;;; All variables are buffer-local, to enable multiple forms visits 
;;; simultaneously.
;;; Variable `forms--mode-setup' is local to *ALL* buffers, for it 

;;; Global variables and constants:

(provide 'forms)			;;; official
(provide 'forms-mode)			;;; for compatibility

(defconst forms-version "2.0"
  "Version of forms-mode implementation.")

(defvar forms-mode-hooks nil
  "Hook functions to be run upon entering Forms mode.")


	  (if (> field-num (length forms--elements))
	      (setq forms--elements (vconcat forms--elements (1- el)))
	    (aset forms--elements field-num (1- el)))
	  (setq field-num (1+ field-num))

	  ;; Make sure the field is preceded by something.
	  (if prev-item
	      (setq forms-format-list
		    (append forms-format-list (list prev-item) nil))
	    (setq forms-format-list
		  (append forms-format-list (list "\n") nil)))
	  (setq prev-item el))

	 ;; Try function ...
	 ((listp el)

    (if prev-item
	(progn
	  (setq forms-format-list
		(append forms-format-list (list prev-item) nil))
	  ;; Append a newline if the last item is a field.
	  ;; This prevents pasrsing problems.
	  ;; Also it makes it possible to insert an empty last field.
	  (if (numberp prev-item)
	      (setq forms-format-list
		    (append forms-format-list (list "\n") nil))))))

  (forms--debug 'forms-format-list
		'forms--elements))

;; Special treatment for read-only segments.
;;
;; If text is inserted after a read-only segment, it inherits the
;; read-only properties.  This is not what we want.
;; The modification hook of the last character of the read-only segment
;; temporarily switches its properties to read-write, so the new
;; text gets the right properties.
;; The post-command-hook is used to restore the original properties.
;;
;; A character category `forms-electric' is used for the characters
;; that get the modification hook set.  Using a category, it is
;; possible to globally enable/disable the modification hook.  This is
;; necessary, since modifying a hook or setting text properties are
;; considered modifications and would trigger the hooks while building
;; the forms.

(defvar forms--ro-modification-start nil
  "Record start of modification command.")
(defvar forms--ro-properties nil
  "Original properties of the character being overridden.")

(defun forms--romh (begin end)
  "`modification-hook' function for forms-electric characters."

  ;; Note start location.
  (or forms--ro-modification-start
      (setq forms--ro-modification-start (point)))

  ;; Fetch current properties.
  (setq forms--ro-properties 
	(text-properties-at (1- forms--ro-modification-start)))

  ;; Disarm modification hook.
  (setplist 'forms--electric nil)

  ;; Replace them.
  (let ((inhibit-read-only t))
    (set-text-properties 
     (1- forms--ro-modification-start) forms--ro-modification-start
     (list 'face forms--rw-face)))

  ;; Re-arm electric.
  (setplist 'forms--electric '(modification-hooks (forms--romh)))

  ;; Enable `post-command-hook' to restore the properties.
  (setq post-command-hook
	(append (list 'forms--romh-post-command-hook) post-command-hook)))

(defun forms--romh-post-command-hook ()
  "`post-command-hook' function for forms--electric characters."

  ;; Disable `post-command-hook'.
  (setq post-command-hook
	(delq 'forms--romh-post-command-hook post-command-hook))

  ;; Disarm modification hook.
  (setplist 'forms--electric nil)

  ;; Restore properties.
  (if forms--ro-modification-start
      (let ((inhibit-read-only t))
	(set-text-properties 
	 (1- forms--ro-modification-start) forms--ro-modification-start
	 forms--ro-properties)))

  ;; Re-arm electric.
  (setplist 'forms--electric '(modification-hooks (forms--romh)))

  ;; Cleanup.
  (setq forms--ro-modification-start nil))

(defvar forms--marker)
(defvar forms--dyntext)

(defun forms--make-format ()

    (setq 
     forms--format
     (if forms-use-text-properties 
	 (` (lambda (arg)
	      (let ((inhibit-read-only t))
		(setplist 'forms--electric nil)
		(,@ (apply 'append
			   (mapcar 'forms--make-format-elt-using-text-properties
				   forms-format-list))))
	      (setplist 'forms--electric
			'(modification-hooks (forms--romh)))
	      (setq forms--ro-modification-start nil)))
       (` (lambda (arg)
	    (,@ (apply 'append
		       (mapcar 'forms--make-format-elt forms-format-list)))))))

    ;; We have tallied the number of markers and dynamic texts,

  ;; The format routine `forms--format' will look like
  ;;
  ;; ;; preamble
  ;; (lambda (arg)
  ;;   (let ((inhibit-read-only t))
  ;;     (setplist 'forms--electric nil)
  ;;
  ;;     ;; a string, e.g. "text: "
  ;;     (set-text-properties 
  ;;      (point)
  ;;      (progn (insert "text: ") (point)) 
  ;;      (list 'face forms--ro-face 'read-only 1))
  ;;
  ;;     ;; a field, e.g. 6
  ;;     (let ((here (point)))
  ;;       (aset forms--markers 0 (point-marker))
  ;;       (insert (elt arg 5))
  ;;       (or (= (point) here)
  ;; 	  (set-text-properties 
  ;; 	   here (point)
  ;; 	   (list 'face forms--rw-face)))
  ;;       (if (get-text-property (1- here) 'read-only)
  ;; 	  (put-text-property 
  ;; 	   (1- here) here
  ;; 	   'category 'forms--electric)))
  ;;
  ;;     ;; another string, e.g. "\nmore text: "
  ;;     (set-text-properties
  ;;      (point)
  ;;      (progn (insert "\nmore text: ") (point))
  ;;      (list 'face forms--ro-face
  ;; 	   'read-only 2))
  ;;
  ;;     ;; a function, e.g. (tocol 40)
  ;;     (set-text-properties
  ;;      (point)
  ;;      (progn
  ;;        (insert (aset forms--dyntexts 0 (tocol 40)))
  ;;        (point))
  ;;      (list 'face forms--ro-face
  ;; 	   'read-only 2))
  ;;
  ;;     ;; wrap up
  ;;     (setplist 'forms--electric
  ;; 	      '(modification-hooks (forms--romh)))
  ;;     (setq forms--ro-modification-start nil)
  ;;     ))

  (cond
   ((stringp el)
    

	 (point)			; start at point
	 (progn				; until after insertion
	   (insert (, el))
	   (point))
	 (list 'face forms--ro-face	; read-only appearance
	       'read-only (,@ (list (1+ forms--marker))))))))
   ((numberp el)
    (` ((let ((here (point)))
	  (aset forms--markers 
		(, (prog1 forms--marker
		     (setq forms--marker (1+ forms--marker))))
		(point-marker))
	  (insert (elt arg (, (1- el))))
	  (or (= (point) here)
	      (set-text-properties 
	       here (point)
	       (list 'face forms--rw-face)))
	  (if (get-text-property (1- here) 'read-only)
	      (put-text-property
	       (1- here) here
	       'category 'forms--electric))))))

   ((listp el)
    (` ((set-text-properties
	 (point)
	 (progn

			 (, (prog1 forms--dyntext
			      (setq forms--dyntext (1+ forms--dyntext))))
			 (, el)))
	   (point))
	 (list 'face forms--ro-face
	       'read-only 
	       (,@ (list (1+ forms--marker))))))))

   ;; end of cond
   ))

(defun forms--make-format-elt (el)

    (setq forms--the-record-list the-result))

  (setq buffer-read-only nil)
  (if forms-use-text-properties
      (let ((inhibit-read-only t))
	(setplist 'forms--electric nil)
	(set-text-properties (point-min) (point-max) nil)))
  (erase-buffer)

  ;; Verify the number of fields, extend forms--the-record-list if needed.
  (if (= (length forms--the-record-list) forms-number-of-fields)

	    (message "Multi-line fields in this record - update refused!")
	    (beep))

	(save-excursion
	  (set-buffer forms--file-buffer)
	  ;; Insert something before kill-line is called.  See kill-line
	  ;; doc.  Bugfix provided by Ignatios Souvatzis.
	  (insert "*")
	  (beginning-of-line)
	  (kill-line nil)
	  (insert the-record)
	  (beginning-of-line))))))

(defun forms--checkmod ()
  "Check if this form has been modified, and call forms--update if so."

	  (y-or-n-p "Really delete this record? "))
      (let ((ln forms--current-record))
	(save-excursion
	  (set-buffer forms--file-buffer)
	  (goto-line ln)
	  (kill-line 1))
	(setq forms--total-records (1- forms--total-records))
	(if (> forms--current-record forms--total-records)
	    (setq forms--current-record forms--total-records))
	(forms-jump-record forms--current-record)))
  (message ""))

4723:6a3f5f51897b

;;; forms.el -- Forms mode: edit a file as a form to fill in.
;;; Copyright (C) 1991, 1993 Free Software Foundation, Inc.

;; Author: Johan Vromans <[e-mail]>
;; Version: 2.2

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;;; Visit a file using a form.
;;;
;;; === Naming conventions
;;;
;;; The names of all variables and functions start with 'forms-'.
;;; Names which start with 'forms--' are intended for internal use, and
;;; should *NOT* be used from the outside.
;;;
;;; All variables are buffer-local, to enable multiple forms visits 
;;; simultaneously.
;;; Variable `forms--mode-setup' is local to *ALL* buffers, for it 

;;; Global variables and constants:

(provide 'forms)			;;; official
(provide 'forms-mode)			;;; for compatibility

(defconst forms-version "2.2"
  "Version of forms-mode implementation.")

(defvar forms-mode-hooks nil
  "Hook functions to be run upon entering Forms mode.")


	  (if (> field-num (length forms--elements))
	      (setq forms--elements (vconcat forms--elements (1- el)))
	    (aset forms--elements field-num (1- el)))
	  (setq field-num (1+ field-num))

	  (if prev-item
	      (setq forms-format-list
		    (append forms-format-list (list prev-item) nil)))
	  (setq prev-item el))

	 ;; Try function ...
	 ((listp el)

    (if prev-item
	(progn
	  (setq forms-format-list
		(append forms-format-list (list prev-item) nil))
	  ;; Append a newline if the last item is a field.
	  ;; This prevents parsing problems.
	  ;; Also it makes it possible to insert an empty last field.
	  (if (numberp prev-item)
	      (setq forms-format-list
		    (append forms-format-list (list "\n") nil))))))

  (forms--debug 'forms-format-list
		'forms--elements))

;; Special treatment for read-only segments.
;;
;; If text is inserted between two read-only segments, it inherits the
;; read-only properties.  This is not what we want.
;; To solve this, read-only segments get the `insert-in-front-hooks'
;; property set with a function that temporarily switches the properties
;; of the first character of the segment to read-write, so the new
;; text gets the right properties.
;; The `post-command-hook' is used to restore the original properties.

(defvar forms--iif-start nil
  "Record start of modification command.")
(defvar forms--iif-properties nil
  "Original properties of the character being overridden.")

(defun forms--iif-hook (begin end)
  "`insert-in-front-hooks' function for read-only segments."

  ;; Note start location.  By making it a marker that points one 
  ;; character beyond the actual location, it is guaranteed to move 
  ;; correctly if text is inserted.
  (or forms--iif-start
      (setq forms--iif-start (copy-marker (1+ (point)))))

  ;; Check if there is special treatment required.
  (if (or (<= forms--iif-start 2)
	  (get-text-property (- forms--iif-start 2)
			     'read-only))
      (progn
	;; Fetch current properties.
	(setq forms--iif-properties 
	      (text-properties-at (1- forms--iif-start)))

	;; Replace them.
	(let ((inhibit-read-only t))
	  (set-text-properties 
	   (1- forms--iif-start) forms--iif-start
	   (list 'face forms--rw-face 'front-sticky '(face))))

	;; Enable `post-command-hook' to restore the properties.
	(setq post-command-hook
	      (append (list 'forms--iif-post-command-hook) post-command-hook)))

    ;; No action needed.  Clear marker.
    (setq forms--iif-start nil)))

(defun forms--iif-post-command-hook ()
  "`post-command-hook' function for read-only segments."

  ;; Disable `post-command-hook'.
  (setq post-command-hook
	(delq 'forms--iif-hook-post-command-hook post-command-hook))

  ;; Restore properties.
  (if forms--iif-start
      (let ((inhibit-read-only t))
	(set-text-properties 
	 (1- forms--iif-start) forms--iif-start
	 forms--iif-properties)))

  ;; Cleanup.
  (setq forms--iif-start nil))

(defvar forms--marker)
(defvar forms--dyntext)

(defun forms--make-format ()

    (setq 
     forms--format
     (if forms-use-text-properties 
	 (` (lambda (arg)
	      (let ((inhibit-read-only t))
		(,@ (apply 'append
			   (mapcar 'forms--make-format-elt-using-text-properties
				   forms-format-list)))
		;; Prevent insertion before the first text.
		(,@ (if (numberp (car forms-format-list))
			nil
		      '((add-text-properties (point-min) (1+ (point-min))
					     '(front-sticky (read-only))))))
		;; Prevent insertion after the last text.
		(remove-text-properties (1- (point)) (point)
					'(rear-nonsticky)))
	      (setq forms--iif-start nil)))
       (` (lambda (arg)
	    (,@ (apply 'append
		       (mapcar 'forms--make-format-elt forms-format-list)))))))

    ;; We have tallied the number of markers and dynamic texts,

  ;; The format routine `forms--format' will look like
  ;;
  ;; ;; preamble
  ;; (lambda (arg)
  ;;   (let ((inhibit-read-only t))
  ;;
  ;;     ;; A string, e.g. "text: ".
  ;;     (set-text-properties 
  ;;      (point)
  ;;      (progn (insert "text: ") (point)) 
  ;;      (list 'face forms--ro-face
  ;;		'read-only 1
  ;;		'insert-in-front-hooks 'forms--iif-hook
  ;;		'rear-nonsticky '(read-only face insert-in-front-hooks)))
  ;;
  ;;     ;; A field, e.g. 6.
  ;;     (let ((here (point)))
  ;;       (aset forms--markers 0 (point-marker))
  ;;       (insert (elt arg 5))
  ;;       (or (= (point) here)
  ;; 	  (set-text-properties 
  ;; 	   here (point)
  ;; 	   (list 'face forms--rw-face
  ;;		 'front-sticky '(face))))
  ;;
  ;;     ;; Another string, e.g. "\nmore text: ".
  ;;     (set-text-properties
  ;;      (point)
  ;;      (progn (insert "\nmore text: ") (point))
  ;;      (list 'face forms--ro-face
  ;;		'read-only 2
  ;;		'insert-in-front-hooks 'forms--iif-hook
  ;;		'rear-nonsticky '(read-only face insert-in-front-hooks)))
  ;;
  ;;     ;; A function, e.g. (tocol 40).
  ;;     (set-text-properties
  ;;      (point)
  ;;      (progn
  ;;        (insert (aset forms--dyntexts 0 (tocol 40)))
  ;;        (point))
  ;;      (list 'face forms--ro-face
  ;;		'read-only 2
  ;;		'insert-in-front-hooks 'forms--iif-hook
  ;;		'rear-nonsticky '(read-only face insert-in-front-hooks)))
  ;;
  ;;	 ;; Prevent insertion before the first text.
  ;;	 (add-text-properties (point-min) (1+ (point-min))
  ;;			      '(front-sticky (read-only))))))
  ;;	 ;; Prevent insertion after the last text.
  ;;	 (remove-text-properties (1- (point)) (point)
  ;;	 			 '(rear-nonsticky)))
  ;;
  ;;     ;; wrap up
  ;;     (setq forms--iif-start nil)
  ;;     ))

  (cond
   ((stringp el)
    

	 (point)			; start at point
	 (progn				; until after insertion
	   (insert (, el))
	   (point))
	 (list 'face forms--ro-face	; read-only appearance
	       'read-only (,@ (list (1+ forms--marker)))
	       'insert-in-front-hooks '(forms--iif-hook)
	       'rear-nonsticky '(face read-only insert-in-front-hooks))))))
    
   ((numberp el)
    (` ((let ((here (point)))
	  (aset forms--markers 
		(, (prog1 forms--marker
		     (setq forms--marker (1+ forms--marker))))
		(point-marker))
	  (insert (elt arg (, (1- el))))
	  (or (= (point) here)
	      (set-text-properties 
	       here (point)
	       (list 'face forms--rw-face
		     'front-sticky '(face))))))))

   ((listp el)
    (` ((set-text-properties
	 (point)
	 (progn

			 (, (prog1 forms--dyntext
			      (setq forms--dyntext (1+ forms--dyntext))))
			 (, el)))
	   (point))
	 (list 'face forms--ro-face
	       'read-only (,@ (list (1+ forms--marker)))
	       'insert-in-front-hooks '(forms--iif-hook)
	       'rear-nonsticky '(read-only face insert-in-front-hooks))))))

   ;; end of cond
   ))

(defun forms--make-format-elt (el)

    (setq forms--the-record-list the-result))

  (setq buffer-read-only nil)
  (if forms-use-text-properties
      (let ((inhibit-read-only t))
	(set-text-properties (point-min) (point-max) nil)))
  (erase-buffer)

  ;; Verify the number of fields, extend forms--the-record-list if needed.
  (if (= (length forms--the-record-list) forms-number-of-fields)

	    (message "Multi-line fields in this record - update refused!")
	    (beep))

	(save-excursion
	  (set-buffer forms--file-buffer)
	  ;; Use delete-region instead of kill-region, to avoid
	  ;; adding junk to the kill-ring.
	  (delete-region (save-excursion (beginning-of-line) (point))
			 (save-excursion (end-of-line) (point)))
	  (insert the-record)
	  (beginning-of-line))))))

(defun forms--checkmod ()
  "Check if this form has been modified, and call forms--update if so."

	  (y-or-n-p "Really delete this record? "))
      (let ((ln forms--current-record))
	(save-excursion
	  (set-buffer forms--file-buffer)
	  (goto-line ln)
	  ;; Use delete-region instead of kill-region, to avoid
	  ;; adding junk to the kill-ring.
	  (delete-region (save-excursion (beginning-of-line) (point))
			 (save-excursion (end-of-line) (1+ (point)))))
	(setq forms--total-records (1- forms--total-records))
	(if (> forms--current-record forms--total-records)
	    (setq forms--current-record forms--total-records))
	(forms-jump-record forms--current-record)))
  (message ""))