X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/0b2b62ff6dcaf77d2897a284013af3ff4b8ae268..3021111652cc4f91f8f26b4c34a7aba1ef1070c5:/lisp/mouse.el diff --git a/lisp/mouse.el b/lisp/mouse.el index dba63ce308..e8adeb8810 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1,17 +1,17 @@ ;;; mouse.el --- window system-independent mouse support -;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: hardware, mouse ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -157,7 +155,7 @@ Interactively, INDICATOR is read using completion. If there is no menu defined for the minor mode, then create one with items `Turn Off' and `Help'." (interactive - (list (completing-read + (list (completing-read "Minor mode indicator: " (describe-minor-mode-completion-table-for-indicator)))) (let ((minor-mode (lookup-minor-mode-from-indicator indicator))) @@ -171,7 +169,7 @@ items `Turn Off' and `Help'." ,indicator (turn-off menu-item "Turn Off minor mode" ,minor-mode) (help menu-item "Help for minor mode" - (lambda () (interactive) + (lambda () (interactive) (describe-function ',minor-mode)))))) (popup-menu menu)))) @@ -266,7 +264,7 @@ Default to the Edit menu if the major mode doesn't define a menu." (interactive "@e\nP") (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) (popup-menu (mouse-menu-major-mode-map) event prefix)) -(make-obsolete 'mouse-major-mode-menu 'mouse-menu-major-mode-map) +(make-obsolete 'mouse-major-mode-menu 'mouse-menu-major-mode-map "23.1") (defun mouse-popup-menubar (event prefix) "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX. @@ -275,7 +273,7 @@ not it is actually displayed." (interactive "@e \nP") (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) (popup-menu (mouse-menu-bar-map) event prefix)) -(make-obsolete 'mouse-popup-menubar 'mouse-menu-bar-map) +(make-obsolete 'mouse-popup-menubar 'mouse-menu-bar-map "23.1") (defun mouse-popup-menubar-stuff (event prefix) "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'. @@ -287,7 +285,7 @@ Use the former if the menu bar is showing, otherwise the latter." (mouse-menu-bar-map) (mouse-menu-major-mode-map)) event prefix)) -(make-obsolete 'mouse-popup-menubar-stuff nil) +(make-obsolete 'mouse-popup-menubar-stuff nil "23.1") ;; Commands that operate on windows. @@ -675,7 +673,7 @@ This should be bound to a mouse drag event." ;; If mark is highlighted, no need to bounce the cursor. ;; On X, we highlight while dragging, thus once again no need to bounce. (or transient-mark-mode - (memq (framep (selected-frame)) '(x pc w32 mac)) + (memq (framep (selected-frame)) '(x pc w32 ns)) (sit-for 1)) (push-mark) (set-mark (point)) @@ -1112,8 +1110,7 @@ If DIR is positive skip forward; if negative, skip backward." ;; Here, we can't use skip-syntax-forward/backward because ;; they don't pay attention to word-separating-categories, ;; and thus they will skip over a true word boundary. So, - ;; we simularte the original behaviour by using - ;; forward-word. + ;; we simulate the original behavior by using forward-word. (if (< dir 0) (if (not (looking-at "\\<")) (forward-word -1)) @@ -2427,8 +2424,29 @@ and selects that window." ) "X fonts suitable for use in Emacs.") +(declare-function generate-fontset-menu "fontset" ()) + +(defun mouse-select-font () + "Prompt for a font name, using `x-popup-menu', and return it." + (interactive) + (unless (display-multi-font-p) + (error "Cannot change fonts on this display")) + (x-popup-menu + (if (listp last-nonmenu-event) + 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) - "Select an Emacs font from a list of known good fonts and fontsets." + "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. + +When called interactively, pop up a menu and allow the user to +choose a font." (interactive (progn (unless (display-multi-font-p) (error "Cannot change fonts on this display")) @@ -2450,6 +2468,71 @@ and selects that window." (setq fonts (cdr fonts))))) (if (null font) (error "Font not found"))))) + +(defvar mouse-appearance-menu-map nil) +(declare-function x-select-font "xfns.c" (&optional frame ignored)) ; USE_GTK +(declare-function buffer-face-mode-invoke "face-remap" + (face arg &optional interactive)) +(declare-function font-face-attributes "font.c" (font &optional frame)) + +(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) + (buffer-face-mode 0)) + (choice + ;; Either choice == 'x-select-font, or choice is a + ;; symbol whose name is a font. + (buffer-face-mode-invoke (font-face-attributes + (if (eq choice 'x-select-font) + (x-select-font) + (symbol-name choice))) + t (interactive-p)))))))) + ;;; Bindings for mouse commands. @@ -2477,7 +2560,7 @@ and selects that window." ;; 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