mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-11 16:08:13 +00:00
Code Issues Releases Activity

New post-self-insert-hook.

Browse Source 
* 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.
This commit is contained in:
Stefan Monnier 2010-08-19 17:43:45 +02:00
parent 20d60baf35
commit a2e5caf79e
5 changed files with 90 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/NEWS
View File

@ -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.

5
lisp/ChangeLog
View File

@ -1,5 +1,10 @@
2010-08-19 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <monnier@iro.umontreal.ca>

105
lisp/facemenu.el
View File

@ -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")))

8
src/ChangeLog
View File

@ -1,3 +1,11 @@
2010-08-19 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <jasonr@gnu.org>
* w32fns.c (w32_wnd_proc): Don't check context before initializing.

41
src/cmds.c
View File

@ -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.