Mercurial > emacs
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.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 15 Sep 1993 05:25:16 +0000 |
parents | 25d32add267c |
children | b110036d90b0 |
comparison
equal
deleted
inserted
replaced
4722:1b0ce8ac1c81 | 4723:6a3f5f51897b |
---|---|
1 ;;; forms.el -- Forms mode: edit a file as a form to fill in. | 1 ;;; forms.el -- Forms mode: edit a file as a form to fill in. |
2 ;;; 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.0 | 5 ;; Version: 2.2 |
6 | 6 |
7 ;; This file is part of GNU Emacs. | 7 ;; This file is part of GNU Emacs. |
8 | 8 |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | 9 ;; GNU Emacs is free software; you can redistribute it and/or modify |
10 ;; it under the terms of the GNU General Public License as published by | 10 ;; it under the terms of the GNU General Public License as published by |
24 | 24 |
25 ;;; Visit a file using a form. | 25 ;;; Visit a file using a form. |
26 ;;; | 26 ;;; |
27 ;;; === Naming conventions | 27 ;;; === Naming conventions |
28 ;;; | 28 ;;; |
29 ;;; The names of all variables and functions start with 'form-'. | 29 ;;; The names of all variables and functions start with 'forms-'. |
30 ;;; Names which start with 'form--' are intended for internal use, and | 30 ;;; Names which start with 'forms--' are intended for internal use, and |
31 ;;; should *NOT* be used from the outside. | 31 ;;; should *NOT* be used from the outside. |
32 ;;; | 32 ;;; |
33 ;;; All variables are buffer-local, to enable multiple forms visits | 33 ;;; All variables are buffer-local, to enable multiple forms visits |
34 ;;; simultaneously. | 34 ;;; simultaneously. |
35 ;;; Variable `forms--mode-setup' is local to *ALL* buffers, for it | 35 ;;; Variable `forms--mode-setup' is local to *ALL* buffers, for it |
251 ;;; Global variables and constants: | 251 ;;; Global variables and constants: |
252 | 252 |
253 (provide 'forms) ;;; official | 253 (provide 'forms) ;;; official |
254 (provide 'forms-mode) ;;; for compatibility | 254 (provide 'forms-mode) ;;; for compatibility |
255 | 255 |
256 (defconst forms-version "2.0" | 256 (defconst forms-version "2.2" |
257 "Version of forms-mode implementation.") | 257 "Version of forms-mode implementation.") |
258 | 258 |
259 (defvar forms-mode-hooks nil | 259 (defvar forms-mode-hooks nil |
260 "Hook functions to be run upon entering Forms mode.") | 260 "Hook functions to be run upon entering Forms mode.") |
261 | 261 |
641 (if (> field-num (length forms--elements)) | 641 (if (> field-num (length forms--elements)) |
642 (setq forms--elements (vconcat forms--elements (1- el))) | 642 (setq forms--elements (vconcat forms--elements (1- el))) |
643 (aset forms--elements field-num (1- el))) | 643 (aset forms--elements field-num (1- el))) |
644 (setq field-num (1+ field-num)) | 644 (setq field-num (1+ field-num)) |
645 | 645 |
646 ;; Make sure the field is preceded by something. | |
647 (if prev-item | 646 (if prev-item |
648 (setq forms-format-list | 647 (setq forms-format-list |
649 (append forms-format-list (list prev-item) nil)) | 648 (append forms-format-list (list prev-item) nil))) |
650 (setq forms-format-list | |
651 (append forms-format-list (list "\n") nil))) | |
652 (setq prev-item el)) | 649 (setq prev-item el)) |
653 | 650 |
654 ;; Try function ... | 651 ;; Try function ... |
655 ((listp el) | 652 ((listp el) |
656 | 653 |
678 (if prev-item | 675 (if prev-item |
679 (progn | 676 (progn |
680 (setq forms-format-list | 677 (setq forms-format-list |
681 (append forms-format-list (list prev-item) nil)) | 678 (append forms-format-list (list prev-item) nil)) |
682 ;; Append a newline if the last item is a field. | 679 ;; Append a newline if the last item is a field. |
683 ;; This prevents pasrsing problems. | 680 ;; This prevents parsing problems. |
684 ;; Also it makes it possible to insert an empty last field. | 681 ;; Also it makes it possible to insert an empty last field. |
685 (if (numberp prev-item) | 682 (if (numberp prev-item) |
686 (setq forms-format-list | 683 (setq forms-format-list |
687 (append forms-format-list (list "\n") nil)))))) | 684 (append forms-format-list (list "\n") nil)))))) |
688 | 685 |
689 (forms--debug 'forms-format-list | 686 (forms--debug 'forms-format-list |
690 'forms--elements)) | 687 'forms--elements)) |
691 | 688 |
692 ;; Special treatment for read-only segments. | 689 ;; Special treatment for read-only segments. |
693 ;; | 690 ;; |
694 ;; If text is inserted after a read-only segment, it inherits the | 691 ;; If text is inserted between two read-only segments, it inherits the |
695 ;; read-only properties. This is not what we want. | 692 ;; read-only properties. This is not what we want. |
696 ;; The modification hook of the last character of the read-only segment | 693 ;; To solve this, read-only segments get the `insert-in-front-hooks' |
697 ;; temporarily switches its properties to read-write, so the new | 694 ;; property set with a function that temporarily switches the properties |
695 ;; of the first character of the segment to read-write, so the new | |
698 ;; text gets the right properties. | 696 ;; text gets the right properties. |
699 ;; The post-command-hook is used to restore the original properties. | 697 ;; The `post-command-hook' is used to restore the original properties. |
700 ;; | 698 |
701 ;; A character category `forms-electric' is used for the characters | 699 (defvar forms--iif-start nil |
702 ;; that get the modification hook set. Using a category, it is | |
703 ;; possible to globally enable/disable the modification hook. This is | |
704 ;; necessary, since modifying a hook or setting text properties are | |
705 ;; considered modifications and would trigger the hooks while building | |
706 ;; the forms. | |
707 | |
708 (defvar forms--ro-modification-start nil | |
709 "Record start of modification command.") | 700 "Record start of modification command.") |
710 (defvar forms--ro-properties nil | 701 (defvar forms--iif-properties nil |
711 "Original properties of the character being overridden.") | 702 "Original properties of the character being overridden.") |
712 | 703 |
713 (defun forms--romh (begin end) | 704 (defun forms--iif-hook (begin end) |
714 "`modification-hook' function for forms-electric characters." | 705 "`insert-in-front-hooks' function for read-only segments." |
715 | 706 |
716 ;; Note start location. | 707 ;; Note start location. By making it a marker that points one |
717 (or forms--ro-modification-start | 708 ;; character beyond the actual location, it is guaranteed to move |
718 (setq forms--ro-modification-start (point))) | 709 ;; correctly if text is inserted. |
719 | 710 (or forms--iif-start |
720 ;; Fetch current properties. | 711 (setq forms--iif-start (copy-marker (1+ (point))))) |
721 (setq forms--ro-properties | 712 |
722 (text-properties-at (1- forms--ro-modification-start))) | 713 ;; Check if there is special treatment required. |
723 | 714 (if (or (<= forms--iif-start 2) |
724 ;; Disarm modification hook. | 715 (get-text-property (- forms--iif-start 2) |
725 (setplist 'forms--electric nil) | 716 'read-only)) |
726 | 717 (progn |
727 ;; Replace them. | 718 ;; Fetch current properties. |
728 (let ((inhibit-read-only t)) | 719 (setq forms--iif-properties |
729 (set-text-properties | 720 (text-properties-at (1- forms--iif-start))) |
730 (1- forms--ro-modification-start) forms--ro-modification-start | 721 |
731 (list 'face forms--rw-face))) | 722 ;; Replace them. |
732 | 723 (let ((inhibit-read-only t)) |
733 ;; Re-arm electric. | 724 (set-text-properties |
734 (setplist 'forms--electric '(modification-hooks (forms--romh))) | 725 (1- forms--iif-start) forms--iif-start |
735 | 726 (list 'face forms--rw-face 'front-sticky '(face)))) |
736 ;; Enable `post-command-hook' to restore the properties. | 727 |
737 (setq post-command-hook | 728 ;; Enable `post-command-hook' to restore the properties. |
738 (append (list 'forms--romh-post-command-hook) post-command-hook))) | 729 (setq post-command-hook |
739 | 730 (append (list 'forms--iif-post-command-hook) post-command-hook))) |
740 (defun forms--romh-post-command-hook () | 731 |
741 "`post-command-hook' function for forms--electric characters." | 732 ;; No action needed. Clear marker. |
733 (setq forms--iif-start nil))) | |
734 | |
735 (defun forms--iif-post-command-hook () | |
736 "`post-command-hook' function for read-only segments." | |
742 | 737 |
743 ;; Disable `post-command-hook'. | 738 ;; Disable `post-command-hook'. |
744 (setq post-command-hook | 739 (setq post-command-hook |
745 (delq 'forms--romh-post-command-hook post-command-hook)) | 740 (delq 'forms--iif-hook-post-command-hook post-command-hook)) |
746 | |
747 ;; Disarm modification hook. | |
748 (setplist 'forms--electric nil) | |
749 | 741 |
750 ;; Restore properties. | 742 ;; Restore properties. |
751 (if forms--ro-modification-start | 743 (if forms--iif-start |
752 (let ((inhibit-read-only t)) | 744 (let ((inhibit-read-only t)) |
753 (set-text-properties | 745 (set-text-properties |
754 (1- forms--ro-modification-start) forms--ro-modification-start | 746 (1- forms--iif-start) forms--iif-start |
755 forms--ro-properties))) | 747 forms--iif-properties))) |
756 | |
757 ;; Re-arm electric. | |
758 (setplist 'forms--electric '(modification-hooks (forms--romh))) | |
759 | 748 |
760 ;; Cleanup. | 749 ;; Cleanup. |
761 (setq forms--ro-modification-start nil)) | 750 (setq forms--iif-start nil)) |
762 | 751 |
763 (defvar forms--marker) | 752 (defvar forms--marker) |
764 (defvar forms--dyntext) | 753 (defvar forms--dyntext) |
765 | 754 |
766 (defun forms--make-format () | 755 (defun forms--make-format () |
776 (setq | 765 (setq |
777 forms--format | 766 forms--format |
778 (if forms-use-text-properties | 767 (if forms-use-text-properties |
779 (` (lambda (arg) | 768 (` (lambda (arg) |
780 (let ((inhibit-read-only t)) | 769 (let ((inhibit-read-only t)) |
781 (setplist 'forms--electric nil) | |
782 (,@ (apply 'append | 770 (,@ (apply 'append |
783 (mapcar 'forms--make-format-elt-using-text-properties | 771 (mapcar 'forms--make-format-elt-using-text-properties |
784 forms-format-list)))) | 772 forms-format-list))) |
785 (setplist 'forms--electric | 773 ;; Prevent insertion before the first text. |
786 '(modification-hooks (forms--romh))) | 774 (,@ (if (numberp (car forms-format-list)) |
787 (setq forms--ro-modification-start nil))) | 775 nil |
776 '((add-text-properties (point-min) (1+ (point-min)) | |
777 '(front-sticky (read-only)))))) | |
778 ;; Prevent insertion after the last text. | |
779 (remove-text-properties (1- (point)) (point) | |
780 '(rear-nonsticky))) | |
781 (setq forms--iif-start nil))) | |
788 (` (lambda (arg) | 782 (` (lambda (arg) |
789 (,@ (apply 'append | 783 (,@ (apply 'append |
790 (mapcar 'forms--make-format-elt forms-format-list))))))) | 784 (mapcar 'forms--make-format-elt forms-format-list))))))) |
791 | 785 |
792 ;; We have tallied the number of markers and dynamic texts, | 786 ;; We have tallied the number of markers and dynamic texts, |
801 ;; The format routine `forms--format' will look like | 795 ;; The format routine `forms--format' will look like |
802 ;; | 796 ;; |
803 ;; ;; preamble | 797 ;; ;; preamble |
804 ;; (lambda (arg) | 798 ;; (lambda (arg) |
805 ;; (let ((inhibit-read-only t)) | 799 ;; (let ((inhibit-read-only t)) |
806 ;; (setplist 'forms--electric nil) | |
807 ;; | 800 ;; |
808 ;; ;; a string, e.g. "text: " | 801 ;; ;; A string, e.g. "text: ". |
809 ;; (set-text-properties | 802 ;; (set-text-properties |
810 ;; (point) | 803 ;; (point) |
811 ;; (progn (insert "text: ") (point)) | 804 ;; (progn (insert "text: ") (point)) |
812 ;; (list 'face forms--ro-face 'read-only 1)) | 805 ;; (list 'face forms--ro-face |
806 ;; 'read-only 1 | |
807 ;; 'insert-in-front-hooks 'forms--iif-hook | |
808 ;; 'rear-nonsticky '(read-only face insert-in-front-hooks))) | |
813 ;; | 809 ;; |
814 ;; ;; a field, e.g. 6 | 810 ;; ;; A field, e.g. 6. |
815 ;; (let ((here (point))) | 811 ;; (let ((here (point))) |
816 ;; (aset forms--markers 0 (point-marker)) | 812 ;; (aset forms--markers 0 (point-marker)) |
817 ;; (insert (elt arg 5)) | 813 ;; (insert (elt arg 5)) |
818 ;; (or (= (point) here) | 814 ;; (or (= (point) here) |
819 ;; (set-text-properties | 815 ;; (set-text-properties |
820 ;; here (point) | 816 ;; here (point) |
821 ;; (list 'face forms--rw-face))) | 817 ;; (list 'face forms--rw-face |
822 ;; (if (get-text-property (1- here) 'read-only) | 818 ;; 'front-sticky '(face)))) |
823 ;; (put-text-property | |
824 ;; (1- here) here | |
825 ;; 'category 'forms--electric))) | |
826 ;; | 819 ;; |
827 ;; ;; another string, e.g. "\nmore text: " | 820 ;; ;; Another string, e.g. "\nmore text: ". |
828 ;; (set-text-properties | 821 ;; (set-text-properties |
829 ;; (point) | 822 ;; (point) |
830 ;; (progn (insert "\nmore text: ") (point)) | 823 ;; (progn (insert "\nmore text: ") (point)) |
831 ;; (list 'face forms--ro-face | 824 ;; (list 'face forms--ro-face |
832 ;; 'read-only 2)) | 825 ;; 'read-only 2 |
826 ;; 'insert-in-front-hooks 'forms--iif-hook | |
827 ;; 'rear-nonsticky '(read-only face insert-in-front-hooks))) | |
833 ;; | 828 ;; |
834 ;; ;; a function, e.g. (tocol 40) | 829 ;; ;; A function, e.g. (tocol 40). |
835 ;; (set-text-properties | 830 ;; (set-text-properties |
836 ;; (point) | 831 ;; (point) |
837 ;; (progn | 832 ;; (progn |
838 ;; (insert (aset forms--dyntexts 0 (tocol 40))) | 833 ;; (insert (aset forms--dyntexts 0 (tocol 40))) |
839 ;; (point)) | 834 ;; (point)) |
840 ;; (list 'face forms--ro-face | 835 ;; (list 'face forms--ro-face |
841 ;; 'read-only 2)) | 836 ;; 'read-only 2 |
837 ;; 'insert-in-front-hooks 'forms--iif-hook | |
838 ;; 'rear-nonsticky '(read-only face insert-in-front-hooks))) | |
839 ;; | |
840 ;; ;; Prevent insertion before the first text. | |
841 ;; (add-text-properties (point-min) (1+ (point-min)) | |
842 ;; '(front-sticky (read-only)))))) | |
843 ;; ;; Prevent insertion after the last text. | |
844 ;; (remove-text-properties (1- (point)) (point) | |
845 ;; '(rear-nonsticky))) | |
842 ;; | 846 ;; |
843 ;; ;; wrap up | 847 ;; ;; wrap up |
844 ;; (setplist 'forms--electric | 848 ;; (setq forms--iif-start nil) |
845 ;; '(modification-hooks (forms--romh))) | |
846 ;; (setq forms--ro-modification-start nil) | |
847 ;; )) | 849 ;; )) |
848 | 850 |
849 (cond | 851 (cond |
850 ((stringp el) | 852 ((stringp el) |
851 | 853 |
853 (point) ; start at point | 855 (point) ; start at point |
854 (progn ; until after insertion | 856 (progn ; until after insertion |
855 (insert (, el)) | 857 (insert (, el)) |
856 (point)) | 858 (point)) |
857 (list 'face forms--ro-face ; read-only appearance | 859 (list 'face forms--ro-face ; read-only appearance |
858 'read-only (,@ (list (1+ forms--marker)))))))) | 860 'read-only (,@ (list (1+ forms--marker))) |
861 'insert-in-front-hooks '(forms--iif-hook) | |
862 'rear-nonsticky '(face read-only insert-in-front-hooks)))))) | |
863 | |
859 ((numberp el) | 864 ((numberp el) |
860 (` ((let ((here (point))) | 865 (` ((let ((here (point))) |
861 (aset forms--markers | 866 (aset forms--markers |
862 (, (prog1 forms--marker | 867 (, (prog1 forms--marker |
863 (setq forms--marker (1+ forms--marker)))) | 868 (setq forms--marker (1+ forms--marker)))) |
864 (point-marker)) | 869 (point-marker)) |
865 (insert (elt arg (, (1- el)))) | 870 (insert (elt arg (, (1- el)))) |
866 (or (= (point) here) | 871 (or (= (point) here) |
867 (set-text-properties | 872 (set-text-properties |
868 here (point) | 873 here (point) |
869 (list 'face forms--rw-face))) | 874 (list 'face forms--rw-face |
870 (if (get-text-property (1- here) 'read-only) | 875 'front-sticky '(face)))))))) |
871 (put-text-property | |
872 (1- here) here | |
873 'category 'forms--electric)))))) | |
874 | 876 |
875 ((listp el) | 877 ((listp el) |
876 (` ((set-text-properties | 878 (` ((set-text-properties |
877 (point) | 879 (point) |
878 (progn | 880 (progn |
880 (, (prog1 forms--dyntext | 882 (, (prog1 forms--dyntext |
881 (setq forms--dyntext (1+ forms--dyntext)))) | 883 (setq forms--dyntext (1+ forms--dyntext)))) |
882 (, el))) | 884 (, el))) |
883 (point)) | 885 (point)) |
884 (list 'face forms--ro-face | 886 (list 'face forms--ro-face |
885 'read-only | 887 'read-only (,@ (list (1+ forms--marker))) |
886 (,@ (list (1+ forms--marker)))))))) | 888 'insert-in-front-hooks '(forms--iif-hook) |
889 'rear-nonsticky '(read-only face insert-in-front-hooks)))))) | |
887 | 890 |
888 ;; end of cond | 891 ;; end of cond |
889 )) | 892 )) |
890 | 893 |
891 (defun forms--make-format-elt (el) | 894 (defun forms--make-format-elt (el) |
1205 (setq forms--the-record-list the-result)) | 1208 (setq forms--the-record-list the-result)) |
1206 | 1209 |
1207 (setq buffer-read-only nil) | 1210 (setq buffer-read-only nil) |
1208 (if forms-use-text-properties | 1211 (if forms-use-text-properties |
1209 (let ((inhibit-read-only t)) | 1212 (let ((inhibit-read-only t)) |
1210 (setplist 'forms--electric nil) | |
1211 (set-text-properties (point-min) (point-max) nil))) | 1213 (set-text-properties (point-min) (point-max) nil))) |
1212 (erase-buffer) | 1214 (erase-buffer) |
1213 | 1215 |
1214 ;; Verify the number of fields, extend forms--the-record-list if needed. | 1216 ;; Verify the number of fields, extend forms--the-record-list if needed. |
1215 (if (= (length forms--the-record-list) forms-number-of-fields) | 1217 (if (= (length forms--the-record-list) forms-number-of-fields) |
1289 (message "Multi-line fields in this record - update refused!") | 1291 (message "Multi-line fields in this record - update refused!") |
1290 (beep)) | 1292 (beep)) |
1291 | 1293 |
1292 (save-excursion | 1294 (save-excursion |
1293 (set-buffer forms--file-buffer) | 1295 (set-buffer forms--file-buffer) |
1294 ;; Insert something before kill-line is called. See kill-line | 1296 ;; Use delete-region instead of kill-region, to avoid |
1295 ;; doc. Bugfix provided by Ignatios Souvatzis. | 1297 ;; adding junk to the kill-ring. |
1296 (insert "*") | 1298 (delete-region (save-excursion (beginning-of-line) (point)) |
1297 (beginning-of-line) | 1299 (save-excursion (end-of-line) (point))) |
1298 (kill-line nil) | |
1299 (insert the-record) | 1300 (insert the-record) |
1300 (beginning-of-line)))))) | 1301 (beginning-of-line)))))) |
1301 | 1302 |
1302 (defun forms--checkmod () | 1303 (defun forms--checkmod () |
1303 "Check if this form has been modified, and call forms--update if so." | 1304 "Check if this form has been modified, and call forms--update if so." |
1497 (y-or-n-p "Really delete this record? ")) | 1498 (y-or-n-p "Really delete this record? ")) |
1498 (let ((ln forms--current-record)) | 1499 (let ((ln forms--current-record)) |
1499 (save-excursion | 1500 (save-excursion |
1500 (set-buffer forms--file-buffer) | 1501 (set-buffer forms--file-buffer) |
1501 (goto-line ln) | 1502 (goto-line ln) |
1502 (kill-line 1)) | 1503 ;; Use delete-region instead of kill-region, to avoid |
1504 ;; adding junk to the kill-ring. | |
1505 (delete-region (save-excursion (beginning-of-line) (point)) | |
1506 (save-excursion (end-of-line) (1+ (point))))) | |
1503 (setq forms--total-records (1- forms--total-records)) | 1507 (setq forms--total-records (1- forms--total-records)) |
1504 (if (> forms--current-record forms--total-records) | 1508 (if (> forms--current-record forms--total-records) |
1505 (setq forms--current-record forms--total-records)) | 1509 (setq forms--current-record forms--total-records)) |
1506 (forms-jump-record forms--current-record))) | 1510 (forms-jump-record forms--current-record))) |
1507 (message "")) | 1511 (message "")) |