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: [friedman@splode.com: some other observations on pcomplete] Date: 15 Mar 2002 19:42:18 +0000 Sender: emacs-devel-admin@gnu.org Message-ID: References: <200203151624.g2FGOQd06795@wijiji.santafe.edu> NNTP-Posting-Host: localhost.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1016221771 23506 127.0.0.1 (15 Mar 2002 19:49:31 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Fri, 15 Mar 2002 19:49:31 +0000 (UTC) Cc: eliz@is.elta.co.il, emacs-devel@gnu.org Original-Received: from hermes.netfonds.no ([195.204.10.138]) by main.gmane.org with esmtp (Exim 3.33 #1 (Debian)) id 16lxhi-000672-00 for ; Fri, 15 Mar 2002 20:49:30 +0100 Original-Received: from quimby.gnus.org (quimby.gnus.org [80.91.224.244]) by hermes.netfonds.no (8.10.1/8.9.3) with ESMTP id g2FJmoM26423 for ; Fri, 15 Mar 2002 20:48:50 +0100 (CET) Original-Received: from fencepost.gnu.org ([199.232.76.164]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 16lxkj-0005F5-00 for ; Fri, 15 Mar 2002 20:52:38 +0100 Original-Received: from localhost ([127.0.0.1] helo=fencepost.gnu.org) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 16lxgT-0005YL-00; Fri, 15 Mar 2002 14:48:13 -0500 Original-Received: from tungsten.btinternet.com ([194.73.73.81]) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 16lxeB-0005Sb-00; Fri, 15 Mar 2002 14:45:51 -0500 Original-Received: from host62-7-18-202.in-addr.btopenworld.com ([62.7.18.202] helo=nyaumo.btinternet.com) by tungsten.btinternet.com with esmtp (Exim 3.22 #8) id 16lxe9-0000aa-00; Fri, 15 Mar 2002 19:45:49 +0000 Original-Received: from nyaumo.btinternet.com (localhost [127.0.0.1]) by nyaumo.btinternet.com (8.9.3/8.9.3/SuSE Linux 8.9.3-0.1) with ESMTP id TAA00517; Fri, 15 Mar 2002 19:42:18 GMT Original-To: rms@gnu.org In-Reply-To: <200203151624.g2FGOQd06795@wijiji.santafe.edu> Original-Lines: 182 User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2.50 Errors-To: emacs-devel-admin@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.0.5 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.emacs.devel:1947 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:1947 Richard Stallman writes: > * Provide user-friendly ways to list all available font families, > display a font as a sample, etc. I have still not got my head around the face customization code to try to slot this in there. But I have got this working for mouse-set-font. The code follows for people to try out, suggestions are welcome. -- Jason Rumney ;;; Experimental font selection with a dialog. (defcustom x-select-font-command-line-alist '(("gfontsel" "--print" "-f" nil) ("xfontsel" "-print" nil "-pattern")) "*Programs and associated arguments suitable for `x-select-font-command'. 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) (defcustom x-select-font-command (if (executable-find "gfontsel") "gfontsel" "xfontsel") "*The command used by `x-select-font' to select a font. The command should be one of those listed in `x-select-font-command-line-alist'." :type `(choice ,@(mapcar (lambda (entry) (list 'const :format "%v\n" (car entry))) x-select-font-command-line-alist) (string :tag "other")) :group 'x) (defun x-select-font (&optional initial filter) "Select a font using `x-select-font-command'. 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-line (assoc x-select-font-command x-select-font-command-line-alist)) (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 x-select-font-command nil t 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-list (x-list-fonts (x-select-font initial filter))) (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."))))) ;; 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)))) (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"))) ;; Customize Faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Customize options that are relevant. ;; :family :width :height :weight :slant ;; ;; Ideas so far. ;; Can use x-compose-font-name, x-decompose-font-name ;; How to get current values of widgets? ;; How to change widget values? _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://mail.gnu.org/mailman/listinfo/emacs-devel