From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Jason Rumney Newsgroups: gmane.emacs.devel Subject: Re: Interactive font selector Date: 17 Jun 2002 20:57:54 +0100 Sender: emacs-devel-admin@gnu.org Message-ID: References: <200206152147.g5FLl7Z10917@aztec.santafe.edu> <200206162328.g5GNSZF12662@aztec.santafe.edu> NNTP-Posting-Host: localhost.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1024346212 23153 127.0.0.1 (17 Jun 2002 20:36:52 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 17 Jun 2002 20:36:52 +0000 (UTC) Cc: jas@extundo.com, emacs-devel@gnu.org Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by main.gmane.org with esmtp (Exim 3.33 #1 (Debian)) id 17K3F6-00061K-00 for ; Mon, 17 Jun 2002 22:36:52 +0200 Original-Received: from fencepost.gnu.org ([199.232.76.164]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 17K3fU-0002mQ-00 for ; Mon, 17 Jun 2002 23:04:08 +0200 Original-Received: from localhost ([127.0.0.1] helo=fencepost.gnu.org) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 17K3Eg-0004OB-00; Mon, 17 Jun 2002 16:36:26 -0400 Original-Received: from carbon.btinternet.com ([194.73.73.92] helo=carbon) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 17K3E3-0004LX-00; Mon, 17 Jun 2002 16:35:47 -0400 Original-Received: from host213-122-95-53.in-addr.btopenworld.com ([213.122.95.53] helo=nyaumo.btinternet.com) by carbon with esmtp (Exim 3.22 #8) id 17K3Dt-0002C2-00; Mon, 17 Jun 2002 21:35:37 +0100 Original-Received: from nyaumo.btinternet.com (nyaumo.btinternet.com [127.0.0.1]) by nyaumo.btinternet.com (Postfix) with ESMTP id 640054AFA6; Mon, 17 Jun 2002 20:57:55 +0100 (BST) Original-To: rms@gnu.org In-Reply-To: <200206162328.g5GNSZF12662@aztec.santafe.edu> Original-Lines: 237 User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.3.50 Errors-To: emacs-devel-admin@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.0.9 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.emacs.devel:4941 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:4941 Richard Stallman writes: > To really be usable and similar to other applications, emacs need to > reimplement some GTK widgets (or of course, start to use GTK). > > We don't need this large change to add the specific feature that > you've proposed. I have the following code that implements interactive font selection on X, using either gfontsel or xfontsel (or some other user specified command). It contains a replacement mouse-set-font, which adds an extra submenu (I could not find a way to easily add a top level menu item using easymenu), and an interactive function `set-font-for-face-at-point', which could be used in the Text Properties menu. ;;; Experimental font selection with a dialog. (defcustom x-select-font-commands '(("gfontsel" "--print" "-f" nil) ("xfontsel" "-print" nil "-pattern")) "*Programs and associated arguments for selecting fonts. `x-select-font' will use the first program from this list that can be found in the executable path. The format of each entry is (PROGRAM STANDARD-ARGUMENTS INITIAL-SWITCH FILTER-SWITCH) where PROGRAM is the name of the program, STANDARD-ARGUMENTS are any arguments required to make the program behave as `x-select-font' or the user expects, INITIAL-SWITCH is a switch to specify the font initially selected in the dialog, and FILTER-SWITCH is a switch that can be supplied to limit the fonts the user may choose from. If PROGRAM does not support setting the initial font or filtering the list of fonts, the corresponding switch should be set to nil. If PROGRAM accepts a filter or an initial font on the command-line without a preceding switch, then the corresponding switch should be set to t." :type '(alist :key-type (file :tag "Program") :value-type (group (string :tag "Fixed Args") (choice :tag "Initial Font Switch" (const :tag "Unsupported" nil) (other :tag "No switch" t) string) (choice :tag "Filter Switch" (const :tag "Unsupported" nil) (other :tag "No switch" t) string))) :group 'x) (defvar x-select-font-command-cached nil "The command last used by `x-select-font' to select a font. If nil, x-select-font will try to find a suitable program from `x-select-font-commands'.") (defun x-select-font (&optional initial filter) "Select a font using one of the programs in `x-select-font-commands'. The font initially selected in the font dialog can optionally be set with INITIAL if supported by `x-font-select-font-command'. The range of fonts to choose from can be limited by providing a FILTER, if supported. The filter should be a partially qualified XLFD font name." (with-temp-buffer (let* ((command (or x-select-font-command-cached (let ((cmds x-select-font-commands) this-cmd) (while (and cmds (not x-select-font-command-cached)) (setq this-cmd (car (car cmds))) (if (executable-find this-cmd) (setq x-select-font-command-cached this-cmd)) (setq cmds (cdr cmds))) x-select-font-command-cached))) (command-line (assoc command x-select-font-commands)) (fixed-args (if command-line (nth 1 command-line))) (initial-switch (if command-line (nth 2 command-line))) (filter-switch (if command-line (nth 3 command-line))) (args (append (list fixed-args) (if (and filter filter-switch) (if (stringp filter-switch) (list filter-switch filter) filter)) (if (and initial initial-switch) (if (stringp initial-switch) (list initial-switch initial) initial))))) (apply 'call-process command nil '(t nil) nil args) (buffer-string)))) (defcustom x-select-font-refine-menu-limit 20 "*Limit on the size of the font refine menu. When `x-select-font' is used to choose a font in a context that requires a single font to match, there is a possibility that the pattern returned from `x-select-font' matches multiple fonts. This variable sets an upper limit on the number of fonts that can be matched by the return value of `x-select-font' before an error is thrown." :type 'integer :group 'x) (defun x-select-font-refine-with-menu (fonts menu-pos) "Refine a list of fonts by popping up a menu." (let ((font-list fonts) font-refine-menu this-font) (while font-list (setq this-font (car font-list) font-list (cdr font-list)) (setq font-refine-menu (cons (list this-font this-font) font-refine-menu))) (setq font-refine-menu (cons "Refine Font" (list (append '("Font List") font-refine-menu)))) (x-popup-menu menu-pos font-refine-menu))) (defun x-select-single-font (&optional initial filter) "Select a single font, using `x-select-font-command'. If neccesary, pop up a menu to refine the choices further." (interactive) ;; Take note of the mouse position now while the frame is active. ;; Translate it to what x-popup-menu expects. (let* ((menu-pos (mouse-pixel-position)) (menu-pos-window (car menu-pos)) (menu-pos-x (car (cdr menu-pos))) (menu-pos-y (cdr (cdr menu-pos))) (menu-pos-expected-format (list (list (if menu-pos-x menu-pos-x 0) (if menu-pos-y menu-pos-y 0)) menu-pos-window)) (font-pattern (x-select-font initial filter)) (font-list (or (x-list-fonts font-pattern) (list font-pattern))) (nfonts (length font-list))) (cond ((eq font-list nil) (error "No fonts match.")) ((eq nfonts 1) (car font-list)) ((< nfonts x-select-font-refine-menu-limit) (car (x-select-font-refine-with-menu font-list menu-pos-expected-format))) (t (error "Too many fonts match."))))) (defun x-select-font-for-face (face frame) "Select the font to be used for FACE on FRAME. `x-select-font-command' will be used to make the selection." (let ((family (face-attribute face :family frame 'default)) (width (face-attribute face :width frame 'default)) (height (face-attribute face :height frame 'default)) (weight (face-attribute face :weight frame 'default)) (slant (face-attribute face :slant frame 'default)) (font (face-attribute face :font frame nil)) new-font new-attributes) (if (eq font 'unspecified) (setq font nil)) (setq new-font (x-select-font (if font font (x-compose-font-name (list nil family weight slant nil nil (if (integerp height) height nil) (if (integerp height) nil (floor (* 10 height))) nil nil nil width nil nil))))) ;; If face was specified by a :font attribute, replace it with the new one (if font (set-face-attribute face frame :font new-font) ;; Otherwise replace changed attributes individually. (setq new-attributes (x-decompose-font-name new-font)) (if (not (equal (nth 2 new-attributes) family)) (set-face-attribute face frame :family (nth 2 new-attributes))) (if (not (equal (nth 3 new-attributes) weight)) (set-face-attribute face frame :weight (nth 3 new-attributes))) (if (not (equal (nth 4 new-attributes) slant)) (set-face-attribute face frame :slant (nth 4 new-attributes))) ;; If height was in pixels before, keep it in pixels. (if (integerp height) (if (not (equal (nth 7 new-attributes) height)) (set-face-attribute face frame :height (nth 7 new-attributes))) (let ((float-height (/ (nth 8 new-attributes) 10.0))) (if (not (equal float-height height)) (set-face-attribute face frame :height float-height)))) (if (not (equal (nth 12 new-attributes) width)) (set-face-attribute face frame :width (nth 12 new-attributes)))))) ;; Replacement mouse-set-font ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; The following adds an extra submenu with a single option, which ;; launches the font dialog. It would be nicer to do this with ;; an item on the main menu instead of a submenu, but that involves ;; more code changes. (setq x-fixed-font-alist (append x-fixed-font-alist '(("More fonts" ("Choose..." . x-select-single-font))))) (defun mouse-set-font (&rest fonts) "Select an emacs font from a list of known good fonts and fontsets." (interactive (and (display-multi-font-p) (let ((selected-font (x-popup-menu last-nonmenu-event ;; Append list of fontsets currently defined. (append x-fixed-font-alist (list (generate-fontset-menu)))))) (if (functionp selected-font) (list (call-interactively selected-font)) selected-font)))) (message "%S" fonts) (if fonts (let (font) (while fonts (condition-case nil (progn (set-default-font (car fonts)) (setq font (car fonts)) (setq fonts nil)) (error (setq fonts (cdr fonts))))) (if (null font) (error "Font not found"))) (message "Cannot change fonts on this display"))) ;; Selecting a font for a face ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun set-font-for-face-at-point () "Set the font to use for the face currently under point." (interactive) (let ((face (get-text-property (point) 'face))) (x-select-font-for-face (if face face 'default) nil)))