diff lisp/modeline.el @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents b8cc9ab3f761
children 11054d720c21
line wrap: on
line diff
--- a/lisp/modeline.el	Mon Aug 13 11:19:22 2007 +0200
+++ b/lisp/modeline.el	Mon Aug 13 11:20:41 2007 +0200
@@ -19,7 +19,7 @@
 ;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the
+;; along with XEmacs; see the file COPYING.  If not, write to the 
 ;; Free Software Foundation, 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
@@ -59,52 +59,11 @@
   :type 'boolean
   :group 'modeline)
 
-(defcustom modeline-scrolling-method nil
-  "*If non-nil, dragging the modeline with the mouse may also scroll its
-text horizontally (vertical motion controls window resizing and horizontal
-motion controls modeline scrolling).
-
-With a value of t, the modeline text is scrolled in the same direction as
-the mouse motion. With a value of 'scrollbar, the modeline is considered as
-a scrollbar for its own text, which then moves in the opposite direction."
-  :type '(choice (const :tag "none" nil)
-		 (const :tag "text" t)
-		 (const :tag "scrollbar" scrollbar))
-  :set (lambda (sym val)
-	 (set-default sym val)
-	 (when (featurep 'x)
-	   (cond ((eq val t)
-		  (set-glyph-image modeline-pointer-glyph "hand2" 'global 'x))
-		 ((eq val 'scrollbar)
-		  (set-glyph-image modeline-pointer-glyph "fleur" 'global 'x))
-		 (t
-		  (set-glyph-image modeline-pointer-glyph "sb_v_double_arrow"
-				   'global 'x))))
-	 (when (featurep 'mswindows)
-	   (cond ((eq val t)
-		  (set-glyph-image modeline-pointer-glyph
-				   [mswindows-resource :resource-type cursor
-						       :resource-id "SizeAll"]
-				   'global 'mswindows))
-		 ((eq val 'scrollbar)
-		  (set-glyph-image modeline-pointer-glyph
-				   [mswindows-resource :resource-type cursor
-						       :resource-id "Normal"]
-				   'global 'mswindows))
-		 (t
-		  (set-glyph-image modeline-pointer-glyph
-				   [mswindows-resource :resource-type cursor
-						       :resource-id "SizeNS"]
-				   'global 'mswindows)))))
-  :group 'modeline)
-
 (defun mouse-drag-modeline (event)
   "Resize a window by dragging its modeline.
 This command should be bound to a button-press event in modeline-map.
 Holding down a mouse button and moving the mouse up and down will
-make the clicked-on window taller or shorter.
-
-See also the variable `modeline-scrolling-method'."
+make the clicked-on window taller or shorter."
   (interactive "e")
   (or (button-press-event-p event)
       (error "%s must be invoked by a mouse-press" this-command))
@@ -120,9 +79,9 @@
 	  (start-event-frame (event-frame event))
 	  (start-event-window (event-window event))
 	  (start-nwindows (count-windows t))
-	  (hscroll-delta (face-width 'modeline))
-	  (start-hscroll (modeline-hscroll (event-window event)))
-	  (start-x-pixel (event-x-pixel event))
+;;	  (hscroll-delta (face-width 'modeline))
+;;	  (start-hscroll (modeline-hscroll (event-window event)))
+;	  (start-x-pixel (event-x-pixel event))
 	  (last-timestamp 0)
 	  default-line-height
 	  modeline-height
@@ -182,9 +141,7 @@
 	       ;; scroll) nore Y pos (modeline drag) have changed.
 	       (and modeline-click-swaps-buffers
 		    (= depress-line (event-y event))
-		    (or (not modeline-scrolling-method)
-			(= start-hscroll
-			   (modeline-hscroll start-event-window)))
+;;		    (= start-hscroll (modeline-hscroll start-event-window))
 		    (modeline-swap-buffers event)))
 	      ((button-event-p event)
 	       (setq done t))
@@ -196,14 +153,11 @@
 		  drag-divider-event-lag)
 	       nil)
 	      (t
-	       (when modeline-scrolling-method
-		 (let ((delta (/ (- (event-x-pixel event) start-x-pixel)
-				 hscroll-delta)))
-		   (set-modeline-hscroll start-event-window
-					 (if (eq modeline-scrolling-method t)
-					     (- start-hscroll delta)
-					   (+ start-hscroll delta)))
-		   ))
+;;		 (set-modeline-hscroll start-event-window
+;;				       (+ (/ (- (event-x-pixel event) 
+;;						start-x-pixel)
+;;					     hscroll-delta)
+;;					  start-hscroll))
 	       (setq last-timestamp (event-timestamp event)
 		     y (event-y-pixel event)
 		     edges (window-pixel-edges start-event-window)
@@ -309,9 +263,13 @@
 (make-face 'modeline-mousable "Face for mousable portions of the modeline.")
 (set-face-parent 'modeline-mousable 'modeline nil '(default))
 (when (featurep 'window-system)
-  (set-face-foreground 'modeline-mousable "firebrick" nil '(default color win))
-  (set-face-font 'modeline-mousable [bold] nil '(default mono win))
-  (set-face-font 'modeline-mousable [bold] nil '(default grayscale win)))
+  (set-face-foreground 'modeline-mousable 
+		       '(((default color x) . "firebrick")
+			 ((default color mswindows) . "firebrick"))
+			 'global))
+(when (featurep 'x)
+  (set-face-font 'modeline-mousable [bold] nil '(default mono x))
+  (set-face-font 'modeline-mousable [bold] nil '(default grayscale x)))
 
 (defmacro make-modeline-command-wrapper (command)
   `#'(lambda (event)
@@ -345,8 +303,12 @@
 (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil
 		 '(default))
 (when (featurep 'window-system)
-  (set-face-foreground 'modeline-mousable-minor-mode '("green4" "forestgreen")
-		       nil '(default color win)))
+  (set-face-foreground 'modeline-mousable-minor-mode
+		       '(((default color x) . "green4")
+			 ((default color x) . "forestgreen")
+			 ((default color mswindows) . "green4")
+			 ((default color mswindows) . "forestgreen")) 
+		       'global))
 
 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil)
   ;; alliteration at its finest.
@@ -429,7 +391,7 @@
 	       name)))
 	(if (setq el (assq toggle minor-mode-alist))
 	    (setcdr el (list hacked-name))
-	  (funcall add-elt
+	  (funcall add-elt 
 		   (list toggle hacked-name)
 		   'minor-mode-alist))))
     (when keymap
@@ -546,16 +508,20 @@
 	   "Face for the buffer ID string in the modeline.")
 (set-face-parent 'modeline-buffer-id 'modeline nil '(default))
 (when (featurep 'window-system)
-  (set-face-foreground 'modeline-buffer-id "blue4" nil '(default color win))
-  (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono win))
-  (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale win)))
+  (set-face-foreground 'modeline-buffer-id 
+		       '(((default color x) . "blue4")
+			 ((default color mswindows) . "blue4"))
+		       'global))
+(when (featurep 'x)
+  (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono x))
+  (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale x)))
 (when (featurep 'tty)
   (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty)))
 
 (defvar modeline-buffer-id-extent (make-extent nil nil)
   "Extent covering the whole of the buffer-id string.")
 (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id)
-
+  
 (defvar modeline-buffer-id-left-extent (make-extent nil nil)
 "Extent covering the left half of the buffer-id string.")
 (set-extent-keymap modeline-buffer-id-left-extent
@@ -575,13 +541,8 @@
 					; this used to be "XEmacs:"
 	(cons modeline-buffer-id-right-extent (purecopy " %17b")))
   "Modeline control for identifying the buffer being displayed.
-Its default value is
-
-  (list (cons modeline-buffer-id-left-extent (purecopy \"XEmacs%N:\"))
-	(cons modeline-buffer-id-right-extent (purecopy \" %17b\")))
-
-Major modes that edit things other than ordinary files may change this
-(e.g. Info, Dired,...).")
+Its default value is \"XEmacs: %17b\" (NOT!).  Major modes that edit things
+other than ordinary files may change this (e.g. Info, Dired,...)")
 (make-variable-buffer-local 'modeline-buffer-identification)
 
 ;; These are for the sake of minor mode menu.  #### All of this is
@@ -634,14 +595,13 @@
   (purecopy "   ")
   'global-mode-string
   (purecopy "   %[(")
-  (cons modeline-minor-mode-extent
-	(list (purecopy "") 'mode-name 'minor-mode-alist))
-  (cons modeline-narrowed-extent (purecopy "%n"))
+  (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist))
+  (cons modeline-narrowed-extent "%n")
   'modeline-process
   (purecopy ")%]----")
-  (list 'line-number-mode (purecopy "L%l--"))
-  (list 'column-number-mode (purecopy "C%c--"))
-  (cons -3 (purecopy "%p"))
+  (purecopy '(line-number-mode "L%l--"))
+  (purecopy '(column-number-mode "C%c--"))
+  (purecopy '(-3 . "%p"))
   (purecopy "-%-")))
 
 ;;; Added for XEmacs 20.3.  Provide wrapper for vc since it may not always be