From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Masatake YAMATO Newsgroups: gmane.emacs.devel Subject: mouse-face on mode-line and header-line Date: Fri, 13 May 2005 23:05:46 +0900 (JST) Message-ID: <20050513.230546.243438712.jet@gyve.org> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: Text/Plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: sea.gmane.org 1115994425 30451 80.91.229.2 (13 May 2005 14:27:05 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Fri, 13 May 2005 14:27:05 +0000 (UTC) Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri May 13 16:27:00 2005 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1DWb7E-00004v-Mv for ged-emacs-devel@m.gmane.org; Fri, 13 May 2005 16:26:13 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1DWbGO-0000LG-Ab for ged-emacs-devel@m.gmane.org; Fri, 13 May 2005 10:35:40 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1DWb7O-00087P-O9 for emacs-devel@gnu.org; Fri, 13 May 2005 10:26:23 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1DWb7E-0007zZ-CL for emacs-devel@gnu.org; Fri, 13 May 2005 10:26:17 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1DWb7C-0007rO-VR for emacs-devel@gnu.org; Fri, 13 May 2005 10:26:11 -0400 Original-Received: from [66.187.233.31] (helo=mx1.redhat.com) by monty-python.gnu.org with esmtp (TLS-1.0:DHE_RSA_3DES_EDE_CBC_SHA:24) (Exim 4.34) id 1DWb06-00018s-2j for emacs-devel@gnu.org; Fri, 13 May 2005 10:18:50 -0400 Original-Received: from int-mx1.corp.redhat.com (int-mx1.corp.redhat.com [172.16.52.254]) by mx1.redhat.com (8.12.11/8.12.11) with ESMTP id j4DEBa5w020135 for ; Fri, 13 May 2005 10:11:38 -0400 Original-Received: from pobox.tokyo.redhat.com (pobox.tokyo.redhat.com [172.16.33.225]) by int-mx1.corp.redhat.com (8.11.6/8.11.6) with ESMTP id j4DEBXO08777 for ; Fri, 13 May 2005 10:11:33 -0400 Original-Received: from localhost (gls07.tokyo.redhat.com [172.16.32.104]) by pobox.tokyo.redhat.com (8.12.8/8.12.8) with ESMTP id j4DEBRv7009416 for ; Fri, 13 May 2005 23:11:31 +0900 Original-To: emacs-devel@gnu.org X-Mailer: Mew version 4.2 on Emacs 22.0.50 / Mule 5.0 (SAKAKI) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:37079 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:37079 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 * 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 * 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