;; 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.
: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)))))
+ :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."
+make the clicked-on window taller or shorter.
+
+See also the variable `modeline-scrolling-method'."
(interactive "e")
(or (button-press-event-p event)
(error "%s must be invoked by a mouse-press" this-command))
(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)))
+ (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
;; scroll) nore Y pos (modeline drag) have changed.
(and modeline-click-swaps-buffers
(= depress-line (event-y event))
-;; (= start-hscroll (modeline-hscroll start-event-window))
+ (or (not modeline-scrolling-method)
+ (= start-hscroll
+ (modeline-hscroll start-event-window)))
(modeline-swap-buffers event)))
((button-event-p event)
(setq done t))
drag-divider-event-lag)
nil)
(t
-;; (set-modeline-hscroll start-event-window
-;; (+ (/ (- (event-x-pixel event)
-;; start-x-pixel)
-;; hscroll-delta)
-;; start-hscroll))
+ (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)))
+ ))
(setq last-timestamp (event-timestamp event)
y (event-y-pixel event)
edges (window-pixel-edges start-event-window)
"Handle mouse clicks on modeline by switching buffers.
If click on left half of a frame's modeline, bury current buffer.
If click on right half of a frame's modeline, raise bottommost buffer.
-Arg EVENT is the button release event that occured on the modeline."
+Arg EVENT is the button release event that occurred on the modeline."
(or (event-over-modeline-p event)
(error "not over a modeline"))
(or (button-release-event-p event)
(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
+ (set-face-foreground 'modeline-mousable
'(((default color x) . "firebrick")
((default color mswindows) . "firebrick"))
'global))
'(((default color x) . "green4")
((default color x) . "forestgreen")
((default color mswindows) . "green4")
- ((default color mswindows) . "forestgreen"))
+ ((default color mswindows) . "forestgreen"))
'global))
(defvar modeline-mousable-minor-mode-extent (make-extent nil nil)
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
"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
+ (set-face-foreground 'modeline-buffer-id
'(((default color x) . "blue4")
((default color mswindows) . "blue4"))
'global))
(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
(purecopy " ")
'global-mode-string
(purecopy " %[(")
- (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist))
- (cons modeline-narrowed-extent "%n")
+ (cons modeline-minor-mode-extent
+ (list (purecopy "") 'mode-name 'minor-mode-alist))
+ (cons modeline-narrowed-extent (purecopy "%n"))
'modeline-process
(purecopy ")%]----")
- (purecopy '(line-number-mode "L%l--"))
- (purecopy '(column-number-mode "C%c--"))
- (purecopy '(-3 . "%p"))
+ (list 'line-number-mode (purecopy "L%l--"))
+ (list 'column-number-mode (purecopy "C%c--"))
+ (cons -3 (purecopy "%p"))
(purecopy "-%-")))
;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be
projects / chise / xemacs-chise.git.1 / blobdiff