Mercurial > emacs
comparison lisp/facemenu.el @ 109881:3db1493a6f89
New post-self-insert-hook.
* src/cmds.c (Vself_insert_face, Vself_insert_face_command): Remove.
(Qpost_self_insert_hook, Vpost_self_insert_hook): New vars.
(internal_self_insert): Run post-self-insert-hook rather than handle
self-insert-face.
(syms_of_cmds): Initialize the new vars.
* lisp/facemenu.el (facemenu-self-insert-data): New var.
(facemenu-post-self-insert-function, facemenu-set-self-insert-face): New funs.
(facemenu-add-face): Use them.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Thu, 19 Aug 2010 17:43:45 +0200 |
| parents | d94083f6e4e9 |
| children | 280c8ae2476d |
comparison
equal
deleted
inserted
replaced
| 109880:22ddbf1e2954 | 109881:3db1493a6f89 |
|---|---|
| 697 names mean. It returns nil if the colors differ or if it can't | 697 names mean. It returns nil if the colors differ or if it can't |
| 698 determine the correct answer." | 698 determine the correct answer." |
| 699 (cond ((equal a b) t) | 699 (cond ((equal a b) t) |
| 700 ((equal (color-values a) (color-values b))))) | 700 ((equal (color-values a) (color-values b))))) |
| 701 | 701 |
| 702 | |
| 703 (defvar facemenu-self-insert-data nil) | |
| 704 | |
| 705 (defun facemenu-post-self-insert-function () | |
| 706 (when (and (car facemenu-self-insert-data) | |
| 707 (eq last-command (cdr facemenu-self-insert-data))) | |
| 708 (put-text-property (1- (point)) (point) | |
| 709 'face (car facemenu-self-insert-data)) | |
| 710 (setq facemenu-self-insert-data nil)) | |
| 711 (remove-hook 'post-self-insert-hook 'facemenu-post-self-insert-function)) | |
| 712 | |
| 713 (defun facemenu-set-self-insert-face (face) | |
| 714 "Arrange for the next self-inserted char to have face `face'." | |
| 715 (setq facemenu-self-insert-data (cons face this-command)) | |
| 716 (add-hook 'post-self-insert-hook 'facemenu-post-self-insert-function)) | |
| 717 | |
| 702 (defun facemenu-add-face (face &optional start end) | 718 (defun facemenu-add-face (face &optional start end) |
| 703 "Add FACE to text between START and END. | 719 "Add FACE to text between START and END. |
| 704 If START is nil or START to END is empty, add FACE to next typed character | 720 If START is nil or START to END is empty, add FACE to next typed character |
| 705 instead. For each section of that region that has a different face property, | 721 instead. For each section of that region that has a different face property, |
| 706 FACE will be consed onto it, and other faces that are completely hidden by | 722 FACE will be consed onto it, and other faces that are completely hidden by |
| 710 | 726 |
| 711 As a special case, if FACE is `default', then the region is left with NO face | 727 As a special case, if FACE is `default', then the region is left with NO face |
| 712 text property. Otherwise, selecting the default face would not have any | 728 text property. Otherwise, selecting the default face would not have any |
| 713 effect. See `facemenu-remove-face-function'." | 729 effect. See `facemenu-remove-face-function'." |
| 714 (interactive "*xFace: \nr") | 730 (interactive "*xFace: \nr") |
| 715 (if (and (eq face 'default) | 731 (cond |
| 716 (not (eq facemenu-remove-face-function t))) | 732 ((and (eq face 'default) |
| 717 (if facemenu-remove-face-function | 733 (not (eq facemenu-remove-face-function t))) |
| 718 (funcall facemenu-remove-face-function start end) | 734 (if facemenu-remove-face-function |
| 719 (if (and start (< start end)) | 735 (funcall facemenu-remove-face-function start end) |
| 720 (remove-text-properties start end '(face default)) | |
| 721 (setq self-insert-face 'default | |
| 722 self-insert-face-command this-command))) | |
| 723 (if facemenu-add-face-function | |
| 724 (save-excursion | |
| 725 (if end (goto-char end)) | |
| 726 (save-excursion | |
| 727 (if start (goto-char start)) | |
| 728 (insert-before-markers | |
| 729 (funcall facemenu-add-face-function face end))) | |
| 730 (if facemenu-end-add-face | |
| 731 (insert (if (stringp facemenu-end-add-face) | |
| 732 facemenu-end-add-face | |
| 733 (funcall facemenu-end-add-face face))))) | |
| 734 (if (and start (< start end)) | 736 (if (and start (< start end)) |
| 735 (let ((part-start start) part-end) | 737 (remove-text-properties start end '(face default)) |
| 736 (while (not (= part-start end)) | 738 (facemenu-set-self-insert-face 'default)))) |
| 737 (setq part-end (next-single-property-change part-start 'face | 739 (facemenu-add-face-function |
| 738 nil end)) | 740 (save-excursion |
| 739 (let ((prev (get-text-property part-start 'face))) | 741 (if end (goto-char end)) |
| 740 (put-text-property part-start part-end 'face | 742 (save-excursion |
| 741 (if (null prev) | 743 (if start (goto-char start)) |
| 742 face | 744 (insert-before-markers |
| 743 (facemenu-active-faces | 745 (funcall facemenu-add-face-function face end))) |
| 744 (cons face | 746 (if facemenu-end-add-face |
| 745 (if (listp prev) | 747 (insert (if (stringp facemenu-end-add-face) |
| 746 prev | 748 facemenu-end-add-face |
| 747 (list prev))) | 749 (funcall facemenu-end-add-face face)))))) |
| 748 ;; Specify the selected frame | 750 ((and start (< start end)) |
| 749 ;; because nil would mean to use | 751 (let ((part-start start) part-end) |
| 750 ;; the new-frame default settings, | 752 (while (not (= part-start end)) |
| 751 ;; and those are usually nil. | 753 (setq part-end (next-single-property-change part-start 'face |
| 752 (selected-frame))))) | 754 nil end)) |
| 753 (setq part-start part-end))) | 755 (let ((prev (get-text-property part-start 'face))) |
| 754 (setq self-insert-face (if (eq last-command self-insert-face-command) | 756 (put-text-property part-start part-end 'face |
| 755 (cons face (if (listp self-insert-face) | 757 (if (null prev) |
| 756 self-insert-face | 758 face |
| 757 (list self-insert-face))) | 759 (facemenu-active-faces |
| 758 face) | 760 (cons face |
| 759 self-insert-face-command this-command)))) | 761 (if (listp prev) |
| 762 prev | |
| 763 (list prev))) | |
| 764 ;; Specify the selected frame | |
| 765 ;; because nil would mean to use | |
| 766 ;; the new-frame default settings, | |
| 767 ;; and those are usually nil. | |
| 768 (selected-frame))))) | |
| 769 (setq part-start part-end)))) | |
| 770 (t | |
| 771 (facemenu-set-self-insert-face | |
| 772 (if (eq last-command (cdr facemenu-self-insert-data)) | |
| 773 (cons face (if (listp (car facemenu-self-insert-data)) | |
| 774 (car facemenu-self-insert-data) | |
| 775 (list (car facemenu-self-insert-data)))) | |
| 776 face)))) | |
| 760 (unless (facemenu-enable-faces-p) | 777 (unless (facemenu-enable-faces-p) |
| 761 (message "Font-lock mode will override any faces you set in this buffer"))) | 778 (message "Font-lock mode will override any faces you set in this buffer"))) |
| 762 | 779 |
| 763 (defun facemenu-active-faces (face-list &optional frame) | 780 (defun facemenu-active-faces (face-list &optional frame) |
| 764 "Return from FACE-LIST those faces that would be used for display. | 781 "Return from FACE-LIST those faces that would be used for display. |