From a2e5caf79e75361fb4d7e096e782398299ad1083 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 19 Aug 2010 17:43:45 +0200 Subject: [PATCH] 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. --- etc/NEWS | 2 + lisp/ChangeLog | 5 +++ lisp/facemenu.el | 105 +++++++++++++++++++++++++++-------------------- src/ChangeLog | 8 ++++ src/cmds.c | 41 +++++++----------- 5 files changed, 90 insertions(+), 71 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index fe111ad7038..0df0d20dbac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -453,6 +453,8 @@ has now been removed. * Lisp changes in Emacs 24.1 +** New hook post-self-insert-hook run at the end of self-insert-command. + ** Syntax tables support a new "comment style c" additionally to style b. ** frame-local variables cannot be let-bound any more. ** prog-mode is a new major-mode meant to be the parent of programming mode. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0d8c1304e6c..62d61759aa7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2010-08-19 Stefan Monnier + * facemenu.el (facemenu-self-insert-data): New var. + (facemenu-post-self-insert-function, facemenu-set-self-insert-face): + New functions. + (facemenu-add-face): Use them. + * simple.el (blink-matching-open): Obey forward-sexp-function. 2010-08-18 Stefan Monnier diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 20b86676ea9..992c6418d45 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -699,6 +699,22 @@ determine the correct answer." (cond ((equal a b) t) ((equal (color-values a) (color-values b))))) + +(defvar facemenu-self-insert-data nil) + +(defun facemenu-post-self-insert-function () + (when (and (car facemenu-self-insert-data) + (eq last-command (cdr facemenu-self-insert-data))) + (put-text-property (1- (point)) (point) + 'face (car facemenu-self-insert-data)) + (setq facemenu-self-insert-data nil)) + (remove-hook 'post-self-insert-hook 'facemenu-post-self-insert-function)) + +(defun facemenu-set-self-insert-face (face) + "Arrange for the next self-inserted char to have face `face'." + (setq facemenu-self-insert-data (cons face this-command)) + (add-hook 'post-self-insert-hook 'facemenu-post-self-insert-function)) + (defun facemenu-add-face (face &optional start end) "Add FACE to text between START and END. If START is nil or START to END is empty, add FACE to next typed character @@ -712,51 +728,52 @@ As a special case, if FACE is `default', then the region is left with NO face text property. Otherwise, selecting the default face would not have any effect. See `facemenu-remove-face-function'." (interactive "*xFace: \nr") - (if (and (eq face 'default) - (not (eq facemenu-remove-face-function t))) - (if facemenu-remove-face-function - (funcall facemenu-remove-face-function start end) - (if (and start (< start end)) - (remove-text-properties start end '(face default)) - (setq self-insert-face 'default - self-insert-face-command this-command))) - (if facemenu-add-face-function - (save-excursion - (if end (goto-char end)) - (save-excursion - (if start (goto-char start)) - (insert-before-markers - (funcall facemenu-add-face-function face end))) - (if facemenu-end-add-face - (insert (if (stringp facemenu-end-add-face) - facemenu-end-add-face - (funcall facemenu-end-add-face face))))) + (cond + ((and (eq face 'default) + (not (eq facemenu-remove-face-function t))) + (if facemenu-remove-face-function + (funcall facemenu-remove-face-function start end) (if (and start (< start end)) - (let ((part-start start) part-end) - (while (not (= part-start end)) - (setq part-end (next-single-property-change part-start 'face - nil end)) - (let ((prev (get-text-property part-start 'face))) - (put-text-property part-start part-end 'face - (if (null prev) - face - (facemenu-active-faces - (cons face - (if (listp prev) - prev - (list prev))) - ;; Specify the selected frame - ;; because nil would mean to use - ;; the new-frame default settings, - ;; and those are usually nil. - (selected-frame))))) - (setq part-start part-end))) - (setq self-insert-face (if (eq last-command self-insert-face-command) - (cons face (if (listp self-insert-face) - self-insert-face - (list self-insert-face))) - face) - self-insert-face-command this-command)))) + (remove-text-properties start end '(face default)) + (facemenu-set-self-insert-face 'default)))) + (facemenu-add-face-function + (save-excursion + (if end (goto-char end)) + (save-excursion + (if start (goto-char start)) + (insert-before-markers + (funcall facemenu-add-face-function face end))) + (if facemenu-end-add-face + (insert (if (stringp facemenu-end-add-face) + facemenu-end-add-face + (funcall facemenu-end-add-face face)))))) + ((and start (< start end)) + (let ((part-start start) part-end) + (while (not (= part-start end)) + (setq part-end (next-single-property-change part-start 'face + nil end)) + (let ((prev (get-text-property part-start 'face))) + (put-text-property part-start part-end 'face + (if (null prev) + face + (facemenu-active-faces + (cons face + (if (listp prev) + prev + (list prev))) + ;; Specify the selected frame + ;; because nil would mean to use + ;; the new-frame default settings, + ;; and those are usually nil. + (selected-frame))))) + (setq part-start part-end)))) + (t + (facemenu-set-self-insert-face + (if (eq last-command (cdr facemenu-self-insert-data)) + (cons face (if (listp (car facemenu-self-insert-data)) + (car facemenu-self-insert-data) + (list (car facemenu-self-insert-data)))) + face)))) (unless (facemenu-enable-faces-p) (message "Font-lock mode will override any faces you set in this buffer"))) diff --git a/src/ChangeLog b/src/ChangeLog index 649964178d5..96d5c774339 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2010-08-19 Stefan Monnier + + * cmds.c (Vself_insert_face, Vself_insert_face_command): Remove. + (Qpost_self_insert_hook, Vpost_self_insert_hook): New vars. + (internal_self_insert): Run Qpost_self_insert_hook rather than handle + self-insert-face. + (syms_of_cmds): Initialize the new vars. + 2010-08-19 Jason Rumney * w32fns.c (w32_wnd_proc): Don't check context before initializing. diff --git a/src/cmds.c b/src/cmds.c index 4cb6ca199e7..f306ede7ca5 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -37,12 +37,6 @@ Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function; /* A possible value for a buffer's overwrite-mode variable. */ Lisp_Object Qoverwrite_mode_binary; -/* Non-nil means put this face on the next self-inserting character. */ -Lisp_Object Vself_insert_face; - -/* This is the command that set up Vself_insert_face. */ -Lisp_Object Vself_insert_face_command; - static int internal_self_insert (int, int); DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, @@ -346,6 +340,7 @@ After insertion, the value of `auto-fill-function' is called if the A value of 2 means this did things that call for an undo boundary. */ static Lisp_Object Qexpand_abbrev; +static Lisp_Object Qpost_self_insert_hook, Vpost_self_insert_hook; static int internal_self_insert (int c, int noautofill) @@ -451,10 +446,10 @@ internal_self_insert (int c, int noautofill) && synt != Sword && NILP (current_buffer->read_only) && PT > BEGV - && (!NILP (current_buffer->enable_multibyte_characters) - ? SYNTAX (XFASTINT (Fprevious_char ())) == Sword - : (SYNTAX (UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ()))) - == Sword))) + && (SYNTAX (!NILP (current_buffer->enable_multibyte_characters) + ? XFASTINT (Fprevious_char ()) + : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ()))) + == Sword)) { int modiff = MODIFF; Lisp_Object sym; @@ -514,15 +509,6 @@ internal_self_insert (int c, int noautofill) hairy = 2; } - /* If previous command specified a face to use, use it. */ - if (!NILP (Vself_insert_face) - && EQ (current_kboard->Vlast_command, Vself_insert_face_command)) - { - Fput_text_property (make_number (PT - 1), make_number (PT), - Qface, Vself_insert_face, Qnil); - Vself_insert_face = Qnil; - } - if ((synt == Sclose || synt == Smath) && !NILP (Vblink_paren_function) && INTERACTIVE && !noautofill) @@ -530,6 +516,9 @@ internal_self_insert (int c, int noautofill) call0 (Vblink_paren_function); hairy = 2; } + /* Run hooks for electric keys. */ + call1 (Vrun_hooks, Qpost_self_insert_hook); + return hairy; } @@ -550,15 +539,13 @@ syms_of_cmds (void) Qexpand_abbrev = intern_c_string ("expand-abbrev"); staticpro (&Qexpand_abbrev); - DEFVAR_LISP ("self-insert-face", &Vself_insert_face, - doc: /* If non-nil, set the face of the next self-inserting character to this. -See also `self-insert-face-command'. */); - Vself_insert_face = Qnil; + Qpost_self_insert_hook = intern_c_string ("post-self-insert-hook"); + staticpro (&Qpost_self_insert_hook); - DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command, - doc: /* This is the command that set up `self-insert-face'. -If `last-command' does not equal this value, we ignore `self-insert-face'. */); - Vself_insert_face_command = Qnil; + DEFVAR_LISP ("post-self-insert-hook", &Vpost_self_insert_hook, + doc: /* Hook run at the end of `self-insert-command'. +This run is run after inserting the charater. */); + Vpost_self_insert_hook = Qnil; DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function, doc: /* Function called, if non-nil, whenever a close parenthesis is inserted. -- 2.39.2