Now on revision 104584. ------------------------------------------------------------ revno: 104584 fixes bug(s): http://debbugs.gnu.org/8505 committer: Jan D. branch nick: trunk timestamp: Tue 2011-06-14 23:08:20 +0200 message: Fix resize and change of scroll bar width for Gtk3. * configure.in: Add emacsgtkfixed.o to GTK_OBJ if HAVE_GTK3. * src/emacsgtkfixed.c, src/emacsgtkfixed.h: New files. * src/gtkutil.c: Include src/emacsgtkfixed.h if HAVE_GTK3. (int_gtk_range_get_value): Move to the scroll bar part of the file. (style_changed_cb): Call update_theme_scrollbar_width and call x_set_scroll_bar_default_width and xg_frame_set_char_size for all frames. (xg_create_frame_widgets): Call emacs_fixed_new if HAVE_GTK3 (Bug#8505). Call gtk_window_set_resizable if HAVE_GTK3. (x_wm_set_size_hint): Call emacs_fixed_set_min_size with min width and height if HAVE_GTK3 (Bug#8505). (scroll_bar_width_for_theme): New variable. (update_theme_scrollbar_width): New function. (xg_get_default_scrollbar_width): Move code to update_theme_scrollbar_width, just return scroll_bar_width_for_theme. (xg_initialize): Call update_theme_scrollbar_width. * src/gtkutil.h (xg_get_default_scrollbar_width): Remove argument. * src/xfns.c (x_set_scroll_bar_default_width): Remove argument to xg_get_default_scrollbar_width. diff: === modified file 'ChangeLog' --- ChangeLog 2011-06-08 16:26:45 +0000 +++ ChangeLog 2011-06-14 21:08:20 +0000 @@ -1,3 +1,7 @@ +2011-06-14 Jan Djärv + + * configure.in: Add emacsgtkfixed.o to GTK_OBJ if HAVE_GTK3. + 2011-06-08 Paul Eggert * lib/gnulib.mk, m4/gnulib-common.m4: Merge from gnulib. === modified file 'configure.in' --- configure.in 2011-06-07 04:16:37 +0000 +++ configure.in 2011-06-14 21:08:20 +0000 @@ -1819,6 +1819,7 @@ HAVE_GTK=no +GTK_OBJ= if test "${with_gtk3}" = "yes"; then GLIB_REQUIRED=2.28 GTK_REQUIRED=3.0 @@ -1830,6 +1831,7 @@ AC_MSG_ERROR($GTK_PKG_ERRORS) fi AC_DEFINE(HAVE_GTK3, 1, [Define to 1 if using GTK 3 or later.]) + GTK_OBJ=emacsgtkfixed.o fi if test "$pkg_check_gtk" != "yes"; then @@ -1847,7 +1849,6 @@ fi fi -GTK_OBJ= if test x"$pkg_check_gtk" = xyes; then AC_SUBST(GTK_CFLAGS) @@ -1865,7 +1866,7 @@ else HAVE_GTK=yes AC_DEFINE(USE_GTK, 1, [Define to 1 if using GTK.]) - GTK_OBJ=gtkutil.o + GTK_OBJ="gtkutil.o $GTK_OBJ" USE_X_TOOLKIT=none if $PKG_CONFIG --atleast-version=2.10 gtk+-2.0; then : === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-12 10:16:46 +0000 +++ src/ChangeLog 2011-06-14 21:08:20 +0000 @@ -1,3 +1,27 @@ +2011-06-14 Jan Djärv + + * xfns.c (x_set_scroll_bar_default_width): Remove argument to + xg_get_default_scrollbar_width. + + * gtkutil.c: Include emacsgtkfixed.h if HAVE_GTK3. + (int_gtk_range_get_value): Move to the scroll bar part of the file. + (style_changed_cb): Call update_theme_scrollbar_width and call + x_set_scroll_bar_default_width and xg_frame_set_char_size for + all frames (Bug#8505). + (xg_create_frame_widgets): Call emacs_fixed_new if HAVE_GTK3 (Bug#8505). + Call gtk_window_set_resizable if HAVE_GTK3. + (x_wm_set_size_hint): Call emacs_fixed_set_min_size with min width + and height if HAVE_GTK3 (Bug#8505). + (scroll_bar_width_for_theme): New variable. + (update_theme_scrollbar_width): New function. + (xg_get_default_scrollbar_width): Move code to + update_theme_scrollbar_width, just return scroll_bar_width_for_theme. + (xg_initialize): Call update_theme_scrollbar_width. + + * gtkutil.h (xg_get_default_scrollbar_width): Remove argument. + + * emacsgtkfixed.c, emacsgtkfixed.h: New files. + 2011-06-12 Martin Rudalics * frame.c (make_frame): Call other_buffer_safely instead of === added file 'src/emacsgtkfixed.c' --- src/emacsgtkfixed.c 1970-01-01 00:00:00 +0000 +++ src/emacsgtkfixed.c 2011-06-14 21:08:20 +0000 @@ -0,0 +1,123 @@ +/* A Gtk Widget that inherits GtkFixed, but can be shrinked. + +Copyright (C) 2011 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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 3 of the License, or +(at your option) any later version. + +GNU Emacs 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 GNU Emacs. If not, see . */ + +#include "emacsgtkfixed.h" + + +struct _EmacsFixedPrivate +{ + int minwidth, minheight; +}; + + +static void emacs_fixed_get_preferred_width (GtkWidget *widget, + gint *minimum, + gint *natural); +static void emacs_fixed_get_preferred_height (GtkWidget *widget, + gint *minimum, + gint *natural); +G_DEFINE_TYPE (EmacsFixed, emacs_fixed, GTK_TYPE_FIXED) + +static void +emacs_fixed_class_init (EmacsFixedClass *klass) +{ + GtkWidgetClass *widget_class; + GtkFixedClass *fixed_class; + + widget_class = (GtkWidgetClass*) klass; + fixed_class = (GtkFixedClass*) klass; + + widget_class->get_preferred_width = emacs_fixed_get_preferred_width; + widget_class->get_preferred_height = emacs_fixed_get_preferred_height; + g_type_class_add_private (klass, sizeof (EmacsFixedPrivate)); +} + +static GType +emacs_fixed_child_type (GtkFixed *container) +{ + return GTK_TYPE_WIDGET; +} + +static void +emacs_fixed_init (EmacsFixed *fixed) +{ + fixed->priv = G_TYPE_INSTANCE_GET_PRIVATE (fixed, EMACS_TYPE_FIXED, + EmacsFixedPrivate); + fixed->priv->minwidth = fixed->priv->minheight = 0; +} + +/** + * emacs_fixed_new: + * + * Creates a new #EmacsFixed. + * + * Returns: a new #EmacsFixed. + */ +GtkWidget* +emacs_fixed_new (void) +{ + return g_object_new (EMACS_TYPE_FIXED, NULL); +} + +static GtkWidgetClass * +get_parent_class (EmacsFixed *fixed) +{ + EmacsFixedClass *klass = EMACS_FIXED_GET_CLASS (fixed); + GtkFixedClass *parent_class = g_type_class_peek_parent (klass); + return (GtkWidgetClass*) parent_class; +} + +static void +emacs_fixed_get_preferred_width (GtkWidget *widget, + gint *minimum, + gint *natural) +{ + EmacsFixed *fixed = EMACS_FIXED (widget); + EmacsFixedPrivate *priv = fixed->priv; + GtkWidgetClass *widget_class = get_parent_class (fixed); + widget_class->get_preferred_width (widget, minimum, natural); + if (minimum) *minimum = priv->minwidth; +} + +static void +emacs_fixed_get_preferred_height (GtkWidget *widget, + gint *minimum, + gint *natural) +{ + EmacsFixed *fixed = EMACS_FIXED (widget); + EmacsFixedPrivate *priv = fixed->priv; + GtkWidgetClass *widget_class = get_parent_class (fixed); + widget_class->get_preferred_height (widget, minimum, natural); + if (minimum) *minimum = priv->minheight; +} + +void +emacs_fixed_set_min_size (EmacsFixed *widget, int width, int height) +{ + EmacsFixedPrivate *priv = widget->priv; + GtkWidgetClass *widget_class = get_parent_class (widget); + int mw, nw, mh, nh; + + widget_class->get_preferred_height (GTK_WIDGET (widget), &mh, &nh); + widget_class->get_preferred_width (GTK_WIDGET (widget), &mw, &nw); + + /* Gtk complains if min size is less than natural size. */ + if (width <= nw) priv->minwidth = width; + if (height <= nh) priv->minheight = height; +} === added file 'src/emacsgtkfixed.h' --- src/emacsgtkfixed.h 1970-01-01 00:00:00 +0000 +++ src/emacsgtkfixed.h 2011-06-14 21:08:20 +0000 @@ -0,0 +1,58 @@ +/* A Gtk Widget that inherits GtkFixed, but can be shrinked. + +Copyright (C) 2011 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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 3 of the License, or +(at your option) any later version. + +GNU Emacs 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 GNU Emacs. If not, see . */ + +#ifndef EMACSGTKFIXED_H +#define EMACSGTKFIXED_H + +#include + +G_BEGIN_DECLS + +#define EMACS_TYPE_FIXED (emacs_fixed_get_type ()) +#define EMACS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_CAST ((obj), EMACS_TYPE_FIXED, EmacsFixed)) +#define EMACS_FIXED_CLASS(klass) (G_TYPE_CHECK_CLASS_CAST ((klass), EMACS_TYPE_FIXED, EmacsFixedClass)) +#define EMACS_IS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), EMACS_TYPE_FIXED)) +#define EMACS_IS_FIXED_CLASS(klass) (G_TYPE_CHECK_CLASS_TYPE ((klass), EMACS_TYPE_FIXED)) +#define EMACS_FIXED_GET_CLASS(obj) (G_TYPE_INSTANCE_GET_CLASS ((obj), EMACS_TYPE_FIXED, EmacsFixedClass)) + +typedef struct _EmacsFixed EmacsFixed; +typedef struct _EmacsFixedPrivate EmacsFixedPrivate; +typedef struct _EmacsFixedClass EmacsFixedClass; + +struct _EmacsFixed +{ + GtkFixed container; + + /*< private >*/ + EmacsFixedPrivate *priv; +}; + + +struct _EmacsFixedClass +{ + GtkFixedClass parent_class; +}; + +extern GtkWidget *emacs_fixed_new (void); +extern void emacs_fixed_set_min_size (EmacsFixed *widget, int width, int height); +extern GType emacs_fixed_get_type (void); + +G_END_DECLS + +#endif /* EMACSGTKFIXED_H */ === modified file 'src/gtkutil.c' --- src/gtkutil.c 2011-06-05 22:20:42 +0000 +++ src/gtkutil.c 2011-06-14 21:08:20 +0000 @@ -42,6 +42,7 @@ #ifdef HAVE_GTK3 #include +#include "emacsgtkfixed.h" #endif #define FRAME_TOTAL_PIXEL_HEIGHT(f) \ @@ -88,12 +89,7 @@ #define XG_BIN_CHILD(x) gtk_bin_get_child (GTK_BIN (x)) -/* Get the current value of the range, truncated to an integer. */ -static int -int_gtk_range_get_value (GtkRange *range) -{ - return gtk_range_get_value (range); -} +static void update_theme_scrollbar_width (void); /*********************************************************************** @@ -1015,6 +1011,7 @@ struct input_event event; GdkDisplay *gdpy = (GdkDisplay *) user_data; const char *display_name = gdk_display_get_name (gdpy); + Display *dpy = GDK_DISPLAY_XDISPLAY (gdpy); EVENT_INIT (event); event.kind = CONFIG_CHANGED_EVENT; @@ -1022,6 +1019,24 @@ /* Theme doesn't change often, so intern is called seldom. */ event.arg = intern ("theme-name"); kbd_buffer_store_event (&event); + + update_theme_scrollbar_width (); + + /* If scroll bar width changed, we need set the new size on all frames + on this display. */ + if (dpy) + { + Lisp_Object rest, frame; + FOR_EACH_FRAME (rest, frame) + { + FRAME_PTR f = XFRAME (frame); + if (FRAME_X_DISPLAY (f) == dpy) + { + x_set_scroll_bar_default_width (f); + xg_frame_set_char_size (f, FRAME_COLS (f), FRAME_LINES (f)); + } + } + } } /* Called when a delete-event occurs on WIDGET. */ @@ -1069,7 +1084,12 @@ wvbox = gtk_vbox_new (FALSE, 0); whbox = gtk_hbox_new (FALSE, 0); - wfixed = gtk_fixed_new (); /* Must have this to place scroll bars */ + +#ifdef HAVE_GTK3 + wfixed = emacs_fixed_new (); +#else + wfixed = gtk_fixed_new (); +#endif if (! wtop || ! wvbox || ! whbox || ! wfixed) { @@ -1162,6 +1182,7 @@ gtk_widget_modify_style (wfixed, style); #else gtk_widget_set_can_focus (wfixed, TRUE); + gtk_window_set_resizable (GTK_WINDOW (wtop), TRUE); #endif #ifdef USE_GTK_TOOLTIP @@ -1265,6 +1286,18 @@ size_hints.min_width = base_width + min_cols * size_hints.width_inc; size_hints.min_height = base_height + min_rows * size_hints.height_inc; +#ifdef HAVE_GTK3 + /* Gtk3 ignores min width/height and overwrites them with its own idea + of min width/height. Put out min values to the widget so Gtk + gets the same value we want it to be. Without this, a user can't + shrink an Emacs frame. + */ + if (FRAME_GTK_WIDGET (f)) + emacs_fixed_set_min_size (EMACS_FIXED (FRAME_GTK_WIDGET (f)), + size_hints.min_width, + size_hints.min_height); +#endif + /* These currently have a one to one mapping with the X values, but I don't think we should rely on that. */ hint_flags |= GDK_HINT_WIN_GRAVITY; @@ -3250,6 +3283,10 @@ int xg_ignore_gtk_scrollbar; +/* The width of the scroll bar for the current theme. */ + +static int scroll_bar_width_for_theme; + /* Xlib's `Window' fits in 32 bits. But we want to store pointers, and they may be larger than 32 bits. Keep a mapping from integer index to widget pointers to get around the 32 bit limitation. */ @@ -3326,8 +3363,8 @@ return 0; } -int -xg_get_default_scrollbar_width (FRAME_PTR f) +static void +update_theme_scrollbar_width (void) { #ifdef HAVE_GTK3 GtkAdjustment *vadj; @@ -3336,13 +3373,22 @@ #endif GtkWidget *wscroll; int w = 0, b = 0; + vadj = gtk_adjustment_new (XG_SB_MIN, XG_SB_MIN, XG_SB_MAX, 0.1, 0.1, 0.1); wscroll = gtk_vscrollbar_new (GTK_ADJUSTMENT (vadj)); + g_object_ref_sink (G_OBJECT (wscroll)); gtk_widget_style_get (wscroll, "slider-width", &w, "trough-border", &b, NULL); gtk_widget_destroy (wscroll); + g_object_unref (G_OBJECT (wscroll)); w += 2*b; if (w < 16) w = 16; - return w; + scroll_bar_width_for_theme = w; +} + +int +xg_get_default_scrollbar_width (void) +{ + return scroll_bar_width_for_theme; } /* Return the scrollbar id for X Window WID on display DPY. @@ -3528,6 +3574,15 @@ } } +/* Get the current value of the range, truncated to an integer. */ + +static int +int_gtk_range_get_value (GtkRange *range) +{ + return gtk_range_get_value (range); +} + + /* Set the thumb size and position of scroll bar BAR. We are currently displaying PORTION out of a whole WHOLE, and our position POSITION. */ @@ -4680,6 +4735,7 @@ (GTK_TYPE_MENU_SHELL)); gtk_binding_entry_add_signal (binding_set, GDK_KEY_g, GDK_CONTROL_MASK, "cancel", 0); + update_theme_scrollbar_width (); } #endif /* USE_GTK */ === modified file 'src/gtkutil.h' --- src/gtkutil.h 2011-06-05 19:04:51 +0000 +++ src/gtkutil.h 2011-06-14 21:08:20 +0000 @@ -135,7 +135,7 @@ int position, int whole); extern int xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event); -extern int xg_get_default_scrollbar_width (FRAME_PTR f); +extern int xg_get_default_scrollbar_width (void); extern void update_frame_tool_bar (FRAME_PTR f); extern void free_frame_tool_bar (FRAME_PTR f); === modified file 'src/xfns.c' --- src/xfns.c 2011-06-11 21:31:32 +0000 +++ src/xfns.c 2011-06-14 21:08:20 +0000 @@ -1701,7 +1701,7 @@ int wid = FRAME_COLUMN_WIDTH (f); #ifdef USE_TOOLKIT_SCROLL_BARS #ifdef USE_GTK - int minw = xg_get_default_scrollbar_width (f); + int minw = xg_get_default_scrollbar_width (); #else int minw = 16; #endif ------------------------------------------------------------ revno: 104583 committer: Chong Yidong branch nick: trunk timestamp: Tue 2011-06-14 01:06:26 -0400 message: Print theme summaries in *Custom Themes* buffer. * lisp/cus-theme.el (describe-theme-1): Use custom-theme-p. (custom-theme-summary): New function. (customize-themes): Use it. * etc/themes/light-blue-theme.el: * etc/themes/misterioso-theme.el: * etc/themes/tango-dark-theme.el: * etc/themes/tango-theme.el: * etc/themes/tsdh-dark-theme.el: * etc/themes/tsdh-light-theme.el: * etc/themes/wheatgrass-theme.el: * etc/themes/wombat-theme.el: Tweak summaries for better listability. diff: === modified file 'etc/themes/light-blue-theme.el' --- etc/themes/light-blue-theme.el 2011-02-12 23:10:18 +0000 +++ etc/themes/light-blue-theme.el 2011-06-14 05:06:26 +0000 @@ -26,7 +26,7 @@ ;;; Code: (deftheme light-blue - "Theme with a light blue backgound.") + "Face colors utilizing a light blue backgound.") (let ((class '((class color) (min-colors 89)))) (custom-theme-set-faces === modified file 'etc/themes/misterioso-theme.el' --- etc/themes/misterioso-theme.el 2011-03-22 18:59:50 +0000 +++ etc/themes/misterioso-theme.el 2011-06-14 05:06:26 +0000 @@ -22,7 +22,7 @@ ;;; Code: (deftheme misterioso - "Theme for faces, using light colors on a dark gray background.") + "Predominantly blue/cyan faces on a dark cyan background.") (let ((class '((class color) (min-colors 89)))) === modified file 'etc/themes/tango-dark-theme.el' --- etc/themes/tango-dark-theme.el 2011-02-21 05:59:20 +0000 +++ etc/themes/tango-dark-theme.el 2011-06-14 05:06:26 +0000 @@ -28,7 +28,7 @@ ;;; Code: (deftheme tango-dark - "Theme for faces, based on the Tango palette with a dark background. + "Face colors using the Tango palette (dark background). Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell, Semantic, and Ansi-Color faces are included.") === modified file 'etc/themes/tango-theme.el' --- etc/themes/tango-theme.el 2011-02-02 17:26:04 +0000 +++ etc/themes/tango-theme.el 2011-06-14 05:06:26 +0000 @@ -28,7 +28,7 @@ ;;; Code: (deftheme tango - "Theme for faces, based on the Tango palette with a light background. + "Face colors using the Tango palette (light background). Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell, Semantic, and Ansi-Color faces are included.") === modified file 'etc/themes/tsdh-dark-theme.el' --- etc/themes/tsdh-dark-theme.el 2011-03-08 02:47:55 +0000 +++ etc/themes/tsdh-dark-theme.el 2011-06-14 05:06:26 +0000 @@ -20,7 +20,8 @@ ;;; Code: (deftheme tsdh-dark - "Theme with dark background used and created by Tassilo Horn.") + "Minor tweaks to the Emacs dark-background defaults. +Used and created by Tassilo Horn.") (custom-theme-set-faces 'tsdh-dark === modified file 'etc/themes/tsdh-light-theme.el' --- etc/themes/tsdh-light-theme.el 2011-03-08 02:47:55 +0000 +++ etc/themes/tsdh-light-theme.el 2011-06-14 05:06:26 +0000 @@ -20,7 +20,8 @@ ;;; Code: (deftheme tsdh-light - "Black on white theme used and created by Tassilo Horn.") + "Minor tweaks to the Emacs white-background defaults. +Used and created by Tassilo Horn.") (custom-theme-set-faces 'tsdh-light === modified file 'etc/themes/wheatgrass-theme.el' --- etc/themes/wheatgrass-theme.el 2011-02-02 03:36:29 +0000 +++ etc/themes/wheatgrass-theme.el 2011-06-14 05:06:26 +0000 @@ -20,7 +20,7 @@ ;;; Code: (deftheme wheatgrass - "A high-contrast theme with a black background. + "High-contrast green/blue/brown faces on a black background. Basic, Font Lock, Isearch, Gnus, and Message faces are included. The default face foreground is wheat, with other faces in shades of green, brown, and blue.") === modified file 'etc/themes/wombat-theme.el' --- etc/themes/wombat-theme.el 2011-03-08 02:47:55 +0000 +++ etc/themes/wombat-theme.el 2011-06-14 05:06:26 +0000 @@ -22,7 +22,7 @@ ;;; Code: (deftheme wombat - "Theme for faces, using easy-on-the eyes colors on a dark gray background. + "Medium-contrast faces with a dark gray background. Adapted, with permission, from a Vim color scheme by Lars H. Nielsen. Basic, Font Lock, Isearch, Gnus, Message, and Ansi-Color faces are included.") === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-13 21:42:40 +0000 +++ lisp/ChangeLog 2011-06-14 05:06:26 +0000 @@ -1,3 +1,9 @@ +2011-06-14 Chong Yidong + + * cus-theme.el (describe-theme-1): Use custom-theme-p. + (custom-theme-summary): New function. + (customize-themes): Use it. + 2011-06-13 Glenn Morris * cus-dep.el (custom-make-dependencies): Use up command-line-args-left. === modified file 'lisp/cus-theme.el' --- lisp/cus-theme.el 2011-04-19 13:44:55 +0000 +++ lisp/cus-theme.el 2011-06-14 05:06:26 +0000 @@ -483,25 +483,24 @@ 'help-theme-def fn) (princ "'")) (princ ".\n") - (if (not (memq theme custom-known-themes)) + (if (custom-theme-p theme) (progn - (princ "It is not loaded.") - ;; Attempt to grab the theme documentation - (when fn - (with-temp-buffer - (insert-file-contents fn) - (let ((sexp (let ((read-circle nil)) - (condition-case nil - (read (current-buffer)) - (end-of-file nil))))) - (and sexp (listp sexp) - (eq (car sexp) 'deftheme) - (setq doc (nth 2 sexp))))))) - (if (custom-theme-enabled-p theme) - (princ "It is loaded and enabled.") - (princ "It is loaded but disabled.")) - (setq doc (get theme 'theme-documentation))) - + (if (custom-theme-enabled-p theme) + (princ "It is loaded and enabled.") + (princ "It is loaded but disabled.")) + (setq doc (get theme 'theme-documentation))) + (princ "It is not loaded.") + ;; Attempt to grab the theme documentation + (when fn + (with-temp-buffer + (insert-file-contents fn) + (let ((sexp (let ((read-circle nil)) + (condition-case nil + (read (current-buffer)) + (end-of-file nil))))) + (and sexp (listp sexp) + (eq (car sexp) 'deftheme) + (setq doc (nth 2 sexp))))))) (princ "\n\nDocumentation:\n") (princ (if (stringp doc) doc @@ -605,26 +604,56 @@ (widget-create 'checkbox :value custom-theme-allow-multiple-selections :action 'custom-theme-selections-toggle) - (widget-insert (propertize " Allow more than one theme at a time" + (widget-insert (propertize " Select more than one theme at a time" 'face '(variable-pitch (:height 0.9)))) (widget-insert "\n\nAvailable Custom Themes:\n") - (let (widget) + (let ((help-echo "mouse-2: Enable this theme for this session") + widget) (dolist (theme (custom-available-themes)) (setq widget (widget-create 'checkbox :value (custom-theme-enabled-p theme) :theme-name theme + :help-echo help-echo :action 'custom-theme-checkbox-toggle)) (push (cons theme widget) custom--listed-themes) (widget-create-child-and-convert widget 'push-button :button-face-get 'ignore :mouse-face-get 'ignore :value (format " %s" theme) - :action 'widget-parent-action) - (widget-insert ?\n))) + :action 'widget-parent-action + :help-echo help-echo) + (widget-insert " -- " + (propertize (custom-theme-summary theme) + 'face 'shadow) + ?\n))) (goto-char (point-min)) (widget-setup)) +(defun custom-theme-summary (theme) + "Return the summary line of THEME." + (let (doc) + (if (custom-theme-p theme) + (setq doc (get theme 'theme-documentation)) + (let ((fn (locate-file (concat (symbol-name theme) "-theme.el") + (custom-theme--load-path) + '("" "c")))) + (when fn + (with-temp-buffer + (insert-file-contents fn) + (let ((sexp (let ((read-circle nil)) + (condition-case nil + (read (current-buffer)) + (end-of-file nil))))) + (and sexp (listp sexp) + (eq (car sexp) 'deftheme) + (setq doc (nth 2 sexp)))))))) + (cond ((null doc) + "(no documentation available)") + ((string-match ".*" doc) + (match-string 0 doc)) + (t doc)))) + (defun custom-theme-checkbox-toggle (widget &optional event) (let ((this-theme (widget-get widget :theme-name))) (if (widget-value widget)