comparison lisp/mouse.el @ 95977:d76373886395

(mouse-appearance-menu-map): New var. (mouse-appearance-menu): New function. Bind it to S-down-mouse-1.

95976:75f86f6e4fc7

       last-nonmenu-event
     (list '(0 0) (selected-window)))
   (append x-fixed-font-alist
	   (list (generate-fontset-menu)))))

(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
in this list is used.

		(setq fonts nil))
	    (error
	     (setq fonts (cdr fonts)))))
	(if (null font)
	    (error "Font not found")))))

;;; Bindings for mouse commands.

(define-key global-map [down-mouse-1] 'mouse-drag-region)
(global-set-key [mouse-1]	'mouse-set-point)

;; By binding these to down-going events, we let the user use the up-going
;; 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))
;; C-down-mouse-2 is bound in facemenu.el.
(global-set-key [C-down-mouse-3]
  '(menu-item "Menu Bar" ignore
    :filter (lambda (_)
              (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))

95977:d76373886395

       last-nonmenu-event
     (list '(0 0) (selected-window)))
   (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
in this list is used.

		(setq fonts nil))
	    (error
	     (setq fonts (cdr fonts)))))
	(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)
(global-set-key [mouse-1]	'mouse-set-point)

;; By binding these to down-going events, we let the user use the up-going
;; 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-appearance-menu))
;; C-down-mouse-2 is bound in facemenu.el.
(global-set-key [C-down-mouse-3]
  '(menu-item "Menu Bar" ignore
    :filter (lambda (_)
              (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))