Index: lisp/buffer.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/buffer.el,v retrieving revision 1.3.2.1 diff -u -r1.3.2.1 buffer.el --- lisp/buffer.el 1999/01/18 22:04:11 1.3.2.1 +++ lisp/buffer.el 1999/07/18 17:01:34 @@ -32,6 +32,9 @@ ;;; Code: +(defvar switch-to-buffer-hooks nil + "Hooks to run after a recorded buffer switch.") + (defun switch-to-buffer (bufname &optional norecord) "Select buffer BUFNAME in the current window. BUFNAME may be a buffer or a buffer name and is created if it did not exist. @@ -65,6 +68,8 @@ (next-window (minibuffer-window)) (selected-window)) buf) + ;; XEmacs change + (or norecord (run-hook-with-args 'switch-to-buffer-hooks buf)) buf)) (defun pop-to-buffer (bufname &optional not-this-window-p on-frame) Index: lisp/dumped-lisp.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/dumped-lisp.el,v retrieving revision 1.30.2.7 diff -u -r1.30.2.7 dumped-lisp.el --- lisp/dumped-lisp.el 1999/06/03 09:50:01 1.30.2.7 +++ lisp/dumped-lisp.el 1999/07/18 17:01:34 @@ -164,6 +164,7 @@ (when-feature (and (not infodock) (or x mswindows) menubar) "menubar-items") (when-feature (and infodock (or x mswindows) menubar) "id-menus") + (when-feature gutter "gutter-items") (when-feature x "x-faces") (when-feature x "x-iso8859-1") (when-feature x "x-mouse") Index: lisp/gutter-items.el =================================================================== RCS file: gutter-items.el diff -N gutter-items.el --- /dev/null Sun Jul 18 06:26:52 1999 +++ lisp/gutter-items.el Sun Jul 18 10:01:34 1999 @@ -0,0 +1,158 @@ +;;; gutter-items.el --- Gutter content for XEmacs. + +;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999 Andy Piper. + +;; Maintainer: XEmacs Development Team +;; Keywords: frames, extensions, internal, dumped + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Xmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; Some of this is taken from the buffer-menu stuff in menubar-items.el +;; and the custom specs in toolbar.el. + +(defgroup gutter nil + "Input from the gutters." + :group 'environment) + +(defcustom gutter-visible-p + (specifier-instance default-gutter-visible-p) + "Whether the default gutter is globally visible. This option can be +customized through the options menu." + :group 'display + :type 'boolean + :set #'(lambda (var val) + (set-specifier default-gutter-visible-p val) + (setq gutter-visible-p val))) + +(defcustom default-gutter-position + (default-gutter-position) + "The location of the default gutter. It can be 'top, 'bottom, 'left or +'right. This option can be customized through the options menu." + :group 'display + :type '(choice (const :tag "top" 'top) + (const :tag "bottom" 'bottom) + (const :tag "left" 'left) + (const :tag "right" 'right)) + :set #'(lambda (var val) + (set-default-gutter-position val) + (setq default-gutter-position val))) + +;;; The Buffers tab + +(defgroup buffers-tab nil + "Customization of `Buffers' tab." + :group 'gutter) + +(defvar gutter-buffers-tab nil + "A tab widget in the gutter for displaying buffers. +Do not set this. Use `glyph-image-instance' and +`set-image-instance-property' to change the properties of the tab.") + +(defcustom buffers-tab-max-size 6 + "*Maximum number of entries which may appear on the \"Buffers\" tab. +If this is 10, then only the ten most-recently-selected buffers will be +shown. If this is nil, then all buffers will be shown. Setting this to +a large number or nil will slow down tab responsiveness." + :type '(choice (const :tag "Show all" nil) + (integer 10)) + :group 'buffers-tab) + +(defcustom buffers-tab-switch-to-buffer-function 'buffers-tab-switch-to-buffer + "*The function to call to select a buffer from the buffers tab. +`switch-to-buffer' is a good choice, as is `pop-to-buffer'." + :type '(radio (function-item switch-to-buffer) + (function-item pop-to-buffer) + (function :tag "Other")) + :group 'buffers-tab) + +(defcustom buffers-tab-omit-function 'buffers-menu-omit-invisible-buffers + "*If non-nil, a function specifying the buffers to omit from the buffers menu. +This is passed a buffer and should return non-nil if the buffer should be +omitted. The default value `buffers-tab-omit-invisible-buffers' omits +buffers that are normally considered \"invisible\" (those whose name +begins with a space)." + :type '(choice (const :tag "None" nil) + function) + :group 'buffers-tab) + +(defcustom buffers-tab-format-buffer-line-function 'format-buffers-menu-line + "*The function to call to return a string to represent a buffer in the +buffers menu. The function is passed a buffer and should return a string. +The default value `format-buffers-menu-line' just returns the name of +the buffer. Also check out `slow-format-buffers-menu-line' which +returns a whole bunch of info about a buffer." + :type 'function + :group 'buffers-tab) + +(defun buffers-tab-switch-to-buffer (buffer) + "For use as a value for `buffers-tab-switch-to-buffer-function'." + (switch-to-buffer buffer t)) + +(defsubst build-buffers-tab-internal (buffers) + (let (line) + (mapcar + #'(lambda (buffer) + (setq line (funcall buffers-tab-format-buffer-line-function + buffer)) + (vector line (list buffers-tab-switch-to-buffer-function + (buffer-name buffer)))) + buffers))) + +(defun buffers-tab-items () + "This is the tab filter for the top-level buffers \"Buffers\" tab. +It dynamically creates a list of buffers to use as the contents of the tab. +Only the most-recently-used few buffers will be listed on the tab, for +efficiency reasons. You can control how many buffers will be shown by +setting `buffers-tab-max-size'. You can control the text of the menu +items by redefining the function `format-buffers-menu-line'." + (let ((buffers (delete-if buffers-tab-omit-function (buffer-list)))) + (and (integerp buffers-tab-max-size) + (> buffers-tab-max-size 1) + (> (length buffers) buffers-tab-max-size) + ;; shorten list of buffers (not with submenus!) + (setcdr (nthcdr buffers-tab-max-size buffers) nil)) + (setq buffers (build-buffers-tab-internal buffers)) + buffers)) + +(defun add-tab-to-gutter () + "Put a tab control in the gutter area to hold the most recent buffers." + (let ((gutter-string "")) + (set-extent-begin-glyph + (make-extent 0 0 gutter-string) + (setq gutter-buffers-tab + (make-glyph + (vector 'tab-control :descriptor "Buffers" + :properties (list :items (buffers-tab-items)))))) + ;; This looks better than a 3d border + (set-specifier default-gutter-border-width 0) + (set-specifier default-gutter gutter-string))) + +(defun update-tab-in-gutter (&optional notused) + "Update the tab control in the gutter area." + (set-image-instance-property (glyph-image-instance gutter-buffers-tab) + :items + (buffers-tab-items)) + (resize-subwindow (glyph-image-instance gutter-buffers-tab) + (gutter-pixel-width) nil)) + +(add-tab-to-gutter) +(add-hook 'switch-to-buffer-hooks 'update-tab-in-gutter) + +(provide 'gutter-items) +;;; gutter-items.el ends here. Index: lisp/menubar-items.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/menubar-items.el,v retrieving revision 1.6.2.10 diff -u -r1.6.2.10 menubar-items.el --- lisp/menubar-items.el 1999/07/05 02:21:04 1.6.2.10 +++ lisp/menubar-items.el 1999/07/18 17:01:41 @@ -737,6 +737,32 @@ :selected (eq default-toolbar-position 'right)] ) ))) + ,@(if (featurep 'gutter) + '(("Gutter Appearance" + ["Visible" + (customize-set-variable 'gutter-visible-p + (not gutter-visible-p)) + :style toggle + :selected gutter-visible-p] + ("Default Location" + ["Top" + (customize-set-variable 'default-gutter-position 'top) + :style radio + :selected (eq default-gutter-position 'top)] + ["Bottom" + (customize-set-variable 'default-gutter-position 'bottom) + :style radio + :selected (eq default-gutter-position 'bottom)] + ["Left" + (customize-set-variable 'default-gutter-position 'left) + :style radio + :selected (eq default-gutter-position 'left)] + ["Right" + (customize-set-variable 'default-gutter-position 'right) + :style radio + :selected (eq default-gutter-position 'right)] + ) + ))) ("Mouse" ["Avoid Text..." (customize-set-variable 'mouse-avoidance-mode Index: lisp/toolbar.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/toolbar.el,v retrieving revision 1.8.2.1 diff -u -r1.8.2.1 toolbar.el --- lisp/toolbar.el 1998/12/05 16:54:52 1.8.2.1 +++ lisp/toolbar.el 1999/07/18 17:01:41 @@ -54,7 +54,7 @@ (defcustom default-toolbar-position ;; added for the options menu - dverna (default-toolbar-position) - "The location of the default toolbar. It can be 'top, 'bootom, 'left or + "The location of the default toolbar. It can be 'top, 'bottom, 'left or 'right. This option can be customized through the options menu." :group 'display :type '(choice (const :tag "top" 'top) Index: src/event-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-msw.c,v retrieving revision 1.38.2.15 diff -u -r1.38.2.15 event-msw.c --- src/event-msw.c 1999/07/05 07:28:22 1.38.2.15 +++ src/event-msw.c 1999/07/18 17:01:51 @@ -1970,6 +1970,8 @@ TC_ITEM item; int index = SendMessage (nmhdr->hwndFrom, TCM_GETCURSEL, 0, 0); frame = XFRAME (mswindows_find_frame (hwnd)); + + item.mask = TCIF_PARAM; SendMessage (nmhdr->hwndFrom, TCM_GETITEM, (WPARAM)index, (LPARAM)&item); Index: src/glyphs-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs-msw.c,v retrieving revision 1.21.2.18 diff -u -r1.21.2.18 glyphs-msw.c --- src/glyphs-msw.c 1999/07/05 07:28:23 1.21.2.18 +++ src/glyphs-msw.c 1999/07/18 17:01:59 @@ -107,6 +107,7 @@ struct frame* f); COLORREF mswindows_string_to_color (CONST char *name); +void check_valid_item_list_1 (Lisp_Object items); #define BPLINE(width) ((int)(~3UL & (unsigned long)((width) +3))) @@ -2049,6 +2050,17 @@ | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); } +/* resize the subwindow instance */ +static void +mswindows_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h) +{ + SetWindowPos (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), + NULL, + 0, 0, w, h, + SWP_NOZORDER | SWP_NOMOVE + | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); +} + /* when you click on a widget you may activate another widget this needs to be checked and all appropriate widgets updated */ static void @@ -2540,7 +2552,6 @@ WS_EX_CONTROLPARENT); wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); - /* add items to the tab */ LIST_LOOP (rest, Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), Q_items, Qnil)) { @@ -2549,6 +2560,36 @@ } } +/* set the properties of a tab control */ +static Lisp_Object +mswindows_tab_control_set_property (Lisp_Object image_instance, Lisp_Object prop, + Lisp_Object val) +{ + struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + if (EQ (prop, Q_items)) + { + HWND wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); + int index = 0; + Lisp_Object rest; + check_valid_item_list_1 (val); + + /* delete the pre-existing items */ + SendMessage (wnd, TCM_DELETEALLITEMS, 0, 0); + + /* add items to the tab */ + LIST_LOOP (rest, val) + { + add_tab_item (image_instance, wnd, XCAR (rest), + IMAGE_INSTANCE_SUBWINDOW_FRAME (ii), index); + index++; + } + + return Qt; + } + return Qunbound; +} + /* instantiate a static control possible for putting other things in */ static void mswindows_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, @@ -2739,6 +2780,7 @@ CONSOLE_HAS_METHOD (mswindows, image_instance_hash); CONSOLE_HAS_METHOD (mswindows, init_image_instance_from_eimage); CONSOLE_HAS_METHOD (mswindows, locate_pixmap_file); + CONSOLE_HAS_METHOD (mswindows, resize_subwindow); } void @@ -2815,6 +2857,7 @@ /* tab control widget */ INITIALIZE_DEVICE_IIFORMAT (mswindows, tab_control); IIFORMAT_HAS_DEVMETHOD (mswindows, tab_control, instantiate); + IIFORMAT_HAS_DEVMETHOD (mswindows, tab_control, set_property); /* windows bitmap format */ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (bmp, "bmp"); Index: src/glyphs-widget.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/glyphs-widget.c,v retrieving revision 1.1.2.6 diff -u -r1.1.2.6 glyphs-widget.c --- src/glyphs-widget.c 1999/06/29 14:35:33 1.1.2.6 +++ src/glyphs-widget.c 1999/07/18 17:02:02 @@ -149,7 +149,7 @@ signal_simple_error (":descriptor must be a string or a vector", data); } -static void +void check_valid_item_list_1 (Lisp_Object items) { Lisp_Object rest; Index: src/gutter.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/gutter.c,v retrieving revision 1.1.2.1 diff -u -r1.1.2.1 gutter.c --- src/gutter.c 1999/07/16 19:05:40 1.1.2.1 +++ src/gutter.c 1999/07/18 17:02:02 @@ -357,7 +357,8 @@ /* #### optimize this - redrawing the whole gutter for every expose is very expensive. We reset the current display lines because if they're being exposed they are no longer current. */ - Dynarr_reset (f->current_display_lines); + if (f->current_display_lines) + Dynarr_reset (f->current_display_lines); /* we have to do this in-case there were subwindows where we are redrawing, unfortunately sometimes this also generates expose events resulting in an endless cycle of redsplay. */ @@ -394,27 +395,6 @@ Dynarr_free (f->desired_display_lines); } -void -init_frame_gutters (struct frame *f) -{ - int pos; - struct window* w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); - /* We are here as far in frame creation so cached specifiers are - already recomputed, and possibly modified by resource - initialization. We need to recalculate autodetected gutters. */ - for (pos = 0; pos< 4; pos++) - { - w->real_gutter_size[pos] = w->gutter_size[pos]; - if (EQ (w->gutter_size[pos], Qautodetect) - && !NILP (w->gutter_visible_p[pos])) - { - w->real_gutter_size [pos] = calculate_gutter_size (w, pos); - MARK_GUTTER_CHANGED; - MARK_WINDOWS_CHANGED (w); - } - } -} - static enum gutter_pos decode_gutter_position (Lisp_Object position) { @@ -476,6 +456,48 @@ return Vdefault_gutter_position; } +DEFUN ("gutter-pixel-width", Fgutter_pixel_width, 0, 2, 0, /* +Return the pixel width of the gutter at POS in LOCALE. +POS defaults to the default gutter position. LOCALE defaults to +the current window. +*/ + (pos, locale)) +{ + int x, y, width, height; + enum gutter_pos p = TOP_GUTTER; + struct frame *f = decode_frame (FW_FRAME (locale)); + + if (NILP (pos)) + pos = Vdefault_gutter_position; + p = decode_gutter_position (pos); + + get_gutter_coords (f, p, &x, &y, &width, &height); + width -= (FRAME_GUTTER_BORDER_WIDTH (f, p) * 2); + + return make_int (width); +} + +DEFUN ("gutter-pixel-height", Fgutter_pixel_height, 0, 2, 0, /* +Return the pixel height of the gutter at POS in LOCALE. +POS defaults to the default gutter position. LOCALE defaults to +the current window. +*/ + (pos, locale)) +{ + int x, y, width, height; + enum gutter_pos p = TOP_GUTTER; + struct frame *f = decode_frame (FW_FRAME (locale)); + + if (NILP (pos)) + pos = Vdefault_gutter_position; + p = decode_gutter_position (pos); + + get_gutter_coords (f, p, &x, &y, &width, &height); + height -= (FRAME_GUTTER_BORDER_WIDTH (f, p) * 2); + + return make_int (height); +} + DEFINE_SPECIFIER_TYPE (gutter); static void @@ -580,11 +602,35 @@ } void +init_frame_gutters (struct frame *f) +{ + int pos; + struct window* w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); + /* We are here as far in frame creation so cached specifiers are + already recomputed, and possibly modified by resource + initialization. We need to recalculate autodetected gutters. */ + for (pos = 0; pos< 4; pos++) + { + w->real_gutter_size[pos] = w->gutter_size[pos]; + if (EQ (w->gutter_size[pos], Qautodetect) + && !NILP (w->gutter_visible_p[pos])) + { + Fset_specifier_dirty_flag (Vgutter[pos]); + w->real_gutter_size [pos] = calculate_gutter_size (w, pos); + MARK_GUTTER_CHANGED; + MARK_WINDOWS_CHANGED (w); + } + } +} + +void syms_of_gutter (void) { DEFSUBR (Fgutter_specifier_p); DEFSUBR (Fset_default_gutter_position); DEFSUBR (Fdefault_gutter_position); + DEFSUBR (Fgutter_pixel_height); + DEFSUBR (Fgutter_pixel_width); } void @@ -829,14 +875,13 @@ fb = Qnil; #ifdef HAVE_TTY - fb = Fcons (Fcons (list1 (Qtty), Qzero), fb); + fb = Fcons (Fcons (list1 (Qtty), Qautodetect), fb); #endif #ifdef HAVE_X_WINDOWS - fb = Fcons (Fcons (list1 (Qx), make_int (DEFAULT_GUTTER_HEIGHT)), fb); + fb = Fcons (Fcons (list1 (Qx), Qautodetect), fb); #endif #ifdef HAVE_MS_WINDOWS - fb = Fcons (Fcons (list1 (Qmswindows), - make_int (DEFAULT_GUTTER_HEIGHT)), fb); + fb = Fcons (Fcons (list1 (Qmswindows), Qautodetect), fb); #endif if (!NILP (fb)) set_specifier_fallback (Vdefault_gutter_height, fb); Index: src/gutter.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/gutter.h,v retrieving revision 1.1.2.1 diff -u -r1.1.2.1 gutter.h --- src/gutter.h 1999/07/16 19:05:41 1.1.2.1 +++ src/gutter.h 1999/07/18 17:02:02 @@ -35,9 +35,8 @@ #define CHECK_GUTTER_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, gutter) #define CONCHECK_GUTTER_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, gutter) -#define DEFAULT_GUTTER_HEIGHT 0 -#define DEFAULT_GUTTER_WIDTH 0 -#define DEFAULT_GUTTER_BORDER_WIDTH 0 +#define DEFAULT_GUTTER_WIDTH 40 +#define DEFAULT_GUTTER_BORDER_WIDTH 2 enum gutter_pos { @@ -77,7 +76,8 @@ #define WINDOW_REAL_GUTTER_VISIBLE(f, pos) \ (WINDOW_REAL_GUTTER_SIZE (f, pos) > 0) #define WINDOW_REAL_GUTTER_BORDER_WIDTH(f, pos) \ - (!NILP (WINDOW_GUTTER_VISIBLE (f, pos)) \ + ((!NILP (WINDOW_GUTTER_VISIBLE (f, pos)) \ + && WINDOW_GUTTER_SIZE_INTERNAL (f,pos) > 0) \ ? WINDOW_GUTTER_BORDER_WIDTH (f, pos) \ : 0) #define WINDOW_REAL_GUTTER_BOUNDS(f, pos) \ Index: src/redisplay.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/redisplay.c,v retrieving revision 1.55.2.8 diff -u -r1.55.2.8 redisplay.c --- src/redisplay.c 1999/07/16 19:05:42 1.55.2.8 +++ src/redisplay.c 1999/07/18 17:02:30 @@ -5868,7 +5868,7 @@ } Fset_marker (w->pointm[DESIRED_DISP], make_int (pointm), the_buffer); - /* If the buffer has changed we have to invalid all of our face + /* If the buffer has changed we have to invalidate all of our face cache elements. */ if ((!echo_active && b != window_display_buffer (w)) || !Dynarr_length (w->face_cachels) Index: src/window.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/window.c,v retrieving revision 1.41.2.10 diff -u -r1.41.2.10 window.c --- src/window.c 1999/07/16 19:05:44 1.41.2.10 +++ src/window.c 1999/07/18 17:02:44 @@ -3899,6 +3899,8 @@ SET_LAST_MODIFIED (w, 0); SET_LAST_FACECHANGE (w); MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); + /* overkill maybe, but better to be correct */ + MARK_FRAME_GUTTERS_CHANGED (f); } #undef MINSIZE #undef CURBEG Index: tests/glyph-test.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/tests/Attic/glyph-test.el,v retrieving revision 1.1.2.9 diff -u -r1.1.2.9 glyph-test.el --- tests/glyph-test.el 1999/07/16 19:05:47 1.1.2.9 +++ tests/glyph-test.el 1999/07/18 17:02:44 @@ -5,7 +5,8 @@ (defun foo () (interactive) - (setq ok-select (not ok-select))) + (ding)) +; (setq ok-select (not ok-select))) ;; button in a group (setq ok-select nil) Index: tests/gutter-test.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/tests/Attic/gutter-test.el,v retrieving revision 1.1.2.1 diff -u -r1.1.2.1 gutter-test.el --- tests/gutter-test.el 1999/07/16 19:06:32 1.1.2.1 +++ tests/gutter-test.el 1999/07/18 17:02:44 @@ -14,4 +14,4 @@ (set-specifier default-gutter-width 40) (set-specifier default-gutter-border-width 2) (set-specifier default-gutter str) -(set-default-gutter-position 'top) +(set-default-gutter-position 'bottom)