annotate lisp/gtk-faces.el @ 4677:8f1ee2d15784

Support full Common Lisp multiple values in C. lisp/ChangeLog 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el : Update this file to support full C-level multiple values. This involves: -- Four new bytecodes, and special compiler functions to compile multiple-value-call, multiple-value-list-internal, values, values-list, and, since it now needs to pass back multiple values and is a special form, throw. -- There's a new compiler variable, byte-compile-checks-on-load, which is a list of forms that are evaluated at the very start of a file, with an error thrown if any of them give nil. -- The header is now inserted *after* compilation, giving a chance for the compilation process to influence what those checks are. There is still a check done before compilation for non-ASCII characters, to try to turn off dynamic docstrings if appopriate, in `byte-compile-maybe-reset-coding'. Space is reserved for checks; comments describing the version of the byte compiler generating the file are inserted if space remains for them. * bytecomp.el (byte-compile-version): Update this, we're a newer version of the byte compiler. * byte-optimize.el (byte-optimize-funcall): Correct a comment. * bytecomp.el (byte-compile-lapcode): Discard the arg with byte-multiple-value-call. * bytecomp.el (byte-compile-checks-and-comments-space): New variable, describe how many octets to reserve for checks at the start of byte-compiled files. * cl-compat.el: Remove the fake multiple-value implementation. Have the functions that use it use the real multiple-value implementation instead. * cl-macs.el (cl-block-wrapper, cl-block-throw): Revise the byte-compile properties of these symbols to work now we've made throw into a special form; keep the byte-compile properties as anonymous lambdas, since we don't have docstrings for them. * cl-macs.el (multiple-value-bind, multiple-value-setq) (multiple-value-list, nth-value): Update these functions to work with the C support for multiple values. * cl-macs.el (values): Modify the setf handler for this to call #'multiple-value-list-internal appropriately. * cl-macs.el (cl-setf-do-store): If the store form is a cons, treat it specially as wrapping the store value. * cl.el (cl-block-wrapper): Make this an alias of #'and, not #'identity, since it needs to pass back multiple values. * cl.el (multiple-value-apply): We no longer support this, mark it obsolete. * lisp-mode.el (eval-interactive-verbose): Remove a useless space in the docstring. * lisp-mode.el (eval-interactive): Update this function and its docstring. It now passes back a list, basically wrapping any eval calls with multiple-value-list. This allows multiple values to be printed by default in *scratch*. * lisp-mode.el (prin1-list-as-multiple-values): New function, printing a list as multiple values in the manner of Bruno Haible's clisp, separating each entry with " ;\n". * lisp-mode.el (eval-last-sexp): Call #'prin1-list-as-multiple-values on the return value of #'eval-interactive. * lisp-mode.el (eval-defun): Call #'prin1-list-as-multiple-values on the return value of #'eval-interactive. * mouse.el (mouse-eval-sexp): Deal with lists corresponding to multiple values from #'eval-interactive. Call #'cl-prettyprint, which is always available, instead of sometimes calling #'pprint and sometimes falling back to prin1. * obsolete.el (obsolete-throw): New function, called from eval.c when #'funcall encounters an attempt to call #'throw (now a special form) as a function. Only needed for compatibility with 21.4 byte-code. man/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * cl.texi (Organization): Remove references to the obsolete multiple-value emulating code. src/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * bytecode.c (enum Opcode /* Byte codes */): Add four new bytecodes, to deal with multiple values. (POP_WITH_MULTIPLE_VALUES): New macro. (POP): Modify this macro to ignore multiple values. (DISCARD_PRESERVING_MULTIPLE_VALUES): New macro. (DISCARD): Modify this macro to ignore multiple values. (TOP_WITH_MULTIPLE_VALUES): New macro. (TOP_ADDRESS): New macro. (TOP): Modify this macro to ignore multiple values. (TOP_LVALUE): New macro. (Bcall): Ignore multiple values where appropriate. (Breturn): Pass back multiple values. (Bdup): Preserve multiple values. Use TOP_LVALUE with most bytecodes that assign anything to anything. (Bbind_multiple_value_limits, Bmultiple_value_call, Bmultiple_value_list_internal, Bthrow): Implement the new bytecodes. (Bgotoifnilelsepop, Bgotoifnonnilelsepop, BRgotoifnilelsepop, BRgotoifnonnilelsepop): Discard any multiple values. * callint.c (Fcall_interactively): Ignore multiple values when calling #'eval, in two places. * device-x.c (x_IO_error_handler): * macros.c (pop_kbd_macro_event): * eval.c (Fsignal): * eval.c (flagged_a_squirmer): Call throw_or_bomb_out, not Fthrow, now that the latter is a special form. * eval.c: Make Qthrow, Qobsolete_throw available as symbols. Provide multiple_value_current_limit, multiple-values-limit (the latter as specified by Common Lisp. * eval.c (For): Ignore multiple values when comparing with Qnil, but pass any multiple values back for the last arg. * eval.c (Fand): Ditto. * eval.c (Fif): Ignore multiple values when examining the result of the condition. * eval.c (Fcond): Ignore multiple values when comparing what the clauses give, but pass them back if a clause gave non-nil. * eval.c (Fprog2): Never pass back multiple values. * eval.c (FletX, Flet): Ignore multiple when evaluating what exactly symbols should be bound to. * eval.c (Fwhile): Ignore multiple values when evaluating the test. * eval.c (Fsetq, Fdefvar, Fdefconst): Ignore multiple values. * eval.c (Fthrow): Declare this as a special form; ignore multiple values for TAG, preserve them for VALUE. * eval.c (throw_or_bomb_out): Make this available to other files, now Fthrow is a special form. * eval.c (Feval): Ignore multiple values when calling a compiled function, a non-special-form subr, or a lambda expression. * eval.c (Ffuncall): If we attempt to call #'throw (now a special form) as a function, don't error, call #'obsolete-throw instead. * eval.c (make_multiple_value, multiple_value_aset) (multiple_value_aref, print_multiple_value, mark_multiple_value) (size_multiple_value): Implement the multiple_value type. Add a long comment describing our implementation. * eval.c (bind_multiple_value_limits): New function, used by the bytecode and by #'multiple-value-call, #'multiple-value-list-internal. * eval.c (multiple_value_call): New function, used by the bytecode and #'multiple-value-call. * eval.c (Fmultiple_value_call): New special form. * eval.c (multiple_value_list_internal): New function, used by the byte code and #'multiple-value-list-internal. * eval.c (Fmultiple_value_list_internal, Fmultiple_value_prog1): New special forms. * eval.c (Fvalues, Fvalues_list): New Lisp functions. * eval.c (values2): New function, for C code returning multiple values. * eval.c (syms_of_eval): Make our new Lisp functions and symbols available. * eval.c (multiple-values-limit): Make this available to Lisp. * event-msw.c (dde_eval_string): * event-stream.c (execute_help_form): * glade.c (connector): * glyphs-widget.c (glyph_instantiator_to_glyph): * glyphs.c (evaluate_xpm_color_symbols): * gui-x.c (wv_set_evalable_slot, button_item_to_widget_value): * gui.c (gui_item_value, gui_item_display_flush_left): * lread.c (check_if_suppressed): * menubar-gtk.c (menu_convert, menu_descriptor_to_widget_1): * menubar-msw.c (populate_menu_add_item): * print.c (Fwith_output_to_temp_buffer): * symbols.c (Fsetq_default): Ignore multiple values when calling Feval. * symeval.h: Add the header declarations necessary for the multiple-values implementation. * inline.c: #include symeval.h, now that it has some inline functions. * lisp.h: Update Fthrow's declaration. Make throw_or_bomb_out available to all files. * lrecord.h (enum lrecord_type): Add the multiple_value type here.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 16 Aug 2009 20:55:49 +0100
parents 79c6ff3eef26
children 7d06a8bf47d2
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1 ;;; gtk-faces.el --- GTK-specific face frobnication, aka black magic.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995, 1996 Ben Wing.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
5 ;; Copyright (c) 2000 William Perry
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
6
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
7 ;; Author: William M. Perry <wmperry@gnu.org>
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
8 ;; Maintainer: XEmacs Development Team
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
9 ;; Keywords: extensions, internal, dumped
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
10
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
11 ;; This file is part of XEmacs.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
12
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
13 ;; XEmacs is free software; you can redistribute it and/or modify it
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
14 ;; under the terms of the GNU General Public License as published by
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
15 ;; the Free Software Foundation; either version 2, or (at your option)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
16 ;; any later version.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
17
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
18 ;; XEmacs is distributed in the hope that it will be useful, but
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
21 ;; General Public License for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
22
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 ;; You should have received a copy of the GNU General Public License
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24 ;; along with XEmacs; see the file COPYING. If not, write to the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26 ;; Boston, MA 02111-1307, USA.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
28 ;;; Synched up with: Not synched.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
29
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30 ;;; Commentary:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
31
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
32 ;; This file is dumped with XEmacs (when GTK support is compiled in).
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
33
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
34 (globally-declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
35 '(gtk-init-pointers
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
36 gtk-font-selection-dialog-new
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
37 gtk-widget-set-sensitive gtk-font-selection-dialog-apply-button
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
38 gtk-signal-connect gtk-main-quit
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
39 gtk-font-selection-dialog-ok-button
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
40 gtk-font-selection-dialog-get-font-name gtk-widget-destroy
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
41 font-menu-set-font font-family font-size
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
42 gtk-font-selection-dialog-cancel-button gtk-widget-show-all
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 711
diff changeset
43 gtk-main gtk-style-info))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
44
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
45 (eval-when-compile
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
46 (defmacro gtk-style-munge-face (face attribute value)
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
47 (let ((func (intern (format "face-%s" (eval attribute)))))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
48 `(add-spec-to-specifier (,func ,face) ,value nil '(gtk default) 'prepend))))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 ;;; gtk-init-device-faces is responsible for initializing default
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51 ;;; values for faces on a newly created device.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
52 ;;;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
53 (defun gtk-init-device-faces (device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
54 ;;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55 ;; If the "default" face didn't have a font specified, try to pick one.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 ;;
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
57 (when (eq (device-type device) 'gtk)
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 706
diff changeset
58 (let* ((style (gtk-style-info device))
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
59 (normal 0) ; GTK_STATE_NORMAL
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 ;;(active 1) ; GTK_STATE_ACTIVE
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61 (prelight 2) ; GTK_STATE_PRELIGHT
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 (selected 3) ; GTK_STATE_SELECTED
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 ;;(insensitive 4) ; GTK_STATE_INSENSITIVE
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 )
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
65 (gtk-style-munge-face 'highlight 'foreground
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
66 (nth prelight (plist-get style 'text)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
67 (gtk-style-munge-face 'highlight 'background
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
68 (nth prelight (plist-get style 'background)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
69 (gtk-style-munge-face 'zmacs-region 'foreground
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
70 (nth selected (plist-get style 'text)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
71 (gtk-style-munge-face 'zmacs-region 'background
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
72 (nth selected (plist-get style 'background)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
73 (gtk-style-munge-face 'toolbar 'background
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
74 (nth normal (plist-get style 'base)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
75 (gtk-style-munge-face 'toolbar 'foreground
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
76 (nth normal (plist-get style 'text)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
77 (set-face-background 'modeline [toolbar background] '(gtk default))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
78 (set-face-foreground 'modeline [toolbar foreground] '(gtk default))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
79 )
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
80 (gtk-init-pointers)))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 ;;; This is called from `init-frame-faces', which is called from
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83 ;;; init_frame_faces() which is called from Fmake_frame(), to perform
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84 ;;; any device-specific initialization.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 ;;;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86 (defun gtk-init-frame-faces (frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 )
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
88
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89 (defun gtk-init-global-faces ()
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 776
diff changeset
90 )
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
92
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
93 ;;; Lots of this stolen from x-faces.el - I'm not sure if this will
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
94 ;;; require a rewrite for win32 or not?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
95 (defconst gtk-font-regexp nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
96 (defconst gtk-font-regexp-head nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
97 (defconst gtk-font-regexp-head-2 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
98 (defconst gtk-font-regexp-weight nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
99 (defconst gtk-font-regexp-slant nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
100 (defconst gtk-font-regexp-pixel nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
101 (defconst gtk-font-regexp-point nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
102 (defconst gtk-font-regexp-foundry-and-family nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
103 (defconst gtk-font-regexp-registry-and-encoding nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
104 (defconst gtk-font-regexp-spacing nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
105
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
106 ;;; Regexps matching font names in "Host Portable Character Representation."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
107 ;;;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
108 (let ((- "[-?]")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
109 (foundry "[^-]*")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
110 (family "[^-]*")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
111 (weight "\\(bold\\|demibold\\|medium\\|black\\)") ; 1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
112 ; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
113 (weight\? "\\([^-]*\\)") ; 1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
114 (slant "\\([ior]\\)") ; 2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
115 ; (slant\? "\\([ior?*]?\\)") ; 2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
116 (slant\? "\\([^-]?\\)") ; 2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
117 ; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
118 (swidth "\\([^-]*\\)") ; 3
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
119 ; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
120 (adstyle "\\([^-]*\\)") ; 4
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
121 (pixelsize "\\(\\*\\|[0-9]+\\)") ; 5
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
122 (pointsize "\\(\\*\\|0\\|[0-9][0-9]+\\)") ; 6
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
123 ; (resx "\\(\\*\\|[0-9][0-9]+\\)") ; 7
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
124 ; (resy "\\(\\*\\|[0-9][0-9]+\\)") ; 8
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
125 (resx "\\([*0]\\|[0-9][0-9]+\\)") ; 7
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
126 (resy "\\([*0]\\|[0-9][0-9]+\\)") ; 8
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
127 (spacing "[cmp?*]")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
128 (avgwidth "\\(\\*\\|[0-9]+\\)") ; 9
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
129 (registry "[^-]*") ; some fonts have omitted registries
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
130 ; (encoding ".+") ; note that encoding may contain "-"...
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
131 (encoding "[^-]+") ; false!
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
132 )
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
133 (setq gtk-font-regexp
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
134 (purecopy
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
135 (concat "\\`\\*?[-?*]"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
136 foundry - family - weight\? - slant\? - swidth - adstyle -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
137 pixelsize - pointsize - resx - resy - spacing - avgwidth -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
138 registry - encoding "\\'"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
139 )))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
140 (setq gtk-font-regexp-head
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
141 (purecopy
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
142 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
143 "\\([-*?]\\|\\'\\)")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
144 (setq gtk-font-regexp-head-2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
145 (purecopy
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
146 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
147 - swidth - adstyle - pixelsize - pointsize
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
148 "\\([-*?]\\|\\'\\)")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
149 (setq gtk-font-regexp-slant (purecopy (concat - slant -)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
150 (setq gtk-font-regexp-weight (purecopy (concat - weight -)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
151 ;; if we can't match any of the more specific regexps (unfortunate) then
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
152 ;; look for digits; assume 2+ digits is 10ths of points, and 1-2 digits
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
153 ;; is pixels. Bogus as hell.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
154 (setq gtk-font-regexp-pixel (purecopy "[-?*]\\([0-9][0-9]?\\)[-?*]"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
155 (setq gtk-font-regexp-point (purecopy "[-?*]\\([0-9][0-9]+\\)[-?*]"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
156 ;; the following two are used by x-font-menu.el.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
157 (setq gtk-font-regexp-foundry-and-family
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
158 (purecopy (concat "\\`[-?*]" foundry - "\\(" family "\\)" -)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
159 (setq gtk-font-regexp-registry-and-encoding
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
160 (purecopy (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
161 (setq gtk-font-regexp-spacing
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
162 (purecopy (concat - "\\(" spacing "\\)" - avgwidth
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
163 - registry - encoding "\\'")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
164 )
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
165
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
166 (defvaralias 'x-font-regexp 'gtk-font-regexp)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
167 (defvaralias 'x-font-regexp-head 'gtk-font-regexp-head)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
168 (defvaralias 'x-font-regexp-head-2 'gtk-font-regexp-head-2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
169 (defvaralias 'x-font-regexp-weight 'gtk-font-regexp-weight)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
170 (defvaralias 'x-font-regexp-slant 'gtk-font-regexp-slant)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
171 (defvaralias 'x-font-regexp-pixel 'gtk-font-regexp-pixel)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
172 (defvaralias 'x-font-regexp-point 'gtk-font-regexp-point)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
173 (defvaralias 'x-font-regexp-foundry-and-family 'gtk-font-regexp-foundry-and-family)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
174 (defvaralias 'x-font-regexp-registry-and-encoding 'gtk-font-regexp-registry-and-encoding)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
175 (defvaralias 'x-font-regexp-spacing 'gtk-font-regexp-spacing)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
176
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
177 (defun gtk-frob-font-weight (font which)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
178 (if (font-instance-p font) (setq font (font-instance-name font)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
179 (cond ((null font) nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
180 ((or (string-match gtk-font-regexp font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
181 (string-match gtk-font-regexp-head font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
182 (string-match gtk-font-regexp-weight font))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
183 (concat (substring font 0 (match-beginning 1)) which
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
184 (substring font (match-end 1))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
185 (t nil)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
186
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
187 (defun gtk-frob-font-slant (font which)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
188 (if (font-instance-p font) (setq font (font-instance-name font)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
189 (cond ((null font) nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
190 ((or (string-match gtk-font-regexp font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
191 (string-match gtk-font-regexp-head font))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
192 (concat (substring font 0 (match-beginning 2)) which
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
193 (substring font (match-end 2))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
194 ((string-match gtk-font-regexp-slant font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
195 (concat (substring font 0 (match-beginning 1)) which
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
196 (substring font (match-end 1))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
197 (t nil)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
198
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
199 (defun gtk-make-font-bold (font &optional device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
200 (or (try-font-name (gtk-frob-font-weight font "bold") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
201 (try-font-name (gtk-frob-font-weight font "black") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
202 (try-font-name (gtk-frob-font-weight font "demibold") device)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
203
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
204 (defun gtk-make-font-unbold (font &optional device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
205 (try-font-name (gtk-frob-font-weight font "medium") device))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
206
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
207 (defcustom try-oblique-before-italic-fonts t
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
208 "*If nil, italic fonts are searched before oblique fonts.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
209 If non-nil, oblique fonts are tried before italic fonts. This is mostly
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
210 applicable to adobe-courier fonts"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
211 :type 'boolean
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
212 :tag "Try Oblique Before Italic Fonts"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
213 :group 'x)
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
214 (define-obsolete-variable-alias '*try-oblique-before-italic-fonts*
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
215 'try-oblique-before-italic-fonts)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
216
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
217 (defun gtk-make-font-italic (font &optional device)
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
218 (if try-oblique-before-italic-fonts
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
219 (or (try-font-name (gtk-frob-font-slant font "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
220 (try-font-name (gtk-frob-font-slant font "i") device))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
221 (or (try-font-name (gtk-frob-font-slant font "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
222 (try-font-name (gtk-frob-font-slant font "o") device))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
223
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
224 (defun gtk-make-font-unitalic (font &optional device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
225 (try-font-name (gtk-frob-font-slant font "r") device))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
226
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
227 (defun gtk-make-font-bold-italic (font &optional device)
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
228 (if try-oblique-before-italic-fonts
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
229 (or (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
230 (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
231 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
232 (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
233 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
234 (gtk-frob-font-slant (gtk-frob-font-weight font "black") "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
235 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
236 (gtk-frob-font-slant (gtk-frob-font-weight font "black") "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
237 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
238 (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
239 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
240 (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "i") device))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
241 (or (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
242 (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
243 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
244 (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
245 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
246 (gtk-frob-font-slant (gtk-frob-font-weight font "black") "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
247 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
248 (gtk-frob-font-slant (gtk-frob-font-weight font "black") "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
249 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
250 (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
251 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
252 (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "o") device))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
253
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
254 (defun gtk-choose-font ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
255 (interactive)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
256 (require 'x-font-menu)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
257 (require 'font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
258 (let ((locale (if font-menu-this-frame-only-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
259 (selected-frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
260 nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
261 (dialog nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
262 (setq dialog (gtk-font-selection-dialog-new "Choose default font..."))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
263 (put dialog 'modal t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
264 (put dialog 'type 'dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
265
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
266 (gtk-widget-set-sensitive (gtk-font-selection-dialog-apply-button dialog) nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
267 (gtk-signal-connect dialog 'destroy (lambda (&rest ignored) (gtk-main-quit)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
268 (gtk-signal-connect (gtk-font-selection-dialog-ok-button dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
269 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
270 (lambda (button data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
271 (let* ((dialog (car data))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
272 (font (font-create-object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
273 (gtk-font-selection-dialog-get-font-name dialog))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
274 (gtk-widget-destroy dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
275 (font-menu-set-font (car (font-family font)) nil (* 10 (font-size font)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
276 (cons dialog locale))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
277 (gtk-signal-connect (gtk-font-selection-dialog-cancel-button dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
278 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
279 (lambda (button dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
280 (gtk-widget-destroy dialog)) dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
281
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
282 (gtk-widget-show-all dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
283 (gtk-main)))