[Emacs-diffs] Changes to emacs/lisp/mouse.el,v

[Chong Yidong]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Chong Yidong <cyd>      08/06/15 20:04:34

Index: mouse.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mouse.el,v
retrieving revision 1.336
retrieving revision 1.337
diff -u -b -r1.336 -r1.337
--- mouse.el    12 Jun 2008 03:56:16 -0000      1.336
+++ mouse.el    15 Jun 2008 20:04:33 -0000      1.337
@@ -2439,6 +2439,8 @@
    (append x-fixed-font-alist
           (list (generate-fontset-menu)))))
 
+(declare-function text-scale-mode "face-remap")
+
 (defun mouse-set-font (&rest fonts)
   "Set the default font for the selected frame.
 The argument FONTS is a list of font names; the first valid font
@@ -2468,6 +2470,73 @@
        (if (null font)
            (error "Font not found")))))
 
+(defvar mouse-appearance-menu-map nil)
+
+(defun mouse-appearance-menu (event)
+  (interactive "@e")
+  (require 'face-remap)
+  (when (display-multi-font-p)
+    (with-selected-window (car (event-start event))
+      (if mouse-appearance-menu-map
+         nil ; regenerate new fonts
+       ;; Initialize mouse-appearance-menu-map
+       (setq mouse-appearance-menu-map
+             (make-sparse-keymap "Change Default Buffer Face"))
+       (define-key mouse-appearance-menu-map [face-remap-reset-base]
+         '(menu-item "Reset to Default" face-remap-reset-base))
+       (define-key mouse-appearance-menu-map [text-scale-decrease]
+         '(menu-item "Decrease Buffer Text Size" text-scale-decrease))
+       (define-key mouse-appearance-menu-map [text-scale-increase]
+         '(menu-item "Increase Buffer Text Size" text-scale-increase))
+       ;; Font selector
+       (if (functionp 'x-select-font)
+           (define-key mouse-appearance-menu-map [x-select-font]
+             '(menu-item "Change Buffer Font..." x-select-font))
+         ;; If the select-font is unavailable, construct a menu.
+         (let ((font-submenu (make-sparse-keymap "Change Text Font"))
+               (font-alist (cdr (append x-fixed-font-alist
+                                        (list (generate-fontset-menu))))))
+           (dolist (family font-alist)
+             (let* ((submenu-name (car family))
+                    (submenu-map (make-sparse-keymap submenu-name)))
+               (dolist (font (cdr family))
+                 (let ((font-name (car font))
+                       font-symbol)
+                   (if (string= font-name "")
+                       (define-key submenu-map [space]
+                         '("--"))
+                     (setq font-symbol (intern (cadr font)))
+                     (define-key submenu-map (vector font-symbol)
+                       (list 'menu-item (car font) font-symbol)))))
+               (define-key font-submenu (vector (intern submenu-name))
+                 (list 'menu-item submenu-name submenu-map))))
+           (define-key mouse-appearance-menu-map [font-submenu]
+             (list 'menu-item "Change Text Font" font-submenu)))))
+      (let ((choice (x-popup-menu event mouse-appearance-menu-map)))
+       (setq choice (nth (1- (length choice)) choice))
+       (cond ((eq choice 'text-scale-increase)
+              (text-scale-increase 1))
+             ((eq choice 'text-scale-decrease)
+              (text-scale-increase -1))
+             ((eq choice 'face-remap-reset-base)
+              (text-scale-mode 0)
+              (let ((entry (assq 'default face-remapping-alist)))
+                (when entry
+                  (setq face-remapping-alist
+                        (remq entry face-remapping-alist))
+                  (force-window-update (current-buffer)))))
+             (t
+              ;; Either choice == 'x-select-font, or choice is a
+              ;; symbol whose name is a font.
+              (make-local-variable 'face-remapping-alist)
+              (apply 'face-remap-add-relative
+                     'default
+                     (font-face-attributes 
+                      (if (eq choice 'x-select-font)
+                          (x-select-font)
+                        (symbol-name choice))))))))))
+
+
 ;;; Bindings for mouse commands.
 
 (define-key global-map [down-mouse-1] 'mouse-drag-region)
@@ -2494,7 +2563,7 @@
 ;; event to make the selection, saving a click.
 (global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
 (if (not (eq system-type 'ms-dos))
-    (global-set-key [S-down-mouse-1] 'mouse-set-font))
+    (global-set-key [S-down-mouse-1] 'mouse-appearance-menu))
 ;; C-down-mouse-2 is bound in facemenu.el.
 (global-set-key [C-down-mouse-3]
   '(menu-item "Menu Bar" ignore