unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* mouse-face on mode-line and header-line
@ 2005-05-13 14:05 Masatake YAMATO
  2005-05-13 15:45 ` Stefan Monnier
                   ` (3 more replies)
  0 siblings, 4 replies; 32+ messages in thread
From: Masatake YAMATO @ 2005-05-13 14:05 UTC (permalink / raw)


I've implemented mouse-face on mode-line.

help-echo is useful. However, it just tells the position where
you can do something. It doesn't tell the area where you can
do something. mouse-face helps you to notify the area.

As examples, I've put mouse-face on the standard mode line
format defind in bindings.el and the header line defined in ruler-mode.el.

Now you can port gnome's panel-applets to emacs:-P

2005-05-13  Masatake YAMATO  <jet@gyve.org>

	* faces.el (mode-line-highlight): New face.

	* ruler-mode.el (ruler-mode-ruler): Use mode-line-highlight
	as mouse-face.

	* bindings.el (top-level, help-echo, mode-line-modified)
	(mode-line-mule-info, mode-line-eol-desc): Use mode-line-highlight
	as mouse-face.

2005-05-13  Masatake YAMATO  <jet@gyve.org>

	* xdisp.c (note_mode_line_or_margin_highlight): Added code
	for mouse-face. Change the type of the first argument from `window'
	to `List_Object'.
	(note_mouse_highlight): Call note_mode_line_or_margin_highlight with
	window instead of w.

Masatake YAMATO

Index: src/xdisp.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/xdisp.c,v
retrieving revision 1.1007
diff -u -r1.1007 xdisp.c
--- src/xdisp.c	2 May 2005 17:08:44 -0000	1.1007
+++ src/xdisp.c	13 May 2005 13:55:28 -0000
@@ -21216,11 +21216,12 @@
    position relative to the start of the mode line.  */
 
 static void
-note_mode_line_or_margin_highlight (w, x, y, area)
-     struct window *w;
+note_mode_line_or_margin_highlight (window, x, y, area)
+     Lisp_Object window;
      int x, y;
      enum window_part area;
 {
+  struct window *w = XWINDOW (window);
   struct frame *f = XFRAME (w->frame);
   Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
   Cursor cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
@@ -21229,9 +21230,38 @@
   Lisp_Object string, object = Qnil;
   Lisp_Object pos, help;
 
+  Lisp_Object mouse_face;
+  int original_x_pixel = x;
+  struct glyph * glyph = NULL;
+  struct glyph_row *row;  
+	  
   if (area == ON_MODE_LINE || area == ON_HEADER_LINE)
-    string = mode_line_string (w, area, &x, &y, &charpos,
-			       &object, &dx, &dy, &width, &height);
+    {
+      int x0;
+      struct glyph *end;
+
+      string = mode_line_string (w, area, &x, &y, &charpos,
+				 &object, &dx, &dy, &width, &height);
+
+      row = (area == ON_MODE_LINE)? 
+	MATRIX_MODE_LINE_ROW (w->current_matrix):
+	MATRIX_HEADER_LINE_ROW(w->current_matrix);
+      
+      /* Find glyph */
+      if (row->mode_line_p && row->enabled_p)
+	{
+	  glyph = row->glyphs[TEXT_AREA];
+	  end = glyph + row->used[TEXT_AREA];
+	  
+	  for (x0 = original_x_pixel; 
+	       glyph < end && x0 >= glyph->pixel_width; 
+	       ++glyph)
+	    x0 -= glyph->pixel_width;
+	
+	  if (glyph >= end)
+	    glyph = NULL;
+	}
+    }
   else
     {
       x -= WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w);
@@ -21309,6 +21339,91 @@
 	  if (!KEYMAPP (map))
 	    cursor = dpyinfo->vertical_scroll_bar_cursor;
 	}
+      
+     /* Change the mouse face according to what is under X/Y.  */
+      mouse_face = Fget_text_property (pos, Qmouse_face, string);
+      if (!NILP (mouse_face)
+	  && ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE))
+	  && glyph)
+	{
+	  Lisp_Object b, e;
+
+	  struct glyph * tmp_glyph;
+
+	  int gpos;
+	  int gseq_length;
+	  int total_pixel_width;
+	  int ignore;
+
+	  if (clear_mouse_face (dpyinfo))
+	    cursor = No_Cursor;
+	  
+	  /* Calculate the position(glyph position: GPOS) of GLYPH in 
+	     displayed string. GPOS is different from CHARPOS. 
+	     
+	     CHARPOS is the position of glyph in internal string
+	     object. A mode line string format has structures which
+	     is converted to a flatten by emacs lisp interpreter.
+	     The internal string is an element of the structures.
+	     The displayed string is the flatten string. */
+	  for (tmp_glyph = glyph - 1, gpos = 0; 
+	       tmp_glyph >= row->glyphs[TEXT_AREA]; 
+	       tmp_glyph--, gpos++)
+	    {
+	      if (tmp_glyph->object != glyph->object)
+		break;
+	    }
+
+	  /* Calculate the lenght(glyph sequence length: GSEQ_LENGTH) of
+	     displayed string holding GLYPH. 
+
+	     GSEQ_LENGTH is different from SCHARS (STRING).
+	     SCHARS (STRING) returns the length of the internal string. */
+	  for (tmp_glyph = glyph, gseq_length = gpos;
+	       tmp_glyph < glyph + row->used[TEXT_AREA];
+	       tmp_glyph++, gseq_length++)
+	      {
+		if (tmp_glyph->object != glyph->object)
+		  break;
+	      }
+	  
+	  b = Fprevious_single_property_change(make_number (charpos + 1),
+					       Qmouse_face, string, Qnil);
+	  e = Fnext_single_property_change (pos, Qmouse_face, string, Qnil);
+	  
+	  if (NILP (b))
+	    b = make_number (0);
+
+	  if (NILP (e))
+	    e = make_number(gseq_length);
+
+	  total_pixel_width = 0;
+	  for (tmp_glyph = glyph - (gpos - XINT(b)); tmp_glyph != glyph; tmp_glyph++)
+	    total_pixel_width += tmp_glyph->pixel_width;
+	  
+	  dpyinfo->mouse_face_beg_col = (x - gpos) + XINT(b);
+	  dpyinfo->mouse_face_beg_row = (area == ON_MODE_LINE)? 
+	    (w->current_matrix)->nrows - 1: 
+	    0;
+
+	  dpyinfo->mouse_face_beg_x   = original_x_pixel - (total_pixel_width + dx);
+	  dpyinfo->mouse_face_beg_y   = 0;
+	  
+	  dpyinfo->mouse_face_end_col = (x - gpos) + XINT(e);
+	  dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_beg_row;
+
+	  dpyinfo->mouse_face_end_x   = 0;
+	  dpyinfo->mouse_face_end_y   = 0;
+
+	  dpyinfo->mouse_face_past_end = 0;
+	  dpyinfo->mouse_face_window  = window;
+
+	  dpyinfo->mouse_face_face_id = face_at_string_position(w, string, 
+								charpos,
+								0, 0, 0, &ignore,
+								glyph->face_id, 1);
+	  show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
+	}
     }
 
   define_frame_cursor1 (f, cursor, pointer);
@@ -21389,7 +21504,7 @@
   if (part == ON_MODE_LINE || part == ON_HEADER_LINE
       || part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
     {
-      note_mode_line_or_margin_highlight (w, x, y, part);
+      note_mode_line_or_margin_highlight (window, x, y, part);
       return;
     }
 
Index: lisp/ruler-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/ruler-mode.el,v
retrieving revision 1.21
diff -u -r1.21 ruler-mode.el
--- lisp/ruler-mode.el	9 Feb 2005 15:50:41 -0000	1.21
+++ lisp/ruler-mode.el	13 May 2005 13:55:28 -0000
@@ -697,6 +697,9 @@
         (put-text-property
          i (1+ i) 'face 'ruler-mode-goal-column-face
          ruler)
+	(put-text-property
+         i (1+ i) 'mouse-face 'mode-line-highlight
+         ruler)
         (put-text-property
          i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
          ruler))
@@ -706,6 +709,9 @@
         (put-text-property
          i (1+ i) 'face 'ruler-mode-comment-column-face
          ruler)
+	(put-text-property
+         i (1+ i) 'mouse-face 'mode-line-highlight
+         ruler)
         (put-text-property
          i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
          ruler))
@@ -715,6 +721,9 @@
         (put-text-property
          i (1+ i) 'face 'ruler-mode-fill-column-face
          ruler)
+	(put-text-property
+         i (1+ i) 'mouse-face 'mode-line-highlight
+         ruler)
         (put-text-property
          i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
          ruler))
Index: lisp/faces.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/faces.el,v
retrieving revision 1.304
diff -u -r1.304 faces.el
--- lisp/faces.el	11 Apr 2005 20:47:25 -0000	1.304
+++ lisp/faces.el	13 May 2005 13:55:29 -0000
@@ -1827,9 +1827,22 @@
   :group 'modeline
   :group 'basic-faces)
 
+(defface mode-line-highlight
+  '((((class color) (min-colors 88) (background light))
+      :background "RoyalBlue4" :foreground "white")
+     (((class color) (min-colors 88) (background dark))
+      :background "light sky blue" :foreground "black")
+     (t
+     :inverse-video t))
+  "Basic mode line face for highlighting."
+  :version "22.1"
+  :group 'modeline
+  :group 'basic-faces)
+
 ;; Make `modeline' an alias for `mode-line', for compatibility.
 (put 'modeline 'face-alias 'mode-line)
 (put 'modeline-inactive 'face-alias 'mode-line-inactive)
+(put 'modeline-higilight 'face-alias 'mode-line-highlight)
 
 (defface header-line
   '((default
Index: lisp/bindings.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/bindings.el,v
retrieving revision 1.145
diff -u -r1.145 bindings.el
--- lisp/bindings.el	21 Apr 2005 00:06:54 -0000	1.145
+++ lisp/bindings.el	13 May 2005 13:55:29 -0000
@@ -165,7 +165,8 @@
 	     (eval-when-compile
 	       (let ((map (make-sparse-keymap)))
 		 (define-key map [mode-line mouse-3] 'mode-line-change-eol)
-		 map))))
+		 map))
+	     'mouse-face 'mode-line-highlight))
       (push (cons eol (cons mnemonic desc)) mode-line-eol-desc-cache)
       desc)))
 
@@ -177,7 +178,8 @@
 			     "Input method: "
 			     current-input-method
 			     ".  mouse-2: disable, mouse-3: describe")
-		  local-map ,mode-line-input-method-map))
+		  local-map ,mode-line-input-method-map
+		  mouse-face mode-line-highlight))
     ,(propertize
       "%z"
       'help-echo
@@ -191,6 +193,7 @@
 			  " buffer; mouse-3: describe coding system")
 		(concat "Unibyte " (symbol-name buffer-file-coding-system)
 			" buffer")))))
+      'mouse-face 'mode-line-highlight
       'local-map mode-line-coding-system-map)
     (:eval (mode-line-eol-desc)))
   "Mode-line control for displaying information of multilingual environment.
@@ -235,7 +238,8 @@
 					    "Not r")))))
 	 'local-map (purecopy (make-mode-line-mouse-map
 			       'mouse-3
-			       #'mode-line-toggle-read-only)))
+			       #'mode-line-toggle-read-only))
+	 'mouse-face 'mode-line-highlight)
 	(propertize
 	 "%1+"
 	 'help-echo  (purecopy (lambda (window object point)
@@ -246,7 +250,8 @@
 					     "M"
 					   "Not m")))))
 	 'local-map (purecopy (make-mode-line-mouse-map
-			       'mouse-3 #'mode-line-toggle-modified))))
+			       'mouse-3 #'mode-line-toggle-modified))
+	 'mouse-face 'mode-line-highlight))
   "Mode-line control for displaying whether current buffer is modified.")
 
 (make-variable-buffer-local 'mode-line-modified)
@@ -304,12 +309,15 @@
      (propertize "%[(" 'help-echo help-echo)
      `(:propertize ("" mode-name)
 		   help-echo "mouse-2: help for current major mode"
+		   mouse-face mode-line-highlight
 		   local-map ,mode-line-major-mode-keymap)
      '("" mode-line-process)
      `(:propertize ("" minor-mode-alist)
+		   mouse-face mode-line-highlight
 		   help-echo "mouse-2: help for minor modes, mouse-3: minor mode menu"
 		   local-map ,mode-line-minor-mode-keymap)
      (propertize "%n" 'help-echo "mouse-2: widen"
+		 'mouse-face 'mode-line-highlight
 		 'local-map (make-mode-line-mouse-map
 			     'mouse-2 #'mode-line-widen))
      (propertize ")%]--" 'help-echo help-echo)))
@@ -465,6 +473,7 @@
 		    'face 'Buffer-menu-buffer-face
 		    'help-echo
 		    (purecopy "mouse-1: previous buffer, mouse-3: next buffer")
+		    'mouse-face 'mode-line-highlight
 		    'local-map mode-line-buffer-identification-keymap)))
 
 (setq-default mode-line-buffer-identification

^ permalink raw reply	[flat|nested] 32+ messages in thread
end of thread, other threads:[~2005-05-30 17:20 UTC | newest]

Thread overview: 32+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2005-05-13 14:05 mouse-face on mode-line and header-line Masatake YAMATO
2005-05-13 15:45 ` Stefan Monnier
2005-05-22  2:39 ` Masatake YAMATO
2005-05-23 11:26   ` Masatake YAMATO
2005-05-23 16:26     ` Luc Teirlinck
2005-05-23 18:38       ` Masatake YAMATO
2005-05-23 21:37     ` Luc Teirlinck
2005-05-25  2:02       ` Luc Teirlinck
2005-05-24 10:26     ` Richard Stallman
2005-05-27 14:36     ` Juri Linkov
2005-05-27 14:54       ` Luc Teirlinck
2005-05-27 15:06         ` Masatake YAMATO
2005-05-27 15:59         ` Juri Linkov
2005-05-27 16:23           ` Masatake YAMATO
2005-05-23 21:25   ` Nick Roberts
2005-05-23 21:54     ` Juanma Barranquero
2005-05-24  4:41       ` Masatake YAMATO
2005-05-24  5:39         ` Nick Roberts
2005-05-24  5:47           ` Masatake YAMATO
2005-05-24 16:23             ` Luc Teirlinck
2005-05-24 16:57               ` Masatake YAMATO
2005-05-24 17:32                 ` Luc Teirlinck
2005-05-24  7:08         ` Juanma Barranquero
2005-05-24 10:27       ` Richard Stallman
2005-05-24 10:30         ` Juanma Barranquero
2005-05-27 14:14 ` Kim F. Storm
2005-05-27 17:01   ` Masatake YAMATO
2005-05-27 21:39   ` Nick Roberts
2005-05-27 22:01     ` Luc Teirlinck
2005-05-28  2:40       ` Masatake YAMATO
2005-05-27 17:37 ` Ralf Angeli
2005-05-30 17:20   ` Masatake YAMATO

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).