X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fmodeline.el;h=3e10878d94279232b1cece825de329989391c651;hp=43da2ae225d96e9ad793f6d833d2e30906819a6e;hb=5378ab6d2bb24fd8d39025be1574d406cf91f141;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910 diff --git a/lisp/modeline.el b/lisp/modeline.el index 43da2ae..3e10878 100644 --- a/lisp/modeline.el +++ b/lisp/modeline.el @@ -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. @@ -39,6 +39,23 @@ "Modeline customizations." :group 'environment) +(defcustom modeline-3d-p ;; added for the options menu + (let ((thickness + (specifier-instance modeline-shadow-thickness))) + (and (integerp thickness) + (> thickness 0))) + "Whether the default toolbar is globally visible. This option can be +customized through the options menu." + :group 'display + :type 'boolean + :set #'(lambda (var val) + (if val + (set-specifier modeline-shadow-thickness 2) + (set-specifier modeline-shadow-thickness 0)) + (redraw-modeline t) + (setq modeline-3d-p val)) + ) + (defcustom drag-divider-event-lag 150 "*The pause (in msecs) between divider drag events before redisplaying. If this value is too small, dragging will be choppy because redisplay cannot @@ -59,11 +76,52 @@ buffer list and clicking on the right half cycles backward." :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." +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)) @@ -79,8 +137,8 @@ make the clicked-on window taller or shorter." (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 @@ -141,7 +199,9 @@ make the clicked-on window taller or shorter." ;; 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)) @@ -153,11 +213,14 @@ make the clicked-on window taller or shorter." 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) @@ -220,7 +283,7 @@ make the clicked-on window taller or shorter." "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) @@ -263,13 +326,9 @@ the buffer of the window whose modeline was clicked upon.") (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 - '(((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))) + (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))) (defmacro make-modeline-command-wrapper (command) `#'(lambda (event) @@ -303,12 +362,8 @@ in the list takes precedence.") (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil '(default)) (when (featurep 'window-system) - (set-face-foreground 'modeline-mousable-minor-mode - '(((default color x) . "green4") - ((default color x) . "forestgreen") - ((default color mswindows) . "green4") - ((default color mswindows) . "forestgreen")) - 'global)) + (set-face-foreground 'modeline-mousable-minor-mode '("green4" "forestgreen") + nil '(default color win))) (defvar modeline-mousable-minor-mode-extent (make-extent nil nil) ;; alliteration at its finest. @@ -391,7 +446,7 @@ Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" 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 @@ -508,20 +563,16 @@ parentheses on the modeline." "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 - '(((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))) + (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))) (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 @@ -537,12 +588,17 @@ parentheses on the modeline." "button2 cycles to the next buffer") (defconst modeline-buffer-identification - (list (cons modeline-buffer-id-left-extent (purecopy "XEmacs%N:")) + (list (cons modeline-buffer-id-left-extent "XEmacs%N:") ; this used to be "XEmacs:" - (cons modeline-buffer-id-right-extent (purecopy " %17b"))) + (cons modeline-buffer-id-right-extent " %17b")) "Modeline control for identifying the buffer being displayed. -Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things -other than ordinary files may change this (e.g. Info, Dired,...)") +Its default value is + + (list (cons modeline-buffer-id-left-extent \"XEmacs%N:\") + (cons modeline-buffer-id-right-extent \" %17b\"))) + +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 @@ -570,7 +626,7 @@ Normally nil in most modes, since there is no process to display.") (set-extent-property modeline-modified-extent 'help-echo "button2 toggles the buffer's read-only status") -(defconst modeline-modified (purecopy '("--%1*%1+-")) +(defconst modeline-modified '("--%1*%1+-") "Modeline control for displaying whether current buffer is modified.") (make-variable-buffer-local 'modeline-modified) @@ -589,20 +645,21 @@ Normally nil in most modes, since there is no process to display.") (setq-default modeline-format (list - (purecopy "") + "" (cons modeline-modified-extent 'modeline-modified) (cons modeline-buffer-id-extent 'modeline-buffer-identification) - (purecopy " ") + " " 'global-mode-string - (purecopy " %[(") - (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist)) + " %[(" + (cons modeline-minor-mode-extent + (list "" 'mode-name 'minor-mode-alist)) (cons modeline-narrowed-extent "%n") 'modeline-process - (purecopy ")%]----") - (purecopy '(line-number-mode "L%l--")) - (purecopy '(column-number-mode "C%c--")) - (purecopy '(-3 . "%p")) - (purecopy "-%-"))) + ")%]----" + (list 'line-number-mode "L%l--") + (list 'column-number-mode "C%c--") + (cons -3 "%p") + "-%-")) ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be ;;; present, and its symbols are not visible this early in the dump if it