Re: bug#7234: 24.0.50; strange message after text-scale-adjust

[Stefan Monnier <monnier@iro.umontreal.ca>]

> It would be better that read-event call in
> text-scale-adjust has some prompt:
> e.g. (read-event "+,-,0 for further adjustment: ")

Agreed.

> For non-interactive use, you should probably also be using
> `text-scale-set' or `text-scale-increase' instead.

BTW, I've been playing around with an alternative implementation for
such things.  The reason is that the use of
read-event/read-char/read-key has surprising side-effects: in those
cases I'm concerned with, the user expects that the command is already
finished and the behavior is somewhat consistent with that expectation,
but not completely: indeed typing "any" key sequence (except for a few
special ones) runs the usual corresponding command, but OTOH
post-command-hook and friends aren't run when expected.

So, instead I use a new function set-temporary-overlay-map which sets up
a keymap that's only active for a short period of time (by default just
for the next key-sequence):

Using submit branch file:///home/monnier/src/emacs/bzr/trunk/
=== modified file 'lisp/face-remap.el'
*** lisp/face-remap.el	2010-03-14 21:15:02 +0000
--- lisp/face-remap.el	2010-08-21 07:43:23 +0000
***************
*** 294,319 ****
  `text-scale-decrease' may be more appropriate."
    (interactive "p")
    (let ((first t)
- 	(step t)
  	(ev last-command-event)
  	(echo-keystrokes nil))
!     (while step
!       (let ((base (event-basic-type ev)))
! 	(cond ((or (eq base ?+) (eq base ?=))
! 	       (setq step inc))
! 	      ((eq base ?-)
! 	       (setq step (- inc)))
! 	      ((eq base ?0)
! 	       (setq step 0))
! 	      (first
! 	       (setq step inc))
! 	      (t
! 	       (setq step nil))))
!       (when step
  	(text-scale-increase step)
! 	(setq inc 1 first nil)
! 	(setq ev (read-event))))
!     (push ev unread-command-events)))
  
  \f
  ;; ----------------------------------------------------------------
--- 294,317 ----
  `text-scale-decrease' may be more appropriate."
    (interactive "p")
    (let ((first t)
  	(ev last-command-event)
  	(echo-keystrokes nil))
!     (let* ((base (event-basic-type ev))
!            (step
!             (case base
!               ((?+ ?=) inc)
!               (?- (- inc))
!               (?0 0)
!               (t inc))))
  	(text-scale-increase step)
!       (set-temporary-overlay-map
!        (let ((map (make-sparse-keymap)))
!          (define-key map [?=] 'text-scale-increase)
!          (define-key map [?0] (lambda () (interactive) (text-scale-increase 0)))
!          (define-key map [?+] 'text-scale-increase)
!          (define-key map [?-] 'text-scale-decrease)
!          map)
!        t))))
  
  \f
  ;; ----------------------------------------------------------------

Currently, my implementation of set-temporary-overlay-map (see appended)
is not 100% satisfactory, so it may require some changes to the C code,
but it already works well in practice.


        Stefan


(defun set-temporary-overlay-map (map &optional keep-pred)
  (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
         (overlaysym (make-symbol "t"))
         (alist (list (cons overlaysym map)))
         (clearfun
          `(lambda ()
             (unless ,(cond ((null keep-pred) nil)
                            ((eq t keep-pred)
                             `(eq this-command
                                  (lookup-key ',map
                                              (this-command-keys-vector))))
                            (t `(funcall ',keep-pred)))
               (remove-hook 'pre-command-hook ',clearfunsym)
               (cancel-timer ,overlaysym)
               (setq ,overlaysym nil)
               (save-current-buffer
                 (if (buffer-live-p ',(current-buffer))
                     (set-buffer ',(current-buffer)))
                 (setq emulation-mode-map-alists
                       (delq ',alist emulation-mode-map-alists)))))))
    (fset clearfunsym clearfun)
    (add-hook 'pre-command-hook clearfunsym)
    ;; Sadly, pre-command-hook is occasionally set to nil (if one of its
    ;; functions signals an error).  We should improve safe_run_hooks so as to
    ;; only remove the offending function rather than set the whole thing to
    ;; nil, but in the mean time, let's use an auxiliary timer to monitor
    ;; pre-command-hook to make sure we don't end up with a lingering
    ;; overlay-map which could otherwise render Emacs unusable.
    (set overlaysym
         (run-with-idle-timer
          0 t
          `(lambda ()
             (if (memq ',clearfunsym
                       (default-value 'pre-command-hook))
                 nil
               (message "clear-temporary-overlay-map lost in pre-command-hook!")
               (,clearfunsym)))))
    ;; FIXME: That's the keymaps with highest precedence, except for
    ;; the `keymap' text-property ;-(
    (push alist emulation-mode-map-alists)))