1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-22 07:09:54 +00:00

Use set-temporary-overlay-map.

* lisp/repeat.el: Use lexical-binding.
(repeat-last-self-insert, repeat-num-input-keys-at-self-insert)
(repeat-undo-count): Remove.
(repeat):
* lisp/progmodes/octave-mod.el (octave-abbrev-start):
* lisp/progmodes/f90.el (f90-abbrev-start):
* lisp/face-remap.el (text-scale-adjust):
* lisp/kmacro.el (kmacro-call-macro): Use set-temporary-overlay-map.
This commit is contained in:
Stefan Monnier 2012-05-04 22:50:20 -04:00
parent 5342bb062f
commit df96ab1e0a
6 changed files with 98 additions and 164 deletions

View File

@ -1,5 +1,14 @@
2012-05-05 Stefan Monnier <monnier@iro.umontreal.ca>
* repeat.el: Use lexical-binding.
(repeat-last-self-insert, repeat-num-input-keys-at-self-insert)
(repeat-undo-count): Remove.
(repeat):
* progmodes/octave-mod.el (octave-abbrev-start):
* progmodes/f90.el (f90-abbrev-start):
* face-remap.el (text-scale-adjust):
* kmacro.el (kmacro-call-macro): Use set-temporary-overlay-map.
* emacs-lisp/pcase.el (pcase--let*): New function.
(pcase--expand, pcase-codegen, pcase--q1): Use it to reduce nesting
a bit more.

View File

@ -303,26 +303,29 @@ a top-level keymap, `text-scale-increase' or
`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 "+,-,0 for further adjustment: "))))
(push ev unread-command-events)))
(let* ((base (event-basic-type ev))
(step
(pcase base
((or `?+ `?=) inc)
(`?- (- inc))
(`?0 0)
(t inc))))
(text-scale-increase step)
;; FIXME: do it after everu "iteration of the loop".
(message "+,-,0 for further adjustment: ")
(set-temporary-overlay-map
(let ((map (make-sparse-keymap)))
(dolist (mods '(() (control)))
(define-key map (vector (append mods '(?-))) 'text-scale-decrease)
(define-key map (vector (append mods '(?+))) 'text-scale-increase)
;; = is unshifted + on most keyboards.
(define-key map (vector (append mods '(?=))) 'text-scale-increase)
(define-key map (vector (append mods '(?0)))
(lambda () (interactive) (text-scale-increase 0))))
map)
t))))
;; ----------------------------------------------------------------

View File

@ -625,8 +625,10 @@ for details on how to adjust or disable this behavior.
To make a macro permanent so you can call it even after defining
others, use \\[kmacro-name-last-macro]."
(interactive "p")
(let ((repeat-key (and (null no-repeat)
(> (length (this-single-command-keys)) 1)
(let ((repeat-key (and (or (and (null no-repeat)
(> (length (this-single-command-keys)) 1))
;; Used when we're in the process of repeating.
(eq no-repeat 'repeating))
last-input-event))
repeat-key-str)
(if end-macro
@ -640,24 +642,16 @@ others, use \\[kmacro-name-last-macro]."
repeat-key
kmacro-call-repeat-key)))
(setq repeat-key-str (format-kbd-macro (vector repeat-key) nil))
(while repeat-key
;; Issue a hint to the user, if the echo area isn't in use.
(unless (current-message)
(message "(Type %s to repeat macro%s)"
repeat-key-str
(if (and kmacro-call-repeat-with-arg
arg (> arg 1))
(format " %d times" arg) "")))
(if (equal repeat-key (read-event))
(progn
(clear-this-command-keys t)
(call-last-kbd-macro (and kmacro-call-repeat-with-arg arg)
#'kmacro-loop-setup-function)
(setq last-input-event nil))
(setq repeat-key nil)))
(when last-input-event
(clear-this-command-keys t)
(setq unread-command-events (list last-input-event))))))
;; Can't use the `keep-pred' arg because this overlay keymap needs to be
;; removed during the next run of the kmacro (i.e. we need to add&remove
;; this overlay-map at each repetition).
(set-temporary-overlay-map
(let ((map (make-sparse-keymap)))
(define-key map (vector repeat-key)
`(lambda () (interactive)
(kmacro-call-macro ,(and kmacro-call-repeat-with-arg arg)
'repeating)))
map)))))
;;; Combined function key bindings:

View File

@ -2204,18 +2204,13 @@ Leave point at the end of line."
"Typing `\\[help-command] or `? lists all the F90 abbrevs.
Any other key combination is executed normally."
(interactive "*")
(insert last-command-event)
(let (char event)
(if (fboundp 'next-command-event) ; XEmacs
(setq event (next-command-event)
char (and (fboundp 'event-to-character)
(event-to-character event)))
(setq event (read-event)
char event))
;; Insert char if not equal to `?', or if abbrev-mode is off.
(if (and abbrev-mode (memq char (list ?? help-char)))
(f90-abbrev-help)
(setq unread-command-events (list event)))))
(self-insert-command 1)
(when abbrev-mode
(set-temporary-overlay-map
(let ((map (make-sparse-keymap)))
(define-key map [??] 'f90-abbrev-help)
(define-key map (vector help-char) 'f90-abbrev-help)
map))))
(defun f90-abbrev-help ()
"List the currently defined abbrevs in F90 mode."

View File

@ -989,18 +989,13 @@ If Abbrev mode is turned on, typing ` (grave accent) followed by ? or
executed normally.
Note that all Octave mode abbrevs start with a grave accent."
(interactive)
(if (not abbrev-mode)
(self-insert-command 1)
(let (c)
(insert last-command-event)
(if (if (featurep 'xemacs)
(or (eq (event-to-character (setq c (next-event))) ??)
(eq (event-to-character c) help-char))
(or (eq (setq c (read-event)) ??)
(eq c help-char)))
(let ((abbrev-table-name-list '(octave-abbrev-table)))
(list-abbrevs))
(setq unread-command-events (list c))))))
(self-insert-command 1)
(when abbrev-mode
(set-temporary-overlay-map
(let ((map (make-sparse-keymap)))
(define-key map [??] 'list-abbrevs)
(define-key map (vector help-char) 'list-abbrevs)
map))))
(define-skeleton octave-insert-defun
"Insert an Octave function skeleton.

View File

@ -1,4 +1,4 @@
;;; repeat.el --- convenient way to repeat the previous command
;;; repeat.el --- convenient way to repeat the previous command -*- lexical-binding: t -*-
;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
@ -156,15 +156,6 @@ member of that sequence. If this variable is nil, no re-execution occurs."
;; `repeat' now repeats that command instead of `real-last-command' to
;; avoid a "... must be bound to an event with parameters" error.
(defvar repeat-last-self-insert nil
"If last repeated command was `self-insert-command', it inserted this.")
;; That'll require another keystroke count so we know we're in a string of
;; repetitions of self-insert commands:
(defvar repeat-num-input-keys-at-self-insert -1
"# key sequences read in Emacs session when `self-insert-command' repeated.")
;;;;; *************** ANALOGOUS HACKS TO `repeat' ITSELF **************** ;;;;;
;; That mechanism of checking num-input-keys to figure out what's really
@ -199,14 +190,6 @@ this function is always whether the value of `this-command' would've been
(defvar repeat-previous-repeated-command nil
"The previous repeated command.")
;; The following variable counts repeated self-insertions. The idea is
;; that repeating a self-insertion command and subsequently undoing it
;; should have almost the same effect as if the characters were inserted
;; manually. The basic difference is that we leave in one undo-boundary
;; between the original insertion and its first repetition.
(defvar repeat-undo-count nil
"Number of self-insertions since last `undo-boundary'.")
;;;###autoload
(defun repeat (repeat-arg)
"Repeat most recently executed command.
@ -254,7 +237,7 @@ recently executed command not bound to an input event\"."
(let ((repeat-repeat-char
(if (eq repeat-on-final-keystroke t)
last-command-event
;; allow only specified final keystrokes
;; Allow only specified final keystrokes.
(car (memq last-command-event
(listify-key-sequence
repeat-on-final-keystroke))))))
@ -269,90 +252,45 @@ recently executed command not bound to an input event\"."
(setq current-prefix-arg repeat-arg)
(repeat-message
"Repeating command %S %S" repeat-arg last-repeatable-command))
(if (eq last-repeatable-command 'self-insert-command)
(let ((insertion
(if (<= (- num-input-keys
repeat-num-input-keys-at-self-insert)
1)
repeat-last-self-insert
(let ((range (nth 1 buffer-undo-list)))
(condition-case nil
(setq repeat-last-self-insert
(buffer-substring (car range)
(cdr range)))
(error (error "%s %s %s" ;Danger, Will Robinson!
"repeat can't intuit what you"
"inserted before auto-fill"
"clobbered it, sorry")))))))
(setq repeat-num-input-keys-at-self-insert num-input-keys)
;; If the self-insert had a repeat count, INSERTION
;; includes that many copies of the same character.
;; So use just the first character
;; and repeat it the right number of times.
(setq insertion (substring insertion -1))
(let ((count (prefix-numeric-value repeat-arg))
(i 0))
;; Run pre- and post-command hooks for self-insertion too.
(run-hooks 'pre-command-hook)
(cond
((not repeat-undo-count))
((< repeat-undo-count 20)
;; Don't make an undo-boundary here.
(setq repeat-undo-count (1+ repeat-undo-count)))
(t
;; Make an undo-boundary after 20 repetitions only.
(undo-boundary)
(setq repeat-undo-count 1)))
(while (< i count)
(repeat-self-insert insertion)
(setq i (1+ i)))
(run-hooks 'post-command-hook)))
(let ((indirect (indirect-function last-repeatable-command)))
;; Make each repetition undo separately.
(undo-boundary)
(if (or (stringp indirect)
(vectorp indirect))
;; Bind real-last-command so that executing the macro does
;; not alter it. Do the same for last-repeatable-command.
(let ((real-last-command real-last-command)
(last-repeatable-command last-repeatable-command))
(execute-kbd-macro last-repeatable-command))
(run-hooks 'pre-command-hook)
(call-interactively last-repeatable-command)
(run-hooks 'post-command-hook)))))
(when (eq last-repeatable-command 'self-insert-command)
;; We used to use a much more complex code to try and figure out
;; what key was used to run that self-insert-command:
;; (if (<= (- num-input-keys
;; repeat-num-input-keys-at-self-insert)
;; 1)
;; repeat-last-self-insert
;; (let ((range (nth 1 buffer-undo-list)))
;; (condition-case nil
;; (setq repeat-last-self-insert
;; (buffer-substring (car range)
;; (cdr range)))
;; (error (error "%s %s %s" ;Danger, Will Robinson!
;; "repeat can't intuit what you"
;; "inserted before auto-fill"
;; "clobbered it, sorry")))))
(setq last-command-event (char-before)))
(let ((indirect (indirect-function last-repeatable-command)))
(if (or (stringp indirect)
(vectorp indirect))
;; Bind last-repeatable-command so that executing the macro does
;; not alter it.
(let ((last-repeatable-command last-repeatable-command))
(execute-kbd-macro last-repeatable-command))
(call-interactively last-repeatable-command))))
(when repeat-repeat-char
;; A simple recursion here gets into trouble with max-lisp-eval-depth
;; on long sequences of repetitions of a command like `forward-word'
;; (only 32 repetitions are possible given the default value of 200 for
;; max-lisp-eval-depth), but if I now locally disable the repeat char I
;; can iterate indefinitely here around a single level of recursion.
(let (repeat-on-final-keystroke
;; Bind `undo-inhibit-record-point' to t in order to avoid
;; recording point in `buffer-undo-list' here. We have to
;; do this since the command loop does not set the last
;; position of point thus confusing the point recording
;; mechanism when inserting or deleting text.
(undo-inhibit-record-point t))
(setq real-last-command 'repeat)
(setq repeat-undo-count 1)
(unwind-protect
(while (let ((evt (read-key)))
;; For clicks, we need to strip the meta-data to
;; check the underlying event name.
(eq (or (car-safe evt) evt)
(or (car-safe repeat-repeat-char)
repeat-repeat-char)))
(repeat repeat-arg))
;; Make sure `repeat-undo-count' is reset.
(setq repeat-undo-count nil))
(setq unread-command-events (list last-input-event))))))
(defun repeat-self-insert (string)
(let ((i 0))
(while (< i (length string))
(let ((last-command-event (aref string i)))
(self-insert-command 1))
(setq i (1+ i)))))
(set-temporary-overlay-map
(let ((map (make-sparse-keymap)))
(define-key map (vector repeat-repeat-char)
(if (null repeat-message-function) 'repeat
;; If repeat-message-function is let-bound, preserve it for the
;; next "iterations of the loop".
(let ((fun repeat-message-function))
(lambda ()
(interactive)
(let ((repeat-message-function fun))
(setq this-command 'repeat)
(call-interactively 'repeat))))))
map)))))
(defun repeat-message (format &rest args)
"Like `message' but displays with `repeat-message-function' if non-nil."