annotate lisp/font-menu.el @ 4981:4aebb0131297

Cleanups/renaming of EXTERNAL_TO_C_STRING and friends -------------------- ChangeLog entries follow: -------------------- modules/ChangeLog addition: 2010-02-05 Ben Wing <ben@xemacs.org> * postgresql/postgresql.c: * postgresql/postgresql.c (CHECK_LIVE_CONNECTION): * postgresql/postgresql.c (Fpq_connectdb): * postgresql/postgresql.c (Fpq_connect_start): * postgresql/postgresql.c (Fpq_lo_import): * postgresql/postgresql.c (Fpq_lo_export): * ldap/eldap.c (Fldap_open): * ldap/eldap.c (Fldap_search_basic): * ldap/eldap.c (Fldap_add): * ldap/eldap.c (Fldap_modify): * ldap/eldap.c (Fldap_delete): * canna/canna_api.c (Fcanna_initialize): * canna/canna_api.c (Fcanna_store_yomi): * canna/canna_api.c (Fcanna_parse): * canna/canna_api.c (Fcanna_henkan_begin): EXTERNAL_TO_C_STRING returns its argument instead of storing it in a parameter, and is renamed to EXTERNAL_TO_ITEXT. Similar things happen to related macros. See entry in src/ChangeLog. More Mule-izing of postgresql.c. Extract out common code between `pq-connectdb' and `pq-connect-start'. Fix places that signal an error string using a formatted string to instead follow the standard and have a fixed reason followed by the particular error message stored as one of the frobs. src/ChangeLog addition: 2010-02-05 Ben Wing <ben@xemacs.org> * console-msw.c (write_string_to_mswindows_debugging_output): * console-msw.c (Fmswindows_message_box): * console-x.c (x_perhaps_init_unseen_key_defaults): * console.c: * database.c (dbm_get): * database.c (dbm_put): * database.c (dbm_remove): * database.c (berkdb_get): * database.c (berkdb_put): * database.c (berkdb_remove): * database.c (Fopen_database): * device-gtk.c (gtk_init_device): * device-msw.c (msprinter_init_device_internal): * device-msw.c (msprinter_default_printer): * device-msw.c (msprinter_init_device): * device-msw.c (sync_printer_with_devmode): * device-msw.c (Fmsprinter_select_settings): * device-x.c (sanity_check_geometry_resource): * device-x.c (Dynarr_add_validified_lisp_string): * device-x.c (x_init_device): * device-x.c (Fx_put_resource): * device-x.c (Fx_valid_keysym_name_p): * device-x.c (Fx_set_font_path): * dialog-msw.c (push_lisp_string_as_unicode): * dialog-msw.c (handle_directory_dialog_box): * dialog-msw.c (handle_file_dialog_box): * dialog-x.c (dbox_descriptor_to_widget_value): * editfns.c (Fformat_time_string): * editfns.c (Fencode_time): * editfns.c (Fset_time_zone_rule): * emacs.c (make_argc_argv): * emacs.c (Fdump_emacs): * emodules.c (emodules_load): * eval.c: * eval.c (maybe_signal_error_1): * event-msw.c (Fdde_alloc_advise_item): * event-msw.c (mswindows_dde_callback): * event-msw.c (mswindows_wnd_proc): * fileio.c (report_error_with_errno): * fileio.c (Fsysnetunam): * fileio.c (Fdo_auto_save): * font-mgr.c (extract_fcapi_string): * font-mgr.c (Ffc_config_app_font_add_file): * font-mgr.c (Ffc_config_app_font_add_dir): * font-mgr.c (Ffc_config_filename): * frame-gtk.c (gtk_set_frame_text_value): * frame-gtk.c (gtk_create_widgets): * frame-msw.c (mswindows_init_frame_1): * frame-msw.c (mswindows_set_title_from_ibyte): * frame-msw.c (msprinter_init_frame_3): * frame-x.c (x_set_frame_text_value): * frame-x.c (x_set_frame_properties): * frame-x.c (start_drag_internal_1): * frame-x.c (x_cde_transfer_callback): * frame-x.c (x_create_widgets): * glyphs-eimage.c (my_jpeg_output_message): * glyphs-eimage.c (jpeg_instantiate): * glyphs-eimage.c (gif_instantiate): * glyphs-eimage.c (png_instantiate): * glyphs-eimage.c (tiff_instantiate): * glyphs-gtk.c (xbm_instantiate_1): * glyphs-gtk.c (gtk_xbm_instantiate): * glyphs-gtk.c (gtk_xpm_instantiate): * glyphs-gtk.c (gtk_xface_instantiate): * glyphs-gtk.c (cursor_font_instantiate): * glyphs-gtk.c (gtk_redisplay_widget): * glyphs-gtk.c (gtk_widget_instantiate_1): * glyphs-gtk.c (gtk_add_tab_item): * glyphs-msw.c (mswindows_xpm_instantiate): * glyphs-msw.c (bmp_instantiate): * glyphs-msw.c (mswindows_resource_instantiate): * glyphs-msw.c (xbm_instantiate_1): * glyphs-msw.c (mswindows_xbm_instantiate): * glyphs-msw.c (mswindows_xface_instantiate): * glyphs-msw.c (mswindows_redisplay_widget): * glyphs-msw.c (mswindows_widget_instantiate): * glyphs-msw.c (add_tree_item): * glyphs-msw.c (add_tab_item): * glyphs-msw.c (mswindows_combo_box_instantiate): * glyphs-msw.c (mswindows_widget_query_string_geometry): * glyphs-x.c (x_locate_pixmap_file): * glyphs-x.c (xbm_instantiate_1): * glyphs-x.c (x_xbm_instantiate): * glyphs-x.c (extract_xpm_color_names): * glyphs-x.c (x_xpm_instantiate): * glyphs-x.c (x_xface_instantiate): * glyphs-x.c (autodetect_instantiate): * glyphs-x.c (safe_XLoadFont): * glyphs-x.c (cursor_font_instantiate): * glyphs-x.c (x_redisplay_widget): * glyphs-x.c (Fchange_subwindow_property): * glyphs-x.c (x_widget_instantiate): * glyphs-x.c (x_tab_control_redisplay): * glyphs.c (pixmap_to_lisp_data): * gui-x.c (menu_separator_style_and_to_external): * gui-x.c (add_accel_and_to_external): * gui-x.c (button_item_to_widget_value): * hpplay.c (player_error_internal): * hpplay.c (play_sound_file): * hpplay.c (play_sound_data): * intl.c (Fset_current_locale): * lisp.h: * menubar-gtk.c (gtk_xemacs_set_accel_keys): * menubar-msw.c (populate_menu_add_item): * menubar-msw.c (populate_or_checksum_helper): * menubar-x.c (menu_item_descriptor_to_widget_value_1): * nt.c (init_user_info): * nt.c (get_long_basename): * nt.c (nt_get_resource): * nt.c (init_mswindows_environment): * nt.c (get_cached_volume_information): * nt.c (mswindows_readdir): * nt.c (read_unc_volume): * nt.c (mswindows_stat): * nt.c (mswindows_getdcwd): * nt.c (mswindows_executable_type): * nt.c (Fmswindows_short_file_name): * ntplay.c (nt_play_sound_file): * objects-gtk.c: * objects-gtk.c (gtk_valid_color_name_p): * objects-gtk.c (gtk_initialize_font_instance): * objects-gtk.c (gtk_font_list): * objects-msw.c (font_enum_callback_2): * objects-msw.c (parse_font_spec): * objects-x.c (x_parse_nearest_color): * objects-x.c (x_valid_color_name_p): * objects-x.c (x_initialize_font_instance): * objects-x.c (x_font_instance_truename): * objects-x.c (x_font_list): * objects-xlike-inc.c (XFUN): * objects-xlike-inc.c (xft_find_charset_font): * process-nt.c (mswindows_report_winsock_error): * process-nt.c (nt_create_process): * process-nt.c (get_internet_address): * process-nt.c (nt_open_network_stream): * process-unix.c: * process-unix.c (allocate_pty): * process-unix.c (get_internet_address): * process-unix.c (unix_canonicalize_host_name): * process-unix.c (unix_open_network_stream): * realpath.c: * select-common.h (lisp_data_to_selection_data): * select-gtk.c (symbol_to_gtk_atom): * select-gtk.c (atom_to_symbol): * select-msw.c (symbol_to_ms_cf): * select-msw.c (mswindows_register_selection_data_type): * select-x.c (symbol_to_x_atom): * select-x.c (x_atom_to_symbol): * select-x.c (hack_motif_clipboard_selection): * select-x.c (Fx_store_cutbuffer_internal): * sound.c (Fplay_sound_file): * sound.c (Fplay_sound): * sound.h (sound_perror): * sysdep.c: * sysdep.c (qxe_allocating_getcwd): * sysdep.c (qxe_execve): * sysdep.c (copy_in_passwd): * sysdep.c (qxe_getpwnam): * sysdep.c (qxe_ctime): * sysdll.c (dll_open): * sysdll.c (dll_function): * sysdll.c (dll_variable): * sysdll.c (search_linked_libs): * sysdll.c (dll_error): * sysfile.h: * sysfile.h (PATHNAME_CONVERT_OUT_TSTR): * sysfile.h (PATHNAME_CONVERT_OUT_UTF_8): * sysfile.h (PATHNAME_CONVERT_OUT): * sysfile.h (LISP_PATHNAME_CONVERT_OUT): * syswindows.h (ITEXT_TO_TSTR): * syswindows.h (LOCAL_FILE_FORMAT_TO_TSTR): * syswindows.h (TSTR_TO_LOCAL_FILE_FORMAT): * syswindows.h (LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN): * syswindows.h (LISP_LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR): * text.h: * text.h (eicpy_ext_len): * text.h (enum new_dfc_src_type): * text.h (EXTERNAL_TO_ITEXT): * text.h (GET_STRERROR): * tooltalk.c (check_status): * tooltalk.c (Fadd_tooltalk_message_arg): * tooltalk.c (Fadd_tooltalk_pattern_attribute): * tooltalk.c (Fadd_tooltalk_pattern_arg): * win32.c (tstr_to_local_file_format): * win32.c (mswindows_lisp_error_1): * win32.c (mswindows_report_process_error): * win32.c (Fmswindows_shell_execute): * win32.c (mswindows_read_link_1): Changes involving external/internal format conversion, mostly code cleanup and renaming. 1. Eliminate the previous macros like LISP_STRING_TO_EXTERNAL that stored its result in a parameter. The new version of LISP_STRING_TO_EXTERNAL returns its result through the return value, same as the previous NEW_LISP_STRING_TO_EXTERNAL. Use the new-style macros throughout the code. 2. Rename C_STRING_TO_EXTERNAL and friends to ITEXT_TO_EXTERNAL, in keeping with overall naming rationalization involving Itext and related types. Macros involved in previous two: EXTERNAL_TO_C_STRING -> EXTERNAL_TO_ITEXT EXTERNAL_TO_C_STRING_MALLOC -> EXTERNAL_TO_ITEXT_MALLOC SIZED_EXTERNAL_TO_C_STRING -> SIZED_EXTERNAL_TO_ITEXT SIZED_EXTERNAL_TO_C_STRING_MALLOC -> SIZED_EXTERNAL_TO_ITEXT_MALLOC C_STRING_TO_EXTERNAL -> ITEXT_TO_EXTERNAL C_STRING_TO_EXTERNAL_MALLOC -> ITEXT_TO_EXTERNAL_MALLOC LISP_STRING_TO_EXTERNAL LISP_STRING_TO_EXTERNAL_MALLOC LISP_STRING_TO_TSTR C_STRING_TO_TSTR -> ITEXT_TO_TSTR TSTR_TO_C_STRING -> TSTR_TO_ITEXT The following four still return their values through parameters, since they have more than one value to return: C_STRING_TO_SIZED_EXTERNAL -> ITEXT_TO_SIZED_EXTERNAL LISP_STRING_TO_SIZED_EXTERNAL C_STRING_TO_SIZED_EXTERNAL_MALLOC -> ITEXT_TO_SIZED_EXTERNAL_MALLOC LISP_STRING_TO_SIZED_EXTERNAL_MALLOC Sometimes additional casts had to be inserted, since the old macros played strange games and completely defeated the type system of the store params. 3. Rewrite many places where direct calls to TO_EXTERNAL_FORMAT occurred with calls to one of the convenience macros listed above, or to make_extstring(). 4. Eliminate SIZED_C_STRING macros (they were hardly used, anyway) and use a direct call to TO_EXTERNAL_FORMAT or TO_INTERNAL_FORMAT. 4. Use LISP_PATHNAME_CONVERT_OUT in many places instead of something like LISP_STRING_TO_EXTERNAL(..., Qfile_name). 5. Eliminate some temporary variables that are no longer necessary now that we return a value rather than storing it into a variable. 6. Some Mule-izing in database.c. 7. Error functions: -- A bit of code cleanup in maybe_signal_error_1. -- Eliminate report_file_type_error; it's just an alias for signal_error_2 with params in a different order. -- Fix some places in the hostname-handling code that directly inserted externally-retrieved error strings into the supposed ASCII "reason" param instead of doing the right thing and sticking text descriptive of what was going on in "reason" and putting the external message in a frob. 8. Use Ascbyte instead of CIbyte in process-unix.c and maybe one or two other places. 9. Some code cleanup in copy_in_passwd() in sysdep.c. 10. Fix a real bug due to accidental variable shadowing in tstr_to_local_file_format() in win32.c.
author Ben Wing <ben@xemacs.org>
date Fri, 05 Feb 2010 11:02:24 -0600
parents 049dc907c17a
children 3889ef128488 308d34e9f07d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;; font-menu.el --- Managing menus of fonts.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Copyright (C) 1997 Sun Microsystems
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Adapted from x-font-menu.el by Andy Piper <andy@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
22 ;; along with XEmacs; see the file COPYING. If not, write to the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; This file contains the device-nospecific font menu stuff
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;;; Creates three menus, "Font", "Size", and "Weight", and puts them on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;;; "Options" menu. The contents of these menus are the superset of those
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;;; properties available on any fonts, but only the intersection of the three
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;;; sets is selectable at one time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;;; Known Problems:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;;; ===============
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;;; Items on the Font menu are selectable if and only if that font exists in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;;; the same size and weight as the current font. This means that some fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;;; are simply not reachable from some other fonts - if only one font comes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;;; in only one point size (like "Nil", which comes only in 2), you will never
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;;; be able to select it. It would be better if the items on the Fonts menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;;; were always selectable, and selecting them would set the size to be the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;;; closest size to the current font's size.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;;;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
45 ;;; This attempts to change all other faces in an analogous way to the change
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;;; that was made to the default face; if it can't, it will skip over the face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;;; However, this could leave incongruous font sizes around, which may cause
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;;; some nonreversibility problems if further changes are made. Perhaps it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;;; should remember the initial fonts of all faces, and derive all subsequent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;;; fonts from that initial state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;;; xfontsel(1) is a lot more flexible (but probably harder to understand).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;;; The code to construct menus from all of the x11 fonts available from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;;; server is autoloaded and executed the very first time that one of the Font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;;; menus is selected on each device. That is, if XEmacs has frames on two
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;;; different devices, then separate font menu information will be maintained
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;;; for each X display. If the font path changes after emacs has already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;;; asked the X server on a particular display for its list of fonts, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;;; won't notice. Also, the first time that a font menu is posted on each
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;;; display will entail a lengthy delay, but that's better than slowing down
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;;; XEmacs startup. At any time (i.e.: after a font-path change or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;;; immediately after device creation), you can call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 ;;; `reset-device-font-menus' to rebuild the menus from all currently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;;; available fonts.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;;; There are at least three kinds of fonts under X11r5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;;; - bitmap fonts, which can be assumed to look as good as possible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;;; - bitmap fonts which have been (or can be) automatically scaled to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 ;;; a new size, and which almost always look awful;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 ;;; - and true outline fonts, which should look ok at any size, but in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;;; practice (on at least some systems) look awful at any size, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;;; even in theory are unlikely ever to look as good as non-scaled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;;; bitmap fonts.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;;; It would be nice to get this code to look for non-scaled bitmap fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;;; first, then outline fonts, then scaled bitmap fonts as a last resort.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;;; But it's not clear to me how to tell them apart based on their truenames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;;; and/or the result of XListFonts(). I welcome any and all explanations
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;;; of the subtleties involved...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 ;;; If You Think You'Re Seeing A Bug:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 ;;; =================================
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ;;; When reporting problems, send the following information:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 ;;; - Exactly what behavior you're seeing;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ;;; - The output of the `xlsfonts' program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 ;;; - The value of the variable `device-fonts-cache';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ;;; - The values of the following expressions, both before and after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 ;;; making a selection from any of the fonts-related menus:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 ;;; (face-font 'default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 ;;; (font-truename (face-font 'default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 ;;; (font-properties (face-font 'default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 ;;; - The values of the following variables after making a selection:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 ;;; font-menu-preferred-resolution
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 ;;; font-menu-registry-encoding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 ;;; There is a common misconception that "*-courier-medium-r-*-11-*", also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 ;;; known as "-adobe-courier-medium-r-normal--11-80-100-100-m-60-iso8859-1",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 ;;; is an 11-point font. It is not -- it is an 11-pixel font at 100dpi,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 ;;; which is an 8-point font (the number after -11- is the size in tenths
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 ;;; of points). So if you expect to be seeing an "11" entry in the "Size"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 ;;; menu and are not, this may be why.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 ;;; In the real world (aka Solaris), one has to deal with fonts that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 ;;; appear to be medium-i but are really light-r, and fonts that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 ;;; resolve to different resolutions depending on the charset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 ;;; (font-instance-truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 ;;; (make-font-instance "-*-mincho-medium-i-normal-*-*-*-*-*-*-*-jisx0201*-*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 ;;; ==>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 ;;; "-morisawa-ryumin light kl-light-r-normal--10-100-72-72-m-50-jisx0201.1976-0"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 ;;;
2527
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2297
diff changeset
116 ;;; (font-list "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 ;;; ==>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 ;;; ("-dt-interface user-medium-r-normal-s sans-12-120-72-72-m-70-iso8859-1"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 ;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 ;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-60-jisx0201.1976-0")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (defcustom font-menu-ignore-scaled-fonts nil
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
124 "*If non-nil, the font menu shows only bitmap fonts.
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
125
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
126 Bitmap fonts at their design size are generally noticably higher quality than
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
127 scaled fonts, unless the device is capable of interpreting antialiasing hints.
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
128 In general, setting this option non-`nil' is useful mostly on older X servers.
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
129
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
130 Not all devices make the distinction between bitmap and scaled fonts."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 :group 'font-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (defcustom font-menu-this-frame-only-p nil
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
136 "*If non-nil, the menu affects the default font only on the selected frame."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 :group 'font-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
1701
a1e328407366 [xemacs-hg @ 2003-09-20 01:14:24 by youngs]
youngs
parents: 1102
diff changeset
140 (defcustom font-menu-max-number nil
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
141 "The maximum number of fonts retrieved from the display."
1701
a1e328407366 [xemacs-hg @ 2003-09-20 01:14:24 by youngs]
youngs
parents: 1102
diff changeset
142 :type 'integer
a1e328407366 [xemacs-hg @ 2003-09-20 01:14:24 by youngs]
youngs
parents: 1102
diff changeset
143 :group 'font-menu)
a1e328407366 [xemacs-hg @ 2003-09-20 01:14:24 by youngs]
youngs
parents: 1102
diff changeset
144
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 446
diff changeset
145 (defvaralias 'font-menu-max-items 'menu-max-items)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 446
diff changeset
146 (defvaralias 'font-menu-submenu-name-format 'menu-submenu-name-format)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
148 ;; #### Need to update for fontconfig/Xft? Document form for MS Windows.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
149 (defvar font-menu-preferred-resolution
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (make-specifier-and-init 'generic '((global ((mswindows) . ":")
1102
30118fdc4f1f [xemacs-hg @ 2002-11-12 03:52:23 by stephent]
stephent
parents: 872
diff changeset
151 ((gtk) . "*-*")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 ((x) . "*-*"))) t)
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
153 "Generic specifier containing preferred resolution as a string.
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
154 Do not `setq' this variable; use `set-specifier'.
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
155
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
156 For X11 and GTK devices, the instance value will be interpolated into an
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
157 XLFD, and looks like \"75-75\").")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (defvar font-menu-size-scaling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (make-specifier-and-init 'integer '((global ((mswindows) . 1)
1102
30118fdc4f1f [xemacs-hg @ 2002-11-12 03:52:23 by stephent]
stephent
parents: 872
diff changeset
161 ((gtk) . 10)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 ((x) . 10))) t)
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
163 "Generic specifier containing scale factor for font sizes. Don't touch.
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
164
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
165 This is really a device type constant. Some devices specify size in points
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
166 \(MS Windows), others in decipoints (X11).")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
168 (defvar device-fonts-cache nil
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
169 "Alist mapping devices to font lists and font menus. Don't use this.
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
170
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
171 Instead, use the function `device-fonts-cache' which lazily updates this
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
172 variable, and returns the value for the selected device.
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
173
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
174 Each element has the form (DEVICE . [FONT-LIST FAMILY SIZE WEIGHT]) where
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
175 FAMILY, SIZE, and WEIGHT denote menus.")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (defsubst device-fonts-cache ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 (or (cdr (assq (selected-device) device-fonts-cache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (and (reset-device-font-menus (selected-device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (cdr (assq (selected-device) device-fonts-cache)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (fset 'install-font-menus 'reset-device-font-menus)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 (make-obsolete 'install-font-menus 'reset-device-font-menus)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 (defun reset-device-font-menus (&optional device debug)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 "Generates the `Font', `Size', and `Weight' submenus for the Options menu.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 This is run the first time that a font-menu is needed for each device.
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
190
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 If you don't like the lazy invocation of this function, you can add it to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 `create-device-hook' and that will make the font menus respond more quickly
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
193 when they are selected for the first time. If you add fonts to your system,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 or if you change your font path, you can call this to re-initialize the menus."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (if (or noninteractive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (not (or device (setq device (selected-device)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 nil
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
198 (message "Getting list of fonts from server... ")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 (call-device-method 'reset-device-font-menus device device debug)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (message "Getting list of fonts from server... done.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (defun font-menu-family-constructor (ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (catch 'menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (unless (console-on-window-system-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (throw 'menu '(["Cannot parse current font" ding nil])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 (let* ((dcache (device-fonts-cache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 (font-data (font-menu-font-data 'default dcache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 (entry (aref font-data 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (family (aref font-data 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (size (aref font-data 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (weight (aref font-data 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (unless family
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (throw 'menu '(["Cannot parse current font" ding nil])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 ;; Items on the Font menu are enabled iff that font exists in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 ;; the same size and weight as the current font (scalable fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 ;; exist in every size). Only the current font is marked as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 ;; selected.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 446
diff changeset
220 (menu-split-long-menu
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 (lambda (item)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
223 (setq f (menu-item-strip-accelerator-spec (aref item 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 entry (vassoc f (aref dcache 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 (if (and (or (member weight (aref entry 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 ;; mswindows often allows any weight
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (member "" (aref entry 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (or (member size (aref entry 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (and (not font-menu-ignore-scaled-fonts)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 (member 0 (aref entry 2)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (enable-menu-item item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (disable-menu-item item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (if (string-equal family f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (select-toggle-menu-item item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (deselect-toggle-menu-item item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (aref dcache 1))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (define-device-method* font-menu-font-data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (defun font-menu-size-constructor (ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 (catch 'menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (unless (console-on-window-system-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (throw 'menu '(["Cannot parse current font" ding nil])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (let* ((dcache (device-fonts-cache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (font-data (font-menu-font-data 'default dcache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (entry (aref font-data 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (family (aref font-data 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (size (aref font-data 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 ;;(weight (aref font-data 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 s)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (unless family
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (throw 'menu '(["Cannot parse current font" ding nil])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 ;; Items on the Size menu are enabled iff current font has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 ;; that size. Only the size of the current font is selected.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 ;; (If the current font comes in size 0, it is scalable, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 ;; thus has every size.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (lambda (item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (setq s (nth 3 (aref item 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (if (or (member s (aref entry 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (and (not font-menu-ignore-scaled-fonts)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (member 0 (aref entry 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (enable-menu-item item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (disable-menu-item item))
3094
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
267 ;; #### God save the Queen!
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
268 ;; well, if this fails because s or size is non-numeric, fuck 'em
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
269 (if (= size (if (featurep 'xft-fonts) (float s) s))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 (select-toggle-menu-item item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (deselect-toggle-menu-item item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 item)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
273 (submenu-generate-accelerator-spec (aref dcache 2))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (defun font-menu-weight-constructor (ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (catch 'menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (unless (console-on-window-system-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (throw 'menu '(["Cannot parse current font" ding nil])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (let* ((dcache (device-fonts-cache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (font-data (font-menu-font-data 'default dcache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (entry (aref font-data 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (family (aref font-data 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 ;;(size (aref font-data 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (weight (aref font-data 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 w)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (unless family
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (throw 'menu '(["Cannot parse current font" ding nil])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 ;; Items on the Weight menu are enabled iff current font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 ;; has that weight. Only the weight of the current font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 ;; is selected.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (lambda (item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (setq w (aref item 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (if (member w (aref entry 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (enable-menu-item item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (disable-menu-item item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (if (string-equal weight w)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (select-toggle-menu-item item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (deselect-toggle-menu-item item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 item)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
302 (submenu-generate-accelerator-spec (aref dcache 3))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 ;;; Changing font sizes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (defun font-menu-set-font (family weight size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 ;; This is what gets run when an item is selected from any of the three
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 ;; fonts menus. It needs to be rather clever.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 ;; (size is measured in 10ths of points.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (let* ((dcache (device-fonts-cache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (font-data (font-menu-font-data 'default dcache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (from-family (aref font-data 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (from-size (aref font-data 2))
1102
30118fdc4f1f [xemacs-hg @ 2002-11-12 03:52:23 by stephent]
stephent
parents: 872
diff changeset
315 (from-weight (aref font-data 3))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (from-slant (aref font-data 4))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
317 (face-list-to-change (delq 'default (face-list)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
318 new-default-face-font)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (unless from-family
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (signal 'error '("couldn't parse font name for default face")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (when weight
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (signal 'error '("Setting weight currently not supported")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (setq new-default-face-font
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
324 (font-instance-name
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
325 (font-menu-load-font
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
326 (or family from-family)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
327 (or weight from-weight)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
328 (or size from-size)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
329 from-slant
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
330 (specifier-instance
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
331 font-menu-preferred-resolution (selected-device)))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
332 ;; #### This is such a gross hack. The border-glyph face under
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 ;; mswindows is in a symbol font. Thus it will not appear in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 ;; cache - being a junk family. What we should do is change the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 ;; size but not the family, but this is more work than I care to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 ;; invest at the moment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (when (eq (device-type) 'mswindows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (setq face-list-to-change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (delq 'border-glyph face-list-to-change)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (dolist (face face-list-to-change)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (when (face-font-instance face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (message "Changing font of `%s'..." face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (condition-case c
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (font-menu-change-face face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 from-family from-weight from-size
1102
30118fdc4f1f [xemacs-hg @ 2002-11-12 03:52:23 by stephent]
stephent
parents: 872
diff changeset
346 (or family from-family)
30118fdc4f1f [xemacs-hg @ 2002-11-12 03:52:23 by stephent]
stephent
parents: 872
diff changeset
347 (or weight from-weight)
30118fdc4f1f [xemacs-hg @ 2002-11-12 03:52:23 by stephent]
stephent
parents: 872
diff changeset
348 (or size from-size))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (error
3094
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
350 (message "Error updating font of `%s'" face)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (display-error c nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (sit-for 1)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 ;; Set the default face's font after hacking the other faces, so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 ;; the frame size doesn't change until we are all done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 ;; If we need to be frame local we do the changes ourselves.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (if font-menu-this-frame-only-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 ;;; WMP - we need to honor font-menu-this-frame-only-p here!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (set-face-font 'default new-default-face-font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (and font-menu-this-frame-only-p (selected-frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 ;; OK Let Customize do it.
3094
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
362 (let ((fsize (if (featurep 'xft-fonts)
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
363 (int-to-string (or size from-size))
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
364 (concat (int-to-string
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
365 (/ (or size from-size)
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
366 (specifier-instance font-menu-size-scaling
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
367 (selected-device))))
3918
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
368 "pt")))
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
369 new-spec-list)
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
370 ;; If the font was initialised from X resources (the tag-set
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
371 ;; contains 'x-resource) pretend to Custom that it has
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
372 ;; responsibility for those settings.
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
373 (map-specifier (face-font 'default)
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
374 (lambda (spec locale inst-list arg)
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
375 (loop
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
376 for (tag-set . inst)
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
377 in inst-list
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
378 do (setq tag-set (delq 'x-resource tag-set)
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
379 tag-set (delq 'custom tag-set)
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
380 tag-set (cons 'custom tag-set))
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
381 (push (cons tag-set inst) new-spec-list)
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
382 ;; Need to return nil, else map-specifier stops
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
383 finally return nil))
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
384 nil nil '(x-resource))
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
385 (remove-specifier (face-font 'default) nil '(x-resource))
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
386 (when new-spec-list
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
387 (add-spec-list-to-specifier (face-font 'default)
049dc907c17a [xemacs-hg @ 2007-04-22 19:58:27 by aidan]
aidan
parents: 3094
diff changeset
388 (list (cons 'global new-spec-list))))
3094
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
389 (custom-set-face-update-spec 'default
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
390 (list (list 'type (device-type)))
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
391 (list :family (or family from-family)
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
392 :size fsize))))
ad2f4ae9895b [xemacs-hg @ 2005-11-26 11:45:47 by stephent]
stephent
parents: 2527
diff changeset
393 (message "Font %s" (face-font-name 'default))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
395 ;; #### This should be called `font-menu-maybe-change-face'
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
396 ;; I wonder if a better API wouldn't (face attribute from to)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (defun font-menu-change-face (face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 from-family from-weight from-size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 to-family to-weight to-size)
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
400 "Maybe update the font of FACE per TO-FAMILY, TO-WEIGHT, and TO-SIZE."
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
401 (check-type face symbol)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (let* ((dcache (device-fonts-cache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (font-data (font-menu-font-data face dcache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (face-family (aref font-data 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (face-size (aref font-data 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (face-weight (aref font-data 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (face-slant (aref font-data 4)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
409 (or face-family
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1701
diff changeset
410 (signal 'error (list "couldn't parse font name for face" face)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 ;; If this face matches the old default face in the attribute we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 ;; are changing, then change it to the new attribute along that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 ;; dimension. Also, the face must have its own global attribute.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 ;; If its value is inherited, we don't touch it. If any of this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 ;; is not true, we leave it alone.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 (when (and (face-font face 'global)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
418 (cond
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (to-family (string-equal face-family from-family))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (to-weight (string-equal face-weight from-weight))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (to-size (= face-size from-size))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (set-face-font face
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
423 (font-instance-name
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
424 (font-menu-load-font (or to-family face-family)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
425 (or to-weight face-weight)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
426 (or to-size face-size)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
427 face-slant
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
428 (specifier-instance
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
429 font-menu-preferred-resolution
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 771
diff changeset
430 (selected-device))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (and font-menu-this-frame-only-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (selected-frame))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (define-device-method font-menu-load-font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 (defun flush-device-fonts-cache (device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 ;; by Stig@hackvan.com
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (let ((elt (assq device device-fonts-cache)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (and elt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 (setq device-fonts-cache (delq elt device-fonts-cache)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 (add-hook 'delete-device-hook 'flush-device-fonts-cache)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (provide 'font-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 ;; font-menu ends here