[Emacs-diffs] /srv/bzr/emacs/trunk r101138: New post-self-insert-hook.

[Stefan Monnier]

------------------------------------------------------------
revno: 101138
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2010-08-19 17:43:45 +0200
message:
  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.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/facemenu.el
  src/ChangeLog
  src/cmds.c

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2010-08-18 11:11:01 +0000
+++ b/etc/NEWS  2010-08-19 15:43:45 +0000
@@ -453,6 +453,8 @@
 
 * 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.

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-08-19 09:37:40 +0000
+++ b/lisp/ChangeLog    2010-08-19 15:43:45 +0000
@@ -1,5 +1,10 @@
 2010-08-19  Stefan Monnier  <address@hidden>
 
+       * 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  <address@hidden>

=== modified file 'lisp/facemenu.el'
--- a/lisp/facemenu.el  2010-06-16 21:33:54 +0000
+++ b/lisp/facemenu.el  2010-08-19 15:43:45 +0000
@@ -699,6 +699,22 @@
   (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 @@
 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")))
 

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2010-08-19 14:51:09 +0000
+++ b/src/ChangeLog     2010-08-19 15:43:45 +0000
@@ -1,3 +1,11 @@
+2010-08-19  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * w32fns.c (w32_wnd_proc): Don't check context before initializing.

=== modified file 'src/cmds.c'
--- a/src/cmds.c        2010-08-08 16:43:26 +0000
+++ b/src/cmds.c        2010-08-19 15:43:45 +0000
@@ -37,12 +37,6 @@
 /* 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 @@
    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 @@
       && 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 @@
        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 @@
       call0 (Vblink_paren_function);
       hairy = 2;
     }
+  /* Run hooks for electric keys.  */
+  call1 (Vrun_hooks, Qpost_self_insert_hook);
+
   return hairy;
 }
 
@@ -550,15 +539,13 @@
   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.