Mercurial > emacs
changeset 95806:2e2ae1dd33cc
* emacs-lisp/map-ynp.el (map-y-or-n-p): Add support for other-window-scroll.
* files.el (save-some-buffers-action-alist): Only use recursive-edit
if the user enabled recursive-minibuffers.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Wed, 11 Jun 2008 01:47:48 +0000 |
| parents | dc8b6f0d85e8 |
| children | 43c1eff6b631 |
| files | lisp/ChangeLog lisp/emacs-lisp/map-ynp.el lisp/files.el |
| diffstat | 3 files changed, 89 insertions(+), 68 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Wed Jun 11 01:13:48 2008 +0000 +++ b/lisp/ChangeLog Wed Jun 11 01:47:48 2008 +0000 @@ -1,10 +1,17 @@ +2008-06-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (save-some-buffers-action-alist): Only use recursive-edit + if the user enabled recursive-minibuffers. + + * emacs-lisp/map-ynp.el (map-y-or-n-p): Add support for other-window-scroll. + 2008-06-11 Jason Rumney <jasonr@gnu.org> - * term/w32-win.el (w32-menu-bar-open): Rename from menu-bar-open. - Use tmm-menubar if menu is disabled in this frame. - - * menu-bar.el (menu-bar-open): Determine how to open menu bar - from frame type, per documentation. Add w32 case. + * term/w32-win.el (w32-menu-bar-open): Rename from menu-bar-open. + Use tmm-menubar if menu is disabled in this frame. + + * menu-bar.el (menu-bar-open): Determine how to open menu bar + from frame type, per documentation. Add w32 case. 2008-06-10 Stefan Monnier <monnier@iro.umontreal.ca>
--- a/lisp/emacs-lisp/map-ynp.el Wed Jun 11 01:13:48 2008 +0000 +++ b/lisp/emacs-lisp/map-ynp.el Wed Jun 11 01:47:48 2008 +0000 @@ -81,20 +81,14 @@ ;; Non-nil means we should use mouse menus to ask. use-menus delayed-switch-frame - (next (if (or (and list (symbolp list)) - (subrp list) - (byte-code-function-p list) - (and (consp list) - (eq (car list) 'lambda))) - (function (lambda () - (setq elt (funcall list)))) - (function (lambda () - (if list - (progn - (setq elt (car list) - list (cdr list)) - t) - nil)))))) + ;; Rebind other-window-scroll-buffer so that subfunctions can set + ;; it temporarily, without risking affecting the caller. + (other-window-scroll-buffer other-window-scroll-buffer) + (next (if (functionp list) + (lambda () (setq elt (funcall list))) + (lambda () (when list + (setq elt (pop list)) + t))))) (if (and (listp last-nonmenu-event) use-dialog-box) ;; Make a list describing a dialog box. @@ -125,11 +119,22 @@ "") ;; Make a map that defines each user key as a vector containing ;; its definition. - map (cons 'keymap - (append (mapcar (lambda (elt) - (cons (car elt) (vector (nth 1 elt)))) - action-alist) - query-replace-map)))) + map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map query-replace-map) + (define-key map [?\C-\M-v] 'scroll-other-window) + (define-key map [M-next] 'scroll-other-window) + (define-key map [?\C-\M-\S-v] 'scroll-other-window-down) + (define-key map [M-prior] 'scroll-other-window-down) + ;; The above are rather inconvenient, so maybe we should + ;; provide the non-other keys for the other-scroll as well. + ;; (define-key map [?\C-v] 'scroll-other-window) + ;; (define-key map [next] 'scroll-other-window) + ;; (define-key map [?\M-v] 'scroll-other-window-down) + ;; (define-key map [prior] 'scroll-other-window-down) + (dolist (elt action-alist) + (define-key map (vector (car elt)) (vector (nth 1 elt)))) + map))) (unwind-protect (progn (if (stringp prompter) @@ -165,7 +170,7 @@ (single-key-description char))) (setq def (lookup-key map (vector char)))) (cond ((eq def 'exit) - (setq next (function (lambda () nil)))) + (setq next (lambda () nil))) ((eq def 'act) ;; Act on the object. (funcall actor elt) @@ -177,7 +182,7 @@ ;; Act on the object and then exit. (funcall actor elt) (setq actions (1+ actions) - next (function (lambda () nil)))) + next (lambda () nil))) ((eq def 'quit) (setq quit-flag t) (setq next `(lambda () @@ -220,13 +225,18 @@ (format "or . (period) to %s \ the current %s and exit." action object)))) - (save-excursion - (set-buffer standard-output) + (with-current-buffer standard-output (help-mode))) (setq next `(lambda () (setq next ',next) ',elt))) + ((and (symbolp def) (commandp def)) + (call-interactively def) + ;; Regurgitated; try again. + (setq next `(lambda () + (setq next ',next) + ',elt))) ((vectorp def) ;; A user-defined key. (if (funcall (aref def 0) elt) ;Call its function.
--- a/lisp/files.el Wed Jun 11 01:13:48 2008 +0000 +++ b/lisp/files.el Wed Jun 11 01:47:48 2008 +0000 @@ -4163,22 +4163,28 @@ nil) (defvar save-some-buffers-action-alist - '((?\C-r - (lambda (buf) - (view-buffer buf - (lambda (ignore) - (exit-recursive-edit))) - (recursive-edit) - ;; Return nil to ask about BUF again. - nil) + `((?\C-r + ,(lambda (buf) + (if (not enable-recursive-minibuffers) + (progn (display-buffer buf) + (setq other-window-scroll-buffer buf)) + (view-buffer buf (lambda (_) (exit-recursive-edit))) + (recursive-edit)) + ;; Return nil to ask about BUF again. + nil) "view this buffer") - (?d (lambda (buf) - (save-window-excursion - (diff-buffer-with-file buf)) - (view-buffer (get-buffer-create "*Diff*") - (lambda (ignore) (exit-recursive-edit))) - (recursive-edit) - nil) + (?d ,(lambda (buf) + (if (null buffer-file-name) + (message "Not applicable: no file") + (save-window-excursion (diff-buffer-with-file buf)) + (if (not enable-recursive-minibuffers) + (progn (display-buffer (get-buffer-create "*Diff*")) + (setq other-window-scroll-buffer "*Diff*")) + (view-buffer (get-buffer-create "*Diff*") + (lambda (_) (exit-recursive-edit))) + (recursive-edit))) + ;; Return nil to ask about BUF again. + nil) "view changes in this buffer")) "ACTION-ALIST argument used in call to `map-y-or-n-p'.") @@ -4216,31 +4222,29 @@ ;; and record the number thus saved. (setq files-done (map-y-or-n-p - (function - (lambda (buffer) - (and (buffer-modified-p buffer) - (not (buffer-base-buffer buffer)) - (or - (buffer-file-name buffer) - (and pred - (progn - (set-buffer buffer) - (and buffer-offer-save (> (buffer-size) 0))))) - (or (not (functionp pred)) - (with-current-buffer buffer (funcall pred))) - (if arg - t - (setq queried t) - (if (buffer-file-name buffer) - (format "Save file %s? " - (buffer-file-name buffer)) - (format "Save buffer %s? " - (buffer-name buffer))))))) - (function - (lambda (buffer) - (set-buffer buffer) - (save-buffer))) - (buffer-list) + (lambda (buffer) + (and (buffer-modified-p buffer) + (not (buffer-base-buffer buffer)) + (or + (buffer-file-name buffer) + (and pred + (progn + (set-buffer buffer) + (and buffer-offer-save (> (buffer-size) 0))))) + (or (not (functionp pred)) + (with-current-buffer buffer (funcall pred))) + (if arg + t + (setq queried t) + (if (buffer-file-name buffer) + (format "Save file %s? " + (buffer-file-name buffer)) + (format "Save buffer %s? " + (buffer-name buffer)))))) + (lambda (buffer) + (with-current-buffer buffer + (save-buffer))) + (buffer-list) '("buffer" "buffers" "save") save-some-buffers-action-alist)) ;; Maybe to save abbrevs, and record whether