Mercurial > hg > xemacs-beta
annotate lisp/modeline.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 | 49e17f7182f5 |
| children | 668c73e222fd |
| rev | line source |
|---|---|
| 428 | 1 ;;; modeline.el --- modeline hackery. |
| 2 | |
| 3 ;; Copyright (C) 1988, 1992-1994, 1997 Free Software Foundation, Inc. | |
| 771 | 4 ;; Copyright (C) 1995, 1996, 2002 Ben Wing. |
| 428 | 5 |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: extensions, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
| 11 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 12 ;; under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 19 ;; General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 438 | 22 ;; along with XEmacs; see the file COPYING. If not, write to the |
| 428 | 23 ;; Free Software Foundation, 59 Temple Place - Suite 330, |
| 24 ;; Boston, MA 02111-1307, USA. | |
| 25 | |
| 26 ;;; Synched up with: Not in FSF. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This file is dumped with XEmacs. | |
| 31 | |
| 32 ;;; Code: | |
| 33 | |
| 34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 35 ;;; General mouse modeline stuff ;;; | |
| 36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 37 | |
| 38 (defgroup modeline nil | |
| 39 "Modeline customizations." | |
| 40 :group 'environment) | |
| 41 | |
| 442 | 42 (defcustom modeline-3d-p ;; added for the options menu |
| 43 (let ((thickness | |
| 44 (specifier-instance modeline-shadow-thickness))) | |
| 45 (and (integerp thickness) | |
| 46 (> thickness 0))) | |
|
4578
49e17f7182f5
Fix docstring copy-pasto.
"Ville Skyttä <scop@xemacs.org>"
parents:
4043
diff
changeset
|
47 "Whether the modeline is displayed with raised, 3-d appearance. |
| 771 | 48 This option only has an effect when set using `customize-set-variable', |
| 49 or through the Options menu." | |
| 442 | 50 :group 'display |
| 51 :type 'boolean | |
| 52 :set #'(lambda (var val) | |
| 53 (if val | |
| 54 (set-specifier modeline-shadow-thickness 2) | |
| 55 (set-specifier modeline-shadow-thickness 0)) | |
| 56 (redraw-modeline t) | |
| 57 (setq modeline-3d-p val)) | |
| 58 ) | |
| 59 | |
| 428 | 60 (defcustom drag-divider-event-lag 150 |
| 61 "*The pause (in msecs) between divider drag events before redisplaying. | |
| 62 If this value is too small, dragging will be choppy because redisplay cannot | |
| 63 keep up. If it is too large, dragging will be choppy because of the explicit | |
| 64 redisplay delay specified." | |
| 65 :type 'integer | |
| 66 ;; #### Fix group. | |
| 67 :group 'modeline) | |
| 68 | |
| 69 (define-obsolete-variable-alias | |
| 70 'drag-modeline-event-lag | |
| 71 'drag-divider-event-lag) | |
| 72 | |
| 73 (defcustom modeline-click-swaps-buffers nil | |
| 74 "*If non-nil, clicking on the modeline changes the current buffer. | |
| 75 Click on the left half of the modeline cycles forward through the | |
| 76 buffer list and clicking on the right half cycles backward." | |
| 77 :type 'boolean | |
| 78 :group 'modeline) | |
| 79 | |
| 438 | 80 (defcustom modeline-scrolling-method nil |
| 81 "*If non-nil, dragging the modeline with the mouse may also scroll its | |
| 82 text horizontally (vertical motion controls window resizing and horizontal | |
| 83 motion controls modeline scrolling). | |
| 84 | |
| 85 With a value of t, the modeline text is scrolled in the same direction as | |
| 86 the mouse motion. With a value of 'scrollbar, the modeline is considered as | |
| 771 | 87 a scrollbar for its own text, which then moves in the opposite direction. |
| 88 | |
| 89 This option should be set using `customize-set-variable'." | |
| 438 | 90 :type '(choice (const :tag "none" nil) |
| 91 (const :tag "text" t) | |
| 92 (const :tag "scrollbar" scrollbar)) | |
| 93 :set (lambda (sym val) | |
| 94 (set-default sym val) | |
| 95 (when (featurep 'x) | |
| 96 (cond ((eq val t) | |
| 97 (set-glyph-image modeline-pointer-glyph "hand2" 'global 'x)) | |
| 98 ((eq val 'scrollbar) | |
| 99 (set-glyph-image modeline-pointer-glyph "fleur" 'global 'x)) | |
| 100 (t | |
| 101 (set-glyph-image modeline-pointer-glyph "sb_v_double_arrow" | |
| 442 | 102 'global 'x)))) |
| 103 (when (featurep 'mswindows) | |
| 104 (cond ((eq val t) | |
| 105 (set-glyph-image modeline-pointer-glyph | |
| 106 [mswindows-resource :resource-type cursor | |
| 107 :resource-id "SizeAll"] | |
| 108 'global 'mswindows)) | |
| 109 ((eq val 'scrollbar) | |
| 110 (set-glyph-image modeline-pointer-glyph | |
| 111 [mswindows-resource :resource-type cursor | |
| 112 :resource-id "Normal"] | |
| 113 'global 'mswindows)) | |
| 114 (t | |
| 115 (set-glyph-image modeline-pointer-glyph | |
| 116 [mswindows-resource :resource-type cursor | |
| 117 :resource-id "SizeNS"] | |
| 118 'global 'mswindows))))) | |
| 438 | 119 :group 'modeline) |
| 120 | |
| 428 | 121 (defun mouse-drag-modeline (event) |
| 122 "Resize a window by dragging its modeline. | |
| 123 This command should be bound to a button-press event in modeline-map. | |
| 124 Holding down a mouse button and moving the mouse up and down will | |
| 438 | 125 make the clicked-on window taller or shorter. |
| 126 | |
| 127 See also the variable `modeline-scrolling-method'." | |
| 428 | 128 (interactive "e") |
| 129 (or (button-press-event-p event) | |
| 130 (error "%s must be invoked by a mouse-press" this-command)) | |
| 131 (or (event-over-modeline-p event) | |
| 132 (error "not over a modeline")) | |
| 133 ;; Give the modeline a "pressed" look. --hniksic | |
| 134 (let-specifier ((modeline-shadow-thickness | |
| 135 (- (specifier-instance modeline-shadow-thickness | |
| 136 (event-window event))) | |
| 137 (event-window event))) | |
| 138 (let ((done nil) | |
| 139 (depress-line (event-y event)) | |
| 140 (start-event-frame (event-frame event)) | |
| 141 (start-event-window (event-window event)) | |
| 142 (start-nwindows (count-windows t)) | |
| 438 | 143 (hscroll-delta (face-width 'modeline)) |
| 144 (start-hscroll (modeline-hscroll (event-window event))) | |
| 145 (start-x-pixel (event-x-pixel event)) | |
| 428 | 146 (last-timestamp 0) |
| 147 default-line-height | |
| 148 modeline-height | |
| 149 should-enlarge-minibuffer | |
| 150 event min-height minibuffer y top bot edges wconfig growth) | |
| 151 (setq minibuffer (minibuffer-window start-event-frame) | |
| 152 default-line-height (face-height 'default start-event-window) | |
| 153 min-height (+ (* window-min-height default-line-height) | |
| 154 ;; Don't let the window shrink by a | |
| 155 ;; non-multiple of the default line | |
| 156 ;; height. (enlarge-window -1) will do | |
| 157 ;; this if the difference between the | |
| 158 ;; current window height and the minimum | |
| 159 ;; window height is less than the height | |
| 160 ;; of the default font. These extra | |
| 161 ;; lost pixels of height don't come back | |
| 162 ;; if you grow the window again. This | |
| 163 ;; can make it impossible to drag back | |
| 164 ;; to the exact original size, which is | |
| 165 ;; disconcerting. | |
| 166 (% (window-pixel-height start-event-window) | |
| 167 default-line-height)) | |
| 168 modeline-height | |
| 169 (if (specifier-instance has-modeline-p start-event-window) | |
| 170 (+ (face-height 'modeline start-event-window) | |
| 171 (* 2 (specifier-instance modeline-shadow-thickness | |
| 172 start-event-window))) | |
| 173 (* 2 (specifier-instance modeline-shadow-thickness | |
| 174 start-event-window)))) | |
| 175 (if (not (eq (window-frame minibuffer) start-event-frame)) | |
| 176 (setq minibuffer nil)) | |
| 177 (if (and (null minibuffer) (one-window-p t)) | |
| 178 (error "Attempt to resize sole window")) | |
| 179 ;; if this is the bottommost ordinary window, then to | |
| 180 ;; move its modeline the minibuffer must be enlarged. | |
| 181 (setq should-enlarge-minibuffer | |
| 182 (and minibuffer (window-lowest-p start-event-window))) | |
| 183 ;; loop reading events | |
| 184 (while (not done) | |
| 185 (setq event (next-event event)) | |
| 186 ;; requeue event and quit if this is a misc-user, eval or | |
| 187 ;; keypress event. | |
| 188 ;; quit if this is a button press or release event, or if the event | |
| 189 ;; occurred in some other frame. | |
| 190 ;; drag if this is a mouse motion event and the time | |
| 191 ;; between this event and the last event is greater than | |
| 192 ;; drag-divider-event-lag. | |
| 193 ;; do nothing if this is any other kind of event. | |
| 194 (cond ((or (misc-user-event-p event) | |
| 195 (key-press-event-p event)) | |
| 196 (setq unread-command-events (nconc unread-command-events | |
| 197 (list event)) | |
| 198 done t)) | |
| 199 ((button-release-event-p event) | |
| 200 (setq done t) | |
| 201 ;; Consider we have a mouse click neither X pos (modeline | |
| 202 ;; scroll) nore Y pos (modeline drag) have changed. | |
| 203 (and modeline-click-swaps-buffers | |
| 204 (= depress-line (event-y event)) | |
| 438 | 205 (or (not modeline-scrolling-method) |
| 206 (= start-hscroll | |
| 207 (modeline-hscroll start-event-window))) | |
| 428 | 208 (modeline-swap-buffers event))) |
| 209 ((button-event-p event) | |
| 210 (setq done t)) | |
| 211 ((not (motion-event-p event)) | |
| 212 (dispatch-event event)) | |
| 213 ((not (eq start-event-frame (event-frame event))) | |
| 214 (setq done t)) | |
| 215 ((< (abs (- (event-timestamp event) last-timestamp)) | |
| 216 drag-divider-event-lag) | |
| 217 nil) | |
| 218 (t | |
| 438 | 219 (when modeline-scrolling-method |
| 220 (let ((delta (/ (- (event-x-pixel event) start-x-pixel) | |
| 221 hscroll-delta))) | |
| 222 (set-modeline-hscroll start-event-window | |
| 223 (if (eq modeline-scrolling-method t) | |
| 224 (- start-hscroll delta) | |
| 225 (+ start-hscroll delta))) | |
| 226 )) | |
| 428 | 227 (setq last-timestamp (event-timestamp event) |
| 228 y (event-y-pixel event) | |
| 229 edges (window-pixel-edges start-event-window) | |
| 230 top (nth 1 edges) | |
| 231 bot (nth 3 edges)) | |
| 232 ;; scale back a move that would make the | |
| 233 ;; window too short. | |
| 234 (cond ((< (- y top (- modeline-height)) min-height) | |
| 235 (setq y (+ top min-height (- modeline-height))))) | |
| 236 ;; compute size change needed | |
| 237 (setq growth (- y bot (/ (- modeline-height) 2)) | |
| 238 wconfig (current-window-configuration)) | |
| 239 ;; grow/shrink minibuffer? | |
| 240 (if should-enlarge-minibuffer | |
| 241 (progn | |
| 242 ;; yes. scale back shrinkage if it | |
| 243 ;; would make the minibuffer less than 1 | |
| 244 ;; line tall. | |
| 245 ;; | |
| 246 ;; also flip the sign of the computed growth, | |
| 247 ;; since if we want to grow the window with the | |
| 248 ;; modeline we need to shrink the minibuffer | |
| 249 ;; and vice versa. | |
| 250 (if (and (> growth 0) | |
| 251 (< (- (window-pixel-height minibuffer) | |
| 252 growth) | |
| 253 default-line-height)) | |
| 254 (setq growth | |
| 255 (- (window-pixel-height minibuffer) | |
| 256 default-line-height))) | |
| 257 (setq growth (- growth)))) | |
| 258 ;; window grow and shrink by lines not pixels, so | |
| 259 ;; divide the pixel height by the height of the | |
| 260 ;; default face. | |
| 261 (setq growth (/ growth default-line-height)) | |
| 262 ;; grow/shrink the window | |
| 263 (enlarge-window growth nil (if should-enlarge-minibuffer | |
| 264 minibuffer | |
| 265 start-event-window)) | |
| 266 ;; if this window's growth caused another | |
| 267 ;; window to be deleted because it was too | |
| 268 ;; short, rescind the change. | |
| 269 ;; | |
| 270 ;; if size change caused space to be stolen | |
| 271 ;; from a window above this one, rescind the | |
| 272 ;; change, but only if we didn't grow/shrink | |
| 273 ;; the minibuffer. minibuffer size changes | |
| 274 ;; can cause all windows to shrink... no way | |
| 275 ;; around it. | |
| 276 (if (or (/= start-nwindows (count-windows t)) | |
| 277 (and (not should-enlarge-minibuffer) | |
| 278 (/= top (nth 1 (window-pixel-edges | |
| 279 start-event-window))))) | |
| 280 (set-window-configuration wconfig)))))))) | |
| 281 | |
| 282 ;; from Bob Weiner (bob_weiner@pts.mot.com) | |
| 283 ;; Whether this function should be called is now decided in | |
| 284 ;; mouse-drag-modeline - dverna feb. 98 | |
| 285 (defun modeline-swap-buffers (event) | |
| 286 "Handle mouse clicks on modeline by switching buffers. | |
| 287 If click on left half of a frame's modeline, bury current buffer. | |
| 288 If click on right half of a frame's modeline, raise bottommost buffer. | |
| 289 Arg EVENT is the button release event that occurred on the modeline." | |
| 290 (or (event-over-modeline-p event) | |
| 291 (error "not over a modeline")) | |
| 292 (or (button-release-event-p event) | |
| 293 (error "not a button release event")) | |
| 294 (if (< (event-x event) (/ (window-width (event-window event)) 2)) | |
| 295 ;; On left half of modeline, bury current buffer, | |
| 296 ;; displaying second buffer on list. | |
| 297 (mouse-bury-buffer event) | |
| 298 ;; On right half of modeline, raise and display bottommost | |
| 299 ;; buffer in buffer list. | |
| 300 (mouse-unbury-buffer event))) | |
| 301 | |
| 302 (defconst modeline-menu | |
| 303 '("Window Commands" | |
| 304 ["Delete Window Above" delete-window t] | |
| 305 ["Delete Other Windows" delete-other-windows t] | |
| 306 ["Split Window Above" split-window-vertically t] | |
| 307 ["Split Window Horizontally" split-window-horizontally t] | |
| 308 ["Balance Windows" balance-windows t] | |
| 309 )) | |
| 310 | |
| 311 (defun modeline-menu (event) | |
| 312 (interactive "e") | |
| 313 (popup-menu-and-execute-in-window | |
| 314 (cons (format "Window Commands for %S:" | |
| 315 (buffer-name (event-buffer event))) | |
| 316 (cdr modeline-menu)) | |
| 317 event)) | |
| 318 | |
| 319 (defvar modeline-map (make-sparse-keymap 'modeline-map) | |
| 320 "Keymap consulted for mouse-clicks on the modeline of a window. | |
| 321 This variable may be buffer-local; its value will be looked up in | |
| 322 the buffer of the window whose modeline was clicked upon.") | |
| 323 | |
| 324 (define-key modeline-map 'button1 'mouse-drag-modeline) | |
| 325 ;; button2 selects the window without setting point | |
| 326 (define-key modeline-map 'button2 (lambda () (interactive "@"))) | |
| 327 (define-key modeline-map 'button3 'modeline-menu) | |
| 328 | |
| 329 (make-face 'modeline-mousable "Face for mousable portions of the modeline.") | |
| 330 (set-face-parent 'modeline-mousable 'modeline nil '(default)) | |
| 331 (when (featurep 'window-system) | |
| 440 | 332 (set-face-foreground 'modeline-mousable "firebrick" nil '(default color win)) |
| 333 (set-face-font 'modeline-mousable [bold] nil '(default mono win)) | |
| 334 (set-face-font 'modeline-mousable [bold] nil '(default grayscale win))) | |
| 428 | 335 |
| 336 (defmacro make-modeline-command-wrapper (command) | |
| 337 `#'(lambda (event) | |
| 338 (interactive "e") | |
| 339 (save-selected-window | |
| 340 (select-window (event-window event)) | |
| 341 (call-interactively ',(eval command))))) | |
| 342 | |
| 343 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 344 ;;; Minor modes ;;; | |
| 345 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 346 | |
| 347 (defvar minor-mode-alist nil | |
| 348 "Alist saying how to show minor modes in the modeline. | |
| 349 Each element looks like (VARIABLE STRING); | |
| 350 STRING is included in the modeline iff VARIABLE's value is non-nil. | |
| 351 | |
| 352 Actually, STRING need not be a string; any possible modeline element | |
| 353 is okay. See `modeline-format'.") | |
| 354 | |
| 355 ;; Used by C code (lookup-key and friends) but defined here. | |
| 356 (defvar minor-mode-map-alist nil | |
| 357 "Alist of keymaps to use for minor modes. | |
| 358 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read | |
| 359 key sequences and look up bindings iff VARIABLE's value is non-nil. | |
| 360 If two active keymaps bind the same key, the keymap appearing earlier | |
| 361 in the list takes precedence.") | |
| 362 | |
| 363 (make-face 'modeline-mousable-minor-mode | |
| 364 "Face for mousable minor-mode strings in the modeline.") | |
| 365 (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil | |
| 366 '(default)) | |
| 367 (when (featurep 'window-system) | |
| 440 | 368 (set-face-foreground 'modeline-mousable-minor-mode '("green4" "forestgreen") |
| 369 nil '(default color win))) | |
| 428 | 370 |
| 371 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil) | |
| 372 ;; alliteration at its finest. | |
| 373 "Extent managing the mousable minor mode modeline strings.") | |
| 374 (set-extent-face modeline-mousable-minor-mode-extent | |
| 375 'modeline-mousable-minor-mode) | |
| 376 | |
| 377 ;; This replaces the idiom | |
| 378 ;; | |
| 379 ;; (or (assq 'isearch-mode minor-mode-alist) | |
| 380 ;; (setq minor-mode-alist | |
| 381 ;; (purecopy | |
| 382 ;; (append minor-mode-alist | |
| 383 ;; '((isearch-mode isearch-mode)))))) | |
| 384 | |
| 385 (defun add-minor-mode (toggle name &optional keymap after toggle-fun) | |
| 386 "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'. | |
| 387 | |
| 388 TOGGLE is a symbol whose value as a variable specifies whether the | |
| 389 minor mode is active. | |
| 390 | |
| 391 NAME is the name that should appear in the modeline. It should either | |
| 392 be a string beginning with a space, or a symbol with a similar string | |
| 393 as its value. | |
| 394 | |
| 395 KEYMAP is a keymap to make active when the minor mode is active. | |
| 396 | |
| 397 AFTER is the toggling symbol used for another minor mode. If AFTER is | |
| 398 non-nil, then it is used to position the new mode in the minor-mode | |
| 399 alists. | |
| 400 | |
| 401 TOGGLE-FUN specifies an interactive function that is called to toggle | |
| 402 the mode on and off; this affects what happens when button2 is pressed | |
| 403 on the mode, and when button3 is pressed somewhere in the list of | |
| 404 modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function, | |
| 405 TOGGLE is used as the toggle function. | |
| 406 | |
| 407 Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" | |
| 408 (let* ((add-elt #'(lambda (elt sym) | |
| 409 (let (place) | |
| 410 (cond ((null after) ; add to front | |
| 411 (push elt (symbol-value sym))) | |
| 412 ((and (not (eq after t)) | |
| 413 (setq place (memq (assq after | |
| 414 (symbol-value sym)) | |
| 415 (symbol-value sym)))) | |
| 416 (push elt (cdr place))) | |
| 417 (t | |
| 418 (set sym (append (symbol-value sym) | |
| 419 (list elt)))))) | |
| 420 (symbol-value sym))) | |
| 421 el toggle-keymap) | |
| 422 (if toggle-fun | |
| 423 (check-argument-type 'commandp toggle-fun) | |
| 424 (when (commandp toggle) | |
| 425 (setq toggle-fun toggle))) | |
| 426 (when (and toggle-fun name) | |
| 427 (setq toggle-keymap (make-sparse-keymap | |
| 428 (intern (concat "modeline-minor-" | |
| 429 (symbol-name toggle) | |
| 430 "-map")))) | |
| 431 (define-key toggle-keymap 'button2 | |
| 432 ;; defeat the DUMB-ASS byte-compiler, which tries to | |
| 433 ;; expand the macro at compile time and fucks up. | |
| 434 (eval '(make-modeline-command-wrapper toggle-fun))) | |
| 435 (put toggle 'modeline-toggle-function toggle-fun)) | |
| 436 (when name | |
| 437 (let ((hacked-name | |
| 438 (if toggle-keymap | |
| 439 (cons (let ((extent (make-extent nil nil))) | |
| 440 (set-extent-keymap extent toggle-keymap) | |
| 441 (set-extent-property | |
| 442 extent 'help-echo | |
| 443 (concat "button2 turns off " | |
| 444 (if (symbolp toggle-fun) | |
| 445 (symbol-name toggle-fun) | |
| 446 (symbol-name toggle)))) | |
| 447 extent) | |
| 448 (cons modeline-mousable-minor-mode-extent name)) | |
| 449 name))) | |
| 450 (if (setq el (assq toggle minor-mode-alist)) | |
| 451 (setcdr el (list hacked-name)) | |
| 438 | 452 (funcall add-elt |
| 428 | 453 (list toggle hacked-name) |
| 454 'minor-mode-alist)))) | |
| 455 (when keymap | |
| 456 (if (setq el (assq toggle minor-mode-map-alist)) | |
| 457 (setcdr el keymap) | |
| 458 (funcall add-elt | |
| 459 (cons toggle keymap) | |
| 460 'minor-mode-map-alist))))) | |
| 461 | |
| 695 | 462 (defcustom abbrev-mode-line-string " Abbrev" |
| 463 "*String to display in the modeline when `abbrev-mode' is active. | |
| 464 Set this to nil if you don't want a modeline indicator." | |
| 465 :type '(choice string | |
| 729 | 466 (const :tag "none" nil)) |
| 467 :group 'abbrev-mode) | |
| 695 | 468 |
| 469 (defcustom overwrite-mode-line-string " Ovwrt" | |
| 470 "*String to display in the modeline when `overwrite-mode' is active. | |
| 471 Set this to nil if you don't want a modeline indicator." | |
| 472 :type '(choice string | |
| 729 | 473 (const :tag "none" nil)) |
| 474 :group 'editing-basics) | |
| 695 | 475 |
| 476 (defcustom auto-fill-mode-line-string " Fill" | |
| 477 "*String to display in the modeline when `auto-fill-mode' is active. | |
| 478 Set this to nil if you don't want a modeline indicator." | |
| 479 :type '(choice string | |
| 729 | 480 (const :tag "none" nil)) |
| 481 :group 'fill) | |
| 695 | 482 |
| 483 (defcustom defining-kbd-macro-mode-line-string " Def" | |
| 484 "*String to display in the modeline when `defining-kbd-macro' is active. | |
| 485 Set this to nil if you don't want a modeline indicator." | |
| 486 :type '(choice string | |
| 729 | 487 (const :tag "none" nil)) |
| 488 :group 'keyboard) | |
| 695 | 489 |
| 428 | 490 ;; #### TODO: Add `:menu-tag' keyword to add-minor-mode. Or create a |
| 491 ;; separate function to manage the minor mode menu. | |
| 492 | |
| 493 ;(put 'abbrev-mode :menu-tag "Abbreviation Expansion") | |
| 695 | 494 (add-minor-mode 'abbrev-mode 'abbrev-mode-line-string) |
| 428 | 495 ;; only when visiting a file... |
| 695 | 496 (add-minor-mode 'overwrite-mode 'overwrite-mode-line-string) |
| 428 | 497 ;(put 'auto-fill-function :menu-tag "Auto Fill") |
| 695 | 498 (add-minor-mode 'auto-fill-function 'auto-fill-mode-line-string |
| 499 nil nil 'auto-fill-mode) | |
| 428 | 500 |
| 501 ;(put 'defining-kbd-macro :menu-tag "Keyboard Macro") | |
| 695 | 502 (add-minor-mode 'defining-kbd-macro 'defining-kbd-macro-mode-line-string |
| 503 nil nil | |
| 428 | 504 (lambda () |
| 505 (interactive) | |
| 506 (if defining-kbd-macro | |
| 507 (progn | |
| 508 ;; #### This means to disregard the last event. | |
| 509 ;; It is needed because the last recorded | |
| 510 ;; event is usually the mouse event that | |
| 511 ;; invoked the menu item (and this function), | |
| 512 ;; and having it in the macro causes problems. | |
| 513 (zap-last-kbd-macro-event) | |
| 514 (end-kbd-macro nil)) | |
| 515 (start-kbd-macro nil)))) | |
| 516 | |
| 517 (defun modeline-minor-mode-menu (event) | |
| 518 "The menu that pops up when you press `button3' inside the | |
| 519 parentheses on the modeline." | |
| 520 (interactive "e") | |
| 521 (save-excursion | |
| 522 (set-buffer (event-buffer event)) | |
| 523 (popup-menu-and-execute-in-window | |
| 524 (cons | |
| 525 "Minor Mode Toggles" | |
| 526 (sort | |
| 527 (delq nil (mapcar | |
| 528 #'(lambda (x) | |
| 529 (let* ((toggle-sym (car x)) | |
| 530 (toggle-fun (or (get toggle-sym | |
| 531 'modeline-toggle-function) | |
| 532 (and (commandp toggle-sym) | |
| 533 toggle-sym))) | |
| 534 (menu-tag (symbol-name (if (symbolp toggle-fun) | |
| 535 toggle-fun | |
| 536 toggle-sym)) | |
| 537 ;; Here a function should | |
| 538 ;; maybe be invoked to | |
| 539 ;; beautify the symbol's | |
| 540 ;; menu appearance. | |
| 541 )) | |
| 542 (and toggle-fun | |
| 543 (vector menu-tag | |
| 544 toggle-fun | |
| 545 ;; The following two are wrong | |
| 546 ;; because of possible name | |
| 547 ;; clashes. | |
| 548 ;:active (get toggle-sym :active t) | |
| 549 ;:included (get toggle-sym :included t) | |
| 550 :style 'toggle | |
| 551 :selected (and (boundp toggle-sym) | |
| 552 toggle-sym))))) | |
| 553 minor-mode-alist)) | |
| 554 (lambda (e1 e2) | |
| 555 (string< (aref e1 0) (aref e2 0))))) | |
| 556 event))) | |
| 557 | |
| 558 (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map) | |
| 559 "Keymap consulted for mouse-clicks on the minor-mode modeline list.") | |
| 560 (define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu) | |
| 561 | |
| 562 (defvar modeline-minor-mode-extent (make-extent nil nil) | |
| 563 "Extent covering the minor mode modeline strings.") | |
| 564 (set-extent-face modeline-minor-mode-extent 'modeline-mousable) | |
| 565 (set-extent-keymap modeline-minor-mode-extent modeline-minor-mode-map) | |
| 566 | |
| 567 | |
| 568 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 771 | 569 ;;; Modeline definition ;;; |
| 428 | 570 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 571 | |
| 771 | 572 (defmacro define-modeline-control (name contents doc-string &optional face |
| 573 help-echo) | |
| 574 "Define a modeline control named NAME, a symbol. | |
| 575 A modeline control is a section of the modeline whose contents can easily | |
| 576 be changed independently of the rest of the modeline, which can have its | |
| 577 own color, and which can have its own mouse commands, which apply when the | |
| 578 mouse is over the control. | |
| 579 | |
| 580 Logically, a modeline control should be an object; but we have terrible | |
| 581 object support in XEmacs, and so history has given us a series of related | |
| 582 variables, which [hopefully] all follow the same conventions. | |
| 583 | |
| 584 Three variables are created: | |
| 585 | |
| 586 1. The variable holding the control specification is called | |
| 587 `modeline-NAME', and is automatically buffer-local. | |
| 588 | |
| 589 2. The variable holding the extent that covers the control area in the | |
| 590 modeline is called `modeline-NAME-extent'. Onto this extent, colors and | |
| 591 keymaps (and possibly glyphs?) can be added, and will be noticed by the | |
| 592 modeline redisplay code. The attachment of the extent and its control | |
| 593 is done somewhere in the modeline specification: either in the main spec | |
| 594 in `modeline-format', or in some other control, like this: | |
| 595 | |
| 596 (cons modeline-NAME-extent 'modeline-NAME) | |
| 597 | |
| 598 3. The keymap holding the mousable commands for the control is called | |
| 599 `modeline-NAME-map'. This is automatically attached to the extent by | |
| 600 this macro. | |
| 601 | |
| 602 Initial contents of the control are CONTENTS (see `modeline-format' for | |
| 603 information about the structure of this contents). DOC-STRING specifies | |
| 604 help text that will be placed in the control variable's documentation, | |
| 605 indicating what's supposed to be in the control. | |
| 606 | |
| 607 Optional argument FACE specifies the face of the control's | |
| 608 extent. (`modeline-mousable' is a good choice if your control is, in fact, | |
| 609 mousable (i.e. it has some mouse commands defined for it). Optional | |
| 610 argument HELP-ECHO specifies some help-echo to be displayed when the mouse | |
| 611 moves over the control, indicating what mouse strokes are available. " | |
| 612 (let ((control-var (intern (format "modeline-%s" name))) | |
| 613 (extent-var (intern (format "modeline-%s-extent" name))) | |
| 614 (map-var (intern (format "modeline-%s-map" name))) | |
| 615 ) | |
| 616 `(progn | |
| 617 (defconst ,control-var ,contents | |
| 618 ,(format "%s | |
| 619 | |
| 620 The format of the contents of this variable is documented in | |
| 621 `modeline-format'. The way the control is displayed can be changed by | |
| 622 setting the face of `%s'. Mouse commands | |
| 623 for the control can be set using `%s'." doc-string extent-var map-var)) | |
| 624 (make-variable-buffer-local ',control-var) | |
| 625 (defvar ,extent-var (make-extent nil nil) | |
| 626 ,(format "Extent covering the `%s' control." control-var)) | |
| 627 (defvar ,map-var (make-sparse-keymap 'modeline-narrowed-map) | |
| 628 ,(format "Keymap consulted for mouse-clicks on the `%s' control." | |
| 629 control-var)) | |
| 630 (set-extent-face ,extent-var ,face) | |
| 631 (set-extent-keymap ,extent-var ,map-var) | |
| 632 (set-extent-property ,extent-var 'help-echo ,help-echo)))) | |
| 633 (put 'define-modeline-control 'lisp-indent-function 2) | |
| 634 | |
| 635 ;; ------------------------ modeline buffer id ------------------- | |
| 636 | |
| 428 | 637 (defun modeline-buffers-menu (event) |
| 638 (interactive "e") | |
| 639 (popup-menu-and-execute-in-window | |
| 640 '("Buffers Popup Menu" | |
| 641 :filter buffers-menu-filter | |
| 642 ["List All Buffers" list-buffers t] | |
| 643 "--" | |
| 644 ) | |
| 645 event)) | |
| 646 | |
| 771 | 647 (define-modeline-control buffer-id-left |
| 648 'modeline-modified-buffer-highlighted-name ;; "XEmacs:" | |
| 649 "Modeline control for left half of buffer ID." | |
| 650 'modeline-mousable | |
| 651 "button2 cycles to the previous buffer") | |
| 428 | 652 |
| 771 | 653 (define-modeline-control buffer-id-right |
| 654 'modeline-modified-buffer-non-highlighted-name ;; " %17b" | |
| 655 "Modeline control for right half of buffer ID." | |
| 656 nil | |
| 657 "button2 cycles to the next buffer") | |
| 428 | 658 |
| 659 (define-key modeline-buffer-id-left-map 'button2 'mouse-unbury-buffer) | |
| 660 (define-key modeline-buffer-id-right-map 'button2 'mouse-bury-buffer) | |
| 661 (define-key modeline-buffer-id-left-map 'button3 'modeline-buffers-menu) | |
| 662 (define-key modeline-buffer-id-right-map 'button3 'modeline-buffers-menu) | |
| 663 | |
| 664 (make-face 'modeline-buffer-id | |
| 665 "Face for the buffer ID string in the modeline.") | |
| 666 (set-face-parent 'modeline-buffer-id 'modeline nil '(default)) | |
| 667 (when (featurep 'window-system) | |
| 440 | 668 (set-face-foreground 'modeline-buffer-id "blue4" nil '(default color win)) |
| 669 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono win)) | |
| 771 | 670 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale |
| 671 win))) | |
| 428 | 672 (when (featurep 'tty) |
| 673 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty))) | |
| 674 | |
| 771 | 675 (define-modeline-control buffer-id |
| 676 (list (cons modeline-buffer-id-left-extent 'modeline-buffer-id-left) | |
| 677 (cons modeline-buffer-id-right-extent 'modeline-buffer-id-right)) | |
| 428 | 678 "Modeline control for identifying the buffer being displayed. |
| 442 | 679 Its default value is |
| 680 | |
| 771 | 681 (list (cons modeline-buffer-id-left-extent 'modeline-buffer-id-left) |
| 682 (cons modeline-buffer-id-right-extent 'modeline-buffer-id-right)) | |
| 442 | 683 |
| 684 Major modes that edit things other than ordinary files may change this | |
| 771 | 685 (e.g. Info, Dired,...)." |
| 686 'modeline-buffer-id) | |
| 687 | |
| 688 (defvaralias 'modeline-buffer-identification 'modeline-buffer-id) | |
| 689 | |
| 690 (defvar modeline-modified-buffer-non-highlighted-name nil) | |
| 691 (make-variable-buffer-local 'modeline-modified-buffer-non-highlighted-name) | |
| 692 (put 'modeline-modified-buffer-non-highlighted-name 'permanent-local t) | |
| 693 | |
| 694 (defvar modeline-modified-buffer-highlighted-name nil) | |
| 695 (make-variable-buffer-local 'modeline-modified-buffer-highlighted-name) | |
| 696 (put 'modeline-modified-buffer-highlighted-name 'permanent-local t) | |
| 697 | |
| 698 (defvar modeline-recorded-buffer-name nil) | |
| 699 (make-variable-buffer-local 'modeline-recorded-buffer-name) | |
| 700 (put 'modeline-recorded-buffer-name 'permanent-local t) | |
| 701 | |
| 702 (defvar modeline-recorded-buffer-file-name nil) | |
| 703 (make-variable-buffer-local 'modeline-recorded-buffer-file-name) | |
| 704 (put 'modeline-recorded-buffer-file-name 'permanent-local t) | |
| 705 | |
| 706 (add-hook 'buffer-list-changed-hook 'modeline-update-buffer-names) | |
| 707 | |
| 708 (defvar modeline-max-buffer-name-size 30) | |
| 709 | |
| 710 (defun modeline-update-buffer-names (frame) | |
| 711 (mapc #'(lambda (buf) | |
| 712 (when (or (not (eq (buffer-name buf) | |
| 713 (symbol-value-in-buffer | |
| 714 'modeline-recorded-buffer-name buf))) | |
| 715 (not (eq (buffer-file-name buf) | |
| 716 (symbol-value-in-buffer | |
| 717 'modeline-recorded-buffer-file-name buf)))) | |
| 718 ;(dp "processing %s" buf) | |
| 719 (with-current-buffer buf | |
| 720 (setq modeline-recorded-buffer-name (buffer-name)) | |
| 721 (setq modeline-recorded-buffer-file-name (buffer-file-name)) | |
| 722 (if (not modeline-recorded-buffer-file-name) | |
| 723 (setq modeline-modified-buffer-non-highlighted-name | |
| 724 modeline-recorded-buffer-name | |
| 725 modeline-modified-buffer-highlighted-name nil) | |
| 726 (let ((fn | |
| 727 (if (<= (length modeline-recorded-buffer-file-name) | |
| 728 modeline-max-buffer-name-size) | |
| 729 modeline-recorded-buffer-file-name | |
| 730 (concat "..." | |
| 731 (substring | |
| 732 modeline-recorded-buffer-file-name | |
| 733 (- modeline-max-buffer-name-size)))))) | |
| 734 (setq modeline-modified-buffer-non-highlighted-name | |
| 735 ;; if the filename is very long, the entire | |
| 736 ;; directory will get truncated to | |
| 737 ;; non-existence. | |
| 738 (let ((dir (file-name-directory fn))) | |
| 739 (if dir | |
| 740 (concat " (" | |
| 741 (directory-file-name | |
| 742 (file-name-directory fn)) | |
| 743 ")") | |
| 744 "")) | |
| 745 modeline-modified-buffer-highlighted-name | |
| 746 (file-name-nondirectory fn)))) | |
| 747 (redraw-modeline)))) | |
| 748 (buffer-list))) | |
| 749 | |
| 750 (defcustom modeline-new-buffer-id-format t | |
| 751 "Whether the new format for the modeline buffer ID (with directory) is used. | |
| 752 This option only has an effect when set using `customize-set-variable', | |
| 753 or through the Options menu." | |
| 754 :group 'modeline | |
| 755 :type 'boolean | |
| 756 :set #'(lambda (var val) | |
| 757 (if val | |
| 758 (progn | |
| 759 (setq-default modeline-buffer-id-left | |
| 760 'modeline-modified-buffer-highlighted-name | |
| 761 modeline-buffer-id-right | |
| 762 'modeline-modified-buffer-non-highlighted-name) | |
| 763 (set-extent-face modeline-buffer-id-left-extent | |
| 764 'modeline-mousable)) | |
| 765 (setq-default modeline-buffer-id-left "XEmacs:" | |
| 766 modeline-buffer-id-right '(" %17b")) | |
| 767 (set-extent-face modeline-buffer-id-left-extent nil)))) | |
| 768 | |
| 769 ;; ------------------------ other modeline controls ------------------- | |
| 428 | 770 |
| 771 ;; These are for the sake of minor mode menu. #### All of this is | |
| 772 ;; kind of dirty. `add-minor-mode' started out as a simple substitute | |
| 773 ;; for (or (assq ...) ...) FSF stuff, but now is used for all kind of | |
| 774 ;; stuff. There should perhaps be a separate function to add toggles | |
| 775 ;; to the minor-mode-menu. | |
| 776 (add-minor-mode 'line-number-mode "") | |
| 777 (add-minor-mode 'column-number-mode "") | |
| 778 | |
| 771 | 779 (define-modeline-control coding-system '("%C") |
| 780 "Modeline control for showing current coding system.") | |
| 781 ;; added March 7, 2002 | |
| 782 (define-obsolete-variable-alias 'modeline-multibyte-status | |
| 783 'modeline-coding-system) | |
| 428 | 784 |
| 771 | 785 (define-modeline-control modified '("--%1*%1+-") |
| 786 "Modeline control for displaying whether current buffer is modified." | |
| 787 'modeline-mousable | |
| 788 "button2 toggles the buffer's read-only status") | |
| 428 | 789 (define-key modeline-modified-map 'button2 |
| 790 (make-modeline-command-wrapper 'modeline-toggle-read-only)) | |
| 791 | |
| 792 ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be | |
| 793 ;;; present, and its symbols are not visible this early in the dump if it | |
| 794 ;;; is. | |
| 795 | |
| 796 (defun modeline-toggle-read-only () | |
| 797 "Change whether this buffer is visiting its file read-only. | |
| 798 With arg, set read-only iff arg is positive. | |
| 799 This function is designed to be called when the read-only indicator on the | |
| 800 modeline is clicked. It will call `vc-toggle-read-only' if available, | |
| 801 otherwise it will call the usual `toggle-read-only'." | |
| 802 (interactive) | |
| 502 | 803 (if-fboundp 'vc-toggle-read-only |
| 428 | 804 (vc-toggle-read-only) |
| 805 (toggle-read-only))) | |
| 806 | |
| 771 | 807 (define-modeline-control line-number (list 'line-number-mode "L%l ") |
| 808 "Modeline control for displaying the line number of point.") | |
| 809 (define-modeline-control column-number (list 'column-number-mode "C%c ") | |
| 810 "Modeline control for displaying the column number of point.") | |
| 811 (define-modeline-control percentage (cons -3 "%p") | |
| 812 "Modeline control for displaying percentage of file above point.") | |
| 813 | |
| 814 (define-modeline-control position-status | |
| 815 (cons 15 (list | |
| 816 (cons modeline-line-number-extent | |
| 817 'modeline-line-number) | |
| 818 (cons modeline-column-number-extent | |
| 819 'modeline-column-number) | |
| 820 (cons modeline-percentage-extent | |
| 821 'modeline-percentage))) | |
| 822 "Modeline control for providing status about the location of point. | |
| 823 Generally includes the line number of point, its column number, and the | |
| 824 percentage of the file above point." | |
| 825 'modeline-buffer-id) | |
| 826 | |
| 827 (defconst modeline-tty-frame-specifier (make-specifier 'boolean)) | |
| 828 (add-hook 'create-frame-hook 'modeline-update-tty-frame-specifier) | |
| 829 (defun modeline-update-tty-frame-specifier (f) | |
| 4043 | 830 (if (and (eq (frame-type f) 'tty) |
| 831 (> (frame-property f 'frame-number) 1)) | |
| 832 (set-specifier modeline-tty-frame-specifier t f))) | |
| 771 | 833 |
| 834 (define-modeline-control tty-frame-id (list modeline-tty-frame-specifier | |
| 835 " [%S]" | |
| 836 ) | |
| 837 "Modeline control for showing which TTY frame is selected.") | |
| 838 | |
| 839 (define-modeline-control narrowed '("%n") | |
| 840 "Modeline control for displaying whether current buffer is narrowed." | |
| 841 'modeline-mousable | |
| 842 "button2 widens the buffer") | |
| 843 (define-key modeline-narrowed-map 'button2 | |
| 844 (make-modeline-command-wrapper 'widen)) | |
| 845 | |
| 846 (define-modeline-control process nil | |
| 847 "Modeline control for displaying info on process status. | |
| 848 Normally nil in most modes, since there is no process to display.") | |
| 849 | |
| 850 (setq-default | |
| 851 modeline-format | |
| 852 (list | |
| 853 "" | |
| 854 (cons modeline-coding-system-extent 'modeline-coding-system) | |
| 855 (cons modeline-modified-extent 'modeline-modified) | |
| 856 (cons modeline-position-status-extent 'modeline-position-status) | |
| 857 (cons modeline-tty-frame-id-extent 'modeline-tty-frame-id) | |
| 858 (cons modeline-buffer-id-extent 'modeline-buffer-id) | |
| 859 " " | |
| 860 'global-mode-string | |
| 861 " %[(" | |
| 862 (cons modeline-minor-mode-extent | |
| 863 (list "" 'mode-name 'minor-mode-alist)) | |
| 864 (cons modeline-narrowed-extent 'modeline-narrowed) | |
| 865 (cons modeline-process-extent 'modeline-process) | |
| 866 ")%]%-")) | |
| 867 | |
| 428 | 868 ;;; modeline.el ends here |