Mercurial > hg > xemacs-beta
annotate lisp/window.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 | bd28481bb0e1 |
| children | f00192e1cd49 308d34e9f07d |
| rev | line source |
|---|---|
| 428 | 1 ;;; window.el --- XEmacs window commands aside from those written in C. |
| 2 | |
| 3 ;; Copyright (C) 1985, 1989, 1993-94, 1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1995, 1996 Ben Wing. | |
| 5 | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: frames, 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 | |
| 22 ;; along with XEmacs; see the file COPYING. If not, write to the | |
| 23 ;; Free Software Foundation, 59 Temple Place - Suite 330, | |
| 24 ;; Boston, MA 02111-1307, USA. | |
| 25 | |
| 26 ;;; Synched up with: Emacs/Mule zeta. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This file is dumped with XEmacs. | |
| 31 | |
| 32 ;;; Code: | |
| 33 | |
| 34 ;;;; Window tree functions. | |
| 35 | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
36 ;; XEmacs addition, to expose WINDOW. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
37 (defun only-window-p (&optional window nomini which-frames which-devices) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
38 "Return non-nil if WINDOW is the only window in some context, |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
39 normally its frame. Optional arg NOMINI non-nil means don't count the |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
40 minibuffer even if it is active. |
| 428 | 41 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
42 The optional argument WHICH-FRAMES changes the frames that are considered: |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
43 |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
44 WHICH-FRAMES nil or omitted means count only WINDOW's frame, |
| 428 | 45 plus the minibuffer it uses (which may be on another frame). |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
46 \(But, for all values of WHICH-FRAMES, see the documentation for the |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
47 WHICH-DEVICES argument.) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
48 WHICH-FRAMES = `visible' means include windows on all visible frames |
| 444 | 49 WHICH-FRAMES = 0 means include windows on all visible and iconified frames. |
| 50 WHICH-FRAMES = t means include windows on all frames including invisible frames. | |
| 51 If WHICH-FRAMES is any other value, count only the selected frame. | |
| 428 | 52 |
| 444 | 53 The optional third argument WHICH-DEVICES further clarifies on which |
| 54 devices to search for frames as specified by WHICH-FRAMES. This value | |
| 55 is only meaningful if WHICH-FRAMES is non-nil. | |
| 56 If nil or omitted, search all devices on the selected console. | |
| 57 If a device, only search that device. | |
| 58 If a console, search all devices on that console. | |
| 59 If a device type, search all devices of that type. | |
| 60 If `window-system', search all devices on window-system consoles. | |
| 61 Any other non-nil value means search all devices." | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
62 (let ((base-window (or window (selected-window)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
63 (if (and nomini (eq base-window |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
64 (minibuffer-window (window-frame base-window)))) |
| 428 | 65 (setq base-window (next-window base-window))) |
| 66 (eq base-window | |
| 444 | 67 (next-window base-window (if nomini 'arg) which-frames which-devices)))) |
| 428 | 68 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
69 (defun one-window-p (&optional nomini which-frames which-devices) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
70 "Return the result of calling `only-window-p' on the selected window. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
71 |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
72 See that function's documentation for the meaning of the NOMINI, |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
73 WHICH-FRAMES and WHICH-DEVICES arguments." |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
74 (only-window-p (selected-window) nomini which-frames which-devices)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
75 |
| 444 | 76 (defun walk-windows (function &optional minibuf which-frames which-devices) |
| 77 "Cycle through all visible windows, calling FUNCTION for each one. | |
| 78 FUNCTION is called with a window as argument. | |
| 428 | 79 |
| 80 Optional second arg MINIBUF t means count the minibuffer window even | |
| 81 if not active. MINIBUF nil or omitted means count the minibuffer iff | |
| 82 it is active. MINIBUF neither t nor nil means not to count the | |
| 83 minibuffer even if it is active. | |
| 84 | |
| 85 Several frames may share a single minibuffer; if the minibuffer | |
| 86 counts, all windows on all frames that share that minibuffer count | |
| 87 too. Therefore, when a separate minibuffer frame is active, | |
| 88 `walk-windows' includes the windows in the frame from which you | |
| 89 entered the minibuffer, as well as the minibuffer window. But if the | |
| 444 | 90 minibuffer does not count, only the selected window counts. |
| 428 | 91 |
| 444 | 92 By default, only the windows in the selected frame are included. |
| 93 The optional argument WHICH-FRAMES changes this behavior: | |
| 94 WHICH-FRAMES nil or omitted means cycle within the frames as specified above. | |
| 95 WHICH-FRAMES = `visible' means include windows on all visible frames. | |
| 96 WHICH-FRAMES = 0 means include windows on all visible and iconified frames. | |
| 97 WHICH-FRAMES = t means include windows on all frames including invisible frames. | |
| 428 | 98 Anything else means restrict to WINDOW's frame. |
| 99 | |
| 444 | 100 The optional fourth argument WHICH-DEVICES further clarifies on which |
| 101 devices to search for frames as specified by WHICH-FRAMES. This value | |
| 102 is only meaningful if WHICH-FRAMES is non-nil. | |
| 103 If nil or omitted, search all devices on the selected console. | |
| 104 If a device, only search that device. | |
| 105 If a console, search all devices on that console. | |
| 106 If a device type, search all devices of that type. | |
| 107 If `window-system', search all devices on window-system consoles. | |
| 108 Any other non-nil value means search all devices." | |
| 428 | 109 ;; If we start from the minibuffer window, don't fail to come back to it. |
| 1279 | 110 (let ((arg (cond |
| 111 ((framep which-frames) which-frames) | |
| 112 ((devicep which-devices) which-devices) | |
| 113 (t nil)))) | |
| 114 (if (window-minibuffer-p (selected-window arg)) | |
| 115 (setq minibuf t)) | |
| 116 ;; Note that, like next-window & previous-window, this behaves a little | |
| 117 ;; strangely if the selected window is on an invisible frame: it hits | |
| 118 ;; some of the windows on that frame, and all windows on visible frames. | |
| 119 (let* ((walk-windows-start (selected-window arg)) | |
| 120 (walk-windows-current walk-windows-start)) | |
| 121 (while (progn | |
| 122 (setq walk-windows-current | |
| 123 (next-window walk-windows-current minibuf which-frames | |
| 124 which-devices)) | |
| 125 (funcall function walk-windows-current) | |
| 126 (not (eq walk-windows-current walk-windows-start))))))) | |
| 428 | 127 ;; The old XEmacs definition of the above clause. It's more correct in |
| 128 ;; that it will never hit a window that's already been hit even if you | |
| 129 ;; do something odd like `delete-other-windows', but has the problem | |
| 130 ;; that it conses. (This may be called repeatedly, from lazy-lock | |
| 131 ;; for example.) | |
| 132 ; (let* ((walk-windows-history nil) | |
| 133 ; (walk-windows-current (selected-window))) | |
| 134 ; (while (progn | |
| 135 ; (setq walk-windows-current | |
| 444 | 136 ; (next-window walk-windows-current minibuf which-frames |
| 137 ; which-devices)) | |
| 428 | 138 ; (not (memq walk-windows-current walk-windows-history))) |
| 139 ; (setq walk-windows-history (cons walk-windows-current | |
| 140 ; walk-windows-history)) | |
| 444 | 141 ; (funcall function walk-windows-current)))) |
| 428 | 142 |
| 800 | 143 (defun get-window-with-predicate (predicate &optional minibuf |
| 144 all-frames default) | |
| 145 "Return a window satisfying PREDICATE. | |
| 146 | |
| 147 This function cycles through all visible windows using `walk-windows', | |
| 148 calling PREDICATE on each one. PREDICATE is called with a window as | |
| 149 argument. The first window for which PREDICATE returns a non-nil | |
| 150 value is returned. If no window satisfies PREDICATE, DEFAULT is | |
| 151 returned. | |
| 152 | |
| 153 Optional second arg MINIBUF t means count the minibuffer window even | |
| 154 if not active. MINIBUF nil or omitted means count the minibuffer iff | |
| 155 it is active. MINIBUF neither t nor nil means not to count the | |
| 156 minibuffer even if it is active. | |
| 157 | |
| 158 Several frames may share a single minibuffer; if the minibuffer | |
| 159 counts, all windows on all frames that share that minibuffer count | |
| 160 too. Therefore, if you are using a separate minibuffer frame | |
| 161 and the minibuffer is active and MINIBUF says it counts, | |
| 162 `walk-windows' includes the windows in the frame from which you | |
| 163 entered the minibuffer, as well as the minibuffer window. | |
| 164 | |
| 165 ALL-FRAMES is the optional third argument. | |
| 166 ALL-FRAMES nil or omitted means cycle within the frames as specified above. | |
| 167 ALL-FRAMES = `visible' means include windows on all visible frames. | |
| 168 ALL-FRAMES = 0 means include windows on all visible and iconified frames. | |
| 169 ALL-FRAMES = t means include windows on all frames including invisible frames. | |
| 170 If ALL-FRAMES is a frame, it means include windows on that frame. | |
| 171 Anything else means restrict to the selected frame." | |
| 172 (catch 'found | |
| 173 (walk-windows #'(lambda (window) | |
| 174 (when (funcall predicate window) | |
| 175 (throw 'found window))) | |
| 176 minibuf all-frames) | |
| 177 default)) | |
| 178 | |
| 179 (defalias 'some-window 'get-window-with-predicate) | |
| 180 | |
| 428 | 181 (defun minibuffer-window-active-p (window) |
| 182 "Return t if WINDOW (a minibuffer window) is now active." | |
| 183 (eq window (active-minibuffer-window))) | |
| 184 | |
| 185 (defmacro save-selected-window (&rest body) | |
| 460 | 186 "Execute BODY, then select the window that was selected before BODY. |
| 187 The value returned is the value of the last form in BODY." | |
| 188 (let ((old-window (gensym "ssw"))) | |
| 189 `(let ((,old-window (selected-window))) | |
| 442 | 190 (unwind-protect |
| 191 (progn ,@body) | |
| 460 | 192 (when (window-live-p ,old-window) |
| 193 (select-window ,old-window)))))) | |
| 442 | 194 |
| 195 (defmacro with-selected-window (window &rest body) | |
| 196 "Execute forms in BODY with WINDOW as the selected window. | |
| 197 The value returned is the value of the last form in BODY." | |
| 198 `(save-selected-window | |
| 199 (select-window ,window) | |
| 200 ,@body)) | |
| 428 | 201 |
| 1133 | 202 (defmacro save-window-excursion (&rest body) |
| 203 "Execute body, preserving window sizes and contents. | |
| 204 Restores which buffer appears in which window, where display starts, | |
| 205 as well as the current buffer. | |
| 206 Does not restore the value of point in current buffer." | |
| 207 (let ((window-config (gensym 'window-config))) | |
| 208 `(let ((,window-config (current-window-configuration))) | |
| 209 (unwind-protect | |
| 210 (progn ,@body) | |
| 211 (set-window-configuration ,window-config))))) | |
| 212 | |
| 428 | 213 (defun count-windows (&optional minibuf) |
| 214 "Return the number of visible windows. | |
| 800 | 215 This counts the windows in the selected frame and (if the minibuffer is |
| 216 to be counted) its minibuffer frame (if that's not the same frame). | |
| 217 The optional arg MINIBUF non-nil means count the minibuffer | |
| 428 | 218 even if it is inactive." |
| 219 (let ((count 0)) | |
| 220 (walk-windows (function (lambda (w) | |
| 221 (setq count (+ count 1)))) | |
| 222 minibuf) | |
| 223 count)) | |
| 224 | |
| 800 | 225 (defun window-safely-shrinkable-p (&optional window) |
| 226 "Non-nil if the WINDOW can be shrunk without shrinking other windows. | |
| 227 If WINDOW is nil or omitted, it defaults to the currently selected window." | |
| 228 (save-selected-window | |
| 229 (when window (select-window window)) | |
| 230 (or (and (not (eq window (frame-first-window))) | |
| 231 (= (car (window-pixel-edges)) | |
| 232 (car (window-pixel-edges (previous-window))))) | |
| 233 (= (car (window-pixel-edges)) | |
| 234 (car (window-pixel-edges (next-window))))))) | |
| 235 | |
| 428 | 236 (defun balance-windows () |
| 237 "Make all visible windows the same height (approximately)." | |
| 238 (interactive) | |
| 239 (let ((count -1) levels newsizes size) | |
| 240 ;FSFmacs | |
| 241 ;;; Don't count the lines that are above the uppermost windows. | |
| 242 ;;; (These are the menu bar lines, if any.) | |
| 243 ;(mbl (nth 1 (window-edges (frame-first-window (selected-frame)))))) | |
| 244 ;; Find all the different vpos's at which windows start, | |
| 245 ;; then count them. But ignore levels that differ by only 1. | |
| 246 (save-window-excursion | |
| 247 (let (tops (prev-top -2)) | |
| 248 (walk-windows (function (lambda (w) | |
| 249 (setq tops (cons (nth 1 (window-pixel-edges w)) | |
| 250 tops)))) | |
| 251 'nomini) | |
| 252 (setq tops (sort tops '<)) | |
| 253 (while tops | |
| 254 (if (> (car tops) (1+ prev-top)) | |
| 255 (setq prev-top (car tops) | |
| 256 count (1+ count))) | |
| 257 (setq levels (cons (cons (car tops) count) levels)) | |
| 258 (setq tops (cdr tops))) | |
| 259 (setq count (1+ count)))) | |
| 260 ;; Subdivide the frame into that many vertical levels. | |
| 261 ;FSFmacs (setq size (/ (- (frame-height) mbl) count)) | |
| 262 (setq size (/ (window-pixel-height (frame-root-window)) count)) | |
| 263 (walk-windows (function | |
| 264 (lambda (w) | |
| 265 (select-window w) | |
| 266 (let ((newtop (cdr (assq (nth 1 (window-pixel-edges)) | |
| 267 levels))) | |
| 268 (newbot (or (cdr (assq | |
| 269 (+ (window-pixel-height) | |
| 270 (nth 1 (window-pixel-edges))) | |
| 271 levels)) | |
| 272 count))) | |
| 273 (setq newsizes | |
| 274 (cons (cons w (* size (- newbot newtop))) | |
| 275 newsizes))))) | |
| 276 'nomini) | |
| 277 (walk-windows (function (lambda (w) | |
| 278 (select-window w) | |
| 279 (let ((newsize (cdr (assq w newsizes)))) | |
| 280 (enlarge-window | |
| 281 (/ (- newsize (window-pixel-height)) | |
| 282 (face-height 'default)))))) | |
| 283 'nomini))) | |
| 284 | |
| 285 ;;; I think this should be the default; I think people will prefer it--rms. | |
| 286 (defcustom split-window-keep-point t | |
| 287 "*If non-nil, split windows keeps the original point in both children. | |
| 288 This is often more convenient for editing. | |
| 289 If nil, adjust point in each of the two windows to minimize redisplay. | |
| 290 This is convenient on slow terminals, but point can move strangely." | |
| 291 :type 'boolean | |
| 292 :group 'windows) | |
| 293 | |
| 294 (defun split-window-vertically (&optional arg) | |
| 295 "Split current window into two windows, one above the other. | |
| 296 The uppermost window gets ARG lines and the other gets the rest. | |
| 297 Negative arg means select the size of the lowermost window instead. | |
| 298 With no argument, split equally or close to it. | |
| 299 Both windows display the same buffer now current. | |
| 300 | |
| 730 | 301 If the variable `split-window-keep-point' is non-nil, both new windows |
| 428 | 302 will get the same value of point as the current window. This is often |
| 303 more convenient for editing. | |
| 304 | |
| 444 | 305 Otherwise, we choose window starts so as to minimize the amount of |
| 428 | 306 redisplay; this is convenient on slow terminals. The new selected |
| 307 window is the one that the current value of point appears in. The | |
| 308 value of point can change if the text around point is hidden by the | |
| 309 new mode line. | |
| 310 | |
| 311 Programs should probably use split-window instead of this." | |
| 312 (interactive "P") | |
| 313 (let ((old-w (selected-window)) | |
| 314 (old-point (point)) | |
| 315 (size (and arg (prefix-numeric-value arg))) | |
| 316 (window-full-p nil) | |
| 317 new-w bottom moved) | |
| 318 (and size (< size 0) (setq size (+ (window-height) size))) | |
| 319 (setq new-w (split-window nil size)) | |
| 320 (or split-window-keep-point | |
| 321 (progn | |
| 322 (save-excursion | |
| 323 (set-buffer (window-buffer)) | |
| 324 (goto-char (window-start)) | |
| 325 (setq moved (vertical-motion (window-height))) | |
| 326 (set-window-start new-w (point)) | |
| 327 (if (> (point) (window-point new-w)) | |
| 328 (set-window-point new-w (point))) | |
| 329 (and (= moved (window-height)) | |
| 330 (progn | |
| 331 (setq window-full-p t) | |
| 332 (vertical-motion -1))) | |
| 333 (setq bottom (point))) | |
| 334 (and window-full-p | |
| 335 (<= bottom (point)) | |
| 336 (set-window-point old-w (1- bottom))) | |
| 337 (and window-full-p | |
| 338 (<= (window-start new-w) old-point) | |
| 339 (progn | |
| 340 (set-window-point new-w old-point) | |
| 341 (select-window new-w))))) | |
| 342 new-w)) | |
| 343 | |
| 344 (defun split-window-horizontally (&optional arg) | |
| 345 "Split current window into two windows side by side. | |
| 346 This window becomes the leftmost of the two, and gets ARG columns. | |
| 347 Negative arg means select the size of the rightmost window instead. | |
| 348 No arg means split equally." | |
| 349 (interactive "P") | |
| 350 (let ((size (and arg (prefix-numeric-value arg)))) | |
| 351 (and size (< size 0) | |
| 352 (setq size (+ (window-width) size))) | |
| 353 (split-window nil size t))) | |
| 354 | |
| 355 (defun enlarge-window-horizontally (arg) | |
| 356 "Make current window ARG columns wider." | |
| 357 (interactive "p") | |
| 358 (enlarge-window arg t)) | |
| 359 | |
| 360 (defun shrink-window-horizontally (arg) | |
| 361 "Make current window ARG columns narrower." | |
| 362 (interactive "p") | |
| 363 (shrink-window arg t)) | |
| 364 | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
365 (defun window-buffer-height (window) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
366 "Return the height (in screen lines) of the buffer that WINDOW is displaying." |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
367 (with-current-buffer (window-buffer window) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
368 (max 1 |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
369 (count-screen-lines (point-min) (point-max) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
370 ;; If buffer ends with a newline, ignore it when |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
371 ;; counting height unless point is after it. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
372 (eobp) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
373 window)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
374 ;; XEmacs change; accept BUFFER. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
375 (defun count-screen-lines (&optional beg end count-final-newline |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
376 window buffer) |
| 800 | 377 "Return the number of screen lines in the region. |
| 378 The number of screen lines may be different from the number of actual lines, | |
| 379 due to line breaking, display table, etc. | |
| 380 | |
| 381 Optional arguments BEG and END default to `point-min' and `point-max' | |
| 382 respectively. | |
| 383 | |
| 384 If region ends with a newline, ignore it unless optional third argument | |
| 385 COUNT-FINAL-NEWLINE is non-nil. | |
| 386 | |
| 387 The optional fourth argument WINDOW specifies the window used for obtaining | |
| 388 parameters such as width, horizontal scrolling, and so on. The default is | |
| 389 to use the selected window's parameters. | |
| 390 | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
391 Optional argument BUFFER is the buffer to check, and defaults to the current |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
392 buffer. See `vertical-motion' for some caveats on the differences between |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
393 this behaviour and that of GNU Emacs." |
| 800 | 394 (unless beg |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
395 (setq beg (point-min buffer))) |
| 800 | 396 (unless end |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
397 (setq end (point-max buffer))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
398 (unless buffer |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
399 (setq buffer (current-buffer))) |
| 800 | 400 (if (= beg end) |
| 401 0 | |
| 402 (save-excursion | |
| 403 (save-restriction | |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
404 (let ((old-window-buffer (window-buffer window))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
405 (unwind-protect |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
406 (progn |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
407 (set-window-buffer window buffer) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
408 (set-buffer buffer) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
409 (widen) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
410 (narrow-to-region (min beg end) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
411 (if (and (not count-final-newline) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
412 (= ?\n (char-before (max beg end)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
413 (1- (max beg end)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
414 (max beg end))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
415 (goto-char (point-min)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
416 (1+ (vertical-motion (buffer-size) window))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
417 (set-window-buffer window old-window-buffer))))))) |
| 800 | 418 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
419 (defun fit-window-to-buffer (&optional window max-height min-height) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
420 "Make WINDOW the right height to display its contents exactly. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
421 If WINDOW is omitted or nil, it defaults to the selected window. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
422 If the optional argument MAX-HEIGHT is supplied, it is the maximum height |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
423 the window is allowed to be, defaulting to the frame height. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
424 If the optional argument MIN-HEIGHT is supplied, it is the minimum |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
425 height the window is allowed to be, defaulting to `window-min-height'. |
| 800 | 426 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
427 The heights in MAX-HEIGHT and MIN-HEIGHT include the mode-line and/or |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
428 header-line." |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
429 (interactive) |
| 800 | 430 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
431 (when (null window) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
432 (setq window (selected-window))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
433 (when (null max-height) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
434 (setq max-height (frame-height (window-frame window)))) |
| 800 | 435 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
436 (let* ((buf |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
437 ;; Buffer that is displayed in WINDOW |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
438 (window-buffer window)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
439 (window-height |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
440 ;; The current height of WINDOW |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
441 (window-height window)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
442 (desired-height |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
443 ;; The height necessary to show the buffer displayed by WINDOW |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
444 ;; (`count-screen-lines' always works on the current buffer). |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
445 ;; XEmacs; it does in GNU, we provide a BUFFER argument, but we're |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
446 ;; not changing the implementation. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
447 (with-current-buffer buf |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
448 (+ (count-screen-lines) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
449 ;; If the buffer is empty, (count-screen-lines) is |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
450 ;; zero. But, even in that case, we need one text line |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
451 ;; for cursor. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
452 (if (= (point-min) (point-max)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
453 1 0) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
454 ;; For non-minibuffers, count the mode-line, if any |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
455 (if (and (not (window-minibuffer-p window)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
456 mode-line-format) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
457 1 0) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
458 ;; Count the header-line, if any |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
459 ;; XEmacs change; we don't have header-line-format. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
460 ;; (if header-line-format 1 0)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
461 (if (specifier-instance top-gutter) 1 0)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
462 (delta |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
463 ;; Calculate how much the window height has to change to show |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
464 ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
465 (- (max (min desired-height max-height) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
466 (or min-height window-min-height)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
467 window-height))) |
| 800 | 468 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
469 ;; Don't try to redisplay with the cursor at the end |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
470 ;; on its own line--that would force a scroll and spoil things. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
471 (when (with-current-buffer buf |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
472 (and (eobp) (bolp) (not (bobp)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
473 (set-window-point window (1- (window-point window)))) |
| 800 | 474 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
475 ;; Adjust WINDOW to the nominally correct size (which may actually |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
476 ;; be slightly off because of variable height text, etc). |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
477 (unless (zerop delta) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
478 (enlarge-window delta nil window)) |
| 800 | 479 |
|
4506
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
480 ;; Check if the last line is surely fully visible. If not, |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
481 ;; enlarge the window. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
482 (let ((end (with-current-buffer buf |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
483 (save-excursion |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
484 (goto-char (point-max)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
485 (when (and (bolp) (not (bobp))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
486 ;; Don't include final newline |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
487 (backward-char 1)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
488 (when truncate-lines |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
489 ;; If line-wrapping is turned off, test the |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
490 ;; beginning of the last line for visibility |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
491 ;; instead of the end, as the end of the line |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
492 ;; could be invisible by virtue of extending past |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
493 ;; the edge of the window. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
494 (forward-line 0)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
495 (point)))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
496 ;; XEmacs change; bind window-pixel-vscroll-increment, we don't |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
497 ;; have #'set-window-vscroll. |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
498 (window-pixel-scroll-increment 0)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
499 ; (set-window-vscroll window 0) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
500 (while (and (< desired-height max-height) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
501 (= desired-height (window-height window)) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
502 (not (pos-visible-in-window-p end window))) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
503 (enlarge-window 1 nil window) |
|
bd28481bb0e1
Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1279
diff
changeset
|
504 (setq desired-height (1+ desired-height)))))) |
| 800 | 505 |
| 428 | 506 (defun shrink-window-if-larger-than-buffer (&optional window) |
| 507 "Shrink the WINDOW to be as small as possible to display its contents. | |
| 508 Do not shrink to less than `window-min-height' lines. | |
| 509 Do nothing if the buffer contains more lines than the present window height, | |
| 510 or if some of the window's contents are scrolled out of view, | |
| 511 or if the window is not the full width of the frame, | |
| 512 or if the window is the only window of its frame." | |
| 513 (interactive) | |
| 514 (or window (setq window (selected-window))) | |
| 515 (save-excursion | |
| 516 (set-buffer (window-buffer window)) | |
| 1127 | 517 (let ((test-pos |
| 428 | 518 (- (point-max) |
| 519 ;; If buffer ends with a newline, ignore it when counting | |
| 520 ;; height unless point is after it. | |
| 521 (if (and (not (eobp)) | |
| 522 (eq ?\n (char-after (1- (point-max))))) | |
| 523 1 0))) | |
| 442 | 524 (mini (frame-property (window-frame window) 'minibuffer))) |
| 428 | 525 (if (and (< 1 (let ((frame (selected-frame))) |
| 526 (select-frame (window-frame window)) | |
| 527 (unwind-protect | |
| 528 (count-windows) | |
| 529 (select-frame frame)))) | |
| 530 ;; check to make sure that the window is the full width | |
| 531 ;; of the frame | |
| 440 | 532 (window-leftmost-p window) |
| 533 (window-rightmost-p window) | |
| 428 | 534 ;; The whole buffer must be visible. |
| 535 (pos-visible-in-window-p (point-min) window) | |
| 536 ;; The frame must not be minibuffer-only. | |
| 537 (not (eq mini 'only))) | |
| 538 (progn | |
| 1127 | 539 (goto-char (point-min)) |
| 540 (while (and (pos-visible-in-window-p test-pos window) | |
| 541 (> (window-height window) window-min-height)) | |
| 542 (shrink-window 1 nil window)) | |
| 543 (if (not (pos-visible-in-window-p test-pos window)) | |
| 544 (enlarge-window 1 nil window))))))) | |
| 428 | 545 |
| 546 (defun kill-buffer-and-window () | |
| 547 "Kill the current buffer and delete the selected window." | |
| 548 (interactive) | |
| 549 (if (yes-or-no-p (format "Kill buffer `%s'? " (buffer-name))) | |
| 550 (let ((buffer (current-buffer))) | |
| 551 (delete-window (selected-window)) | |
| 552 (kill-buffer buffer)) | |
| 553 (error "Aborted"))) | |
| 554 | |
| 730 | 555 (defun quit-window (&optional kill window) |
| 556 "Quit the current buffer. Bury it, and maybe delete the selected frame. | |
| 557 \(The frame is deleted if it is contains a dedicated window for the buffer.) | |
| 558 With a prefix argument, kill the buffer instead. | |
| 559 | |
| 560 Noninteractively, if KILL is non-nil, then kill the current buffer, | |
| 561 otherwise bury it. | |
| 428 | 562 |
| 730 | 563 If WINDOW is non-nil, it specifies a window; we delete that window, |
| 564 and the buffer that is killed or buried is the one in that window." | |
| 565 (interactive "P") | |
| 566 (let ((buffer (window-buffer window)) | |
| 567 (frame (window-frame (or window (selected-window)))) | |
| 568 (window-solitary | |
| 569 (save-selected-window | |
| 570 (if window | |
| 571 (select-window window)) | |
| 572 (one-window-p t))) | |
| 573 window-handled) | |
| 444 | 574 |
| 730 | 575 (save-selected-window |
| 576 (if window | |
| 577 (select-window window)) | |
| 578 (or (window-minibuffer-p) | |
| 579 (window-dedicated-p (selected-window)) | |
| 580 (switch-to-buffer (other-buffer)))) | |
| 581 | |
| 582 ;; Get rid of the frame, if it has just one dedicated window | |
| 583 ;; and other visible frames exist. | |
| 584 (and (or (window-minibuffer-p) (window-dedicated-p window)) | |
| 585 (delq frame (visible-frame-list)) | |
| 586 window-solitary | |
| 587 (if (and (eq default-minibuffer-frame frame) | |
| 588 (= 1 (length (minibuffer-frame-list)))) | |
| 589 (setq window nil) | |
| 590 (delete-frame frame) | |
| 591 (setq window-handled t))) | |
| 592 | |
| 593 ;; Deal with the buffer. | |
| 594 (if kill | |
| 595 (kill-buffer buffer) | |
| 596 (bury-buffer buffer)) | |
| 597 | |
| 598 ;; Maybe get rid of the window. | |
| 599 (and window (not window-handled) (not window-solitary) | |
| 600 (delete-window window)))) | |
| 428 | 601 |
| 602 ;;; window.el ends here |