;;; modeline.el --- modeline hackery.;; Copyright (C) 1988, 1992-1994, 1997 Free Software Foundation, Inc.;; Copyright (C) 1995, 1996 Ben Wing.;; Maintainer: XEmacs Development Team;; Keywords: extensions, dumped;; This file is part of XEmacs.;; XEmacs is free software; you can redistribute it and/or modify it;; under the terms of the GNU General Public License as published by;; the Free Software Foundation; either version 2, or (at your option);; any later version.;; XEmacs is distributed in the hope that it will be useful, but;; WITHOUT ANY WARRANTY; without even the implied warranty of;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU;; 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 ;; Free Software Foundation, 59 Temple Place - Suite 330,;; Boston, MA 02111-1307, USA.;;; Synched up with: Not in FSF.;;; Commentary:;; This file is dumped with XEmacs.;;; Code:;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; General mouse modeline stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defgroupmodelinenil"Modeline customizations.":group'environment)(defcustomdrag-divider-event-lag150"*The pause (in msecs) between divider drag events before redisplaying.If this value is too small, dragging will be choppy because redisplay cannotkeep up. If it is too large, dragging will be choppy because of the explicitredisplay delay specified.":type'integer;; #### Fix group.:group'modeline)(define-obsolete-variable-alias'drag-modeline-event-lag'drag-divider-event-lag)(defcustommodeline-click-swaps-buffersnil"*If non-nil, clicking on the modeline changes the current buffer.Click on the left half of the modeline cycles forward through thebuffer list and clicking on the right half cycles backward.":type'boolean:group'modeline)(defunmouse-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 willmake the clicked-on window taller or shorter."(interactive"e")(or(button-press-event-pevent)(error"%s must be invoked by a mouse-press"this-command))(or(event-over-modeline-pevent)(error"not over a modeline"));; Give the modeline a "pressed" look. --hniksic(let-specifier((modeline-shadow-thickness(-(specifier-instancemodeline-shadow-thickness(event-windowevent)))(event-windowevent)))(let((donenil)(depress-line(event-yevent))(start-event-frame(event-frameevent))(start-event-window(event-windowevent))(start-nwindows(count-windowst));; (hscroll-delta (face-width 'modeline));; (start-hscroll (modeline-hscroll (event-window event))); (start-x-pixel (event-x-pixel event))(last-timestamp0)default-line-heightmodeline-heightshould-enlarge-minibuffereventmin-heightminibufferytopbotedgeswconfiggrowth)(setqminibuffer(minibuffer-windowstart-event-frame)default-line-height(face-height'defaultstart-event-window)min-height(+(*window-min-heightdefault-line-height);; Don't let the window shrink by a;; non-multiple of the default line;; height. (enlarge-window -1) will do;; this if the difference between the;; current window height and the minimum;; window height is less than the height;; of the default font. These extra;; lost pixels of height don't come back;; if you grow the window again. This;; can make it impossible to drag back;; to the exact original size, which is;; disconcerting.(%(window-pixel-heightstart-event-window)default-line-height))modeline-height(if(specifier-instancehas-modeline-pstart-event-window)(+(face-height'modelinestart-event-window)(*2(specifier-instancemodeline-shadow-thicknessstart-event-window)))(*2(specifier-instancemodeline-shadow-thicknessstart-event-window))))(if(not(eq(window-frameminibuffer)start-event-frame))(setqminibuffernil))(if(and(nullminibuffer)(one-window-pt))(error"Attempt to resize sole window"));; if this is the bottommost ordinary window, then to;; move its modeline the minibuffer must be enlarged.(setqshould-enlarge-minibuffer(andminibuffer(window-lowest-pstart-event-window)));; loop reading events(while(notdone)(setqevent(next-eventevent));; requeue event and quit if this is a misc-user, eval or;; keypress event.;; quit if this is a button press or release event, or if the event;; occurred in some other frame.;; drag if this is a mouse motion event and the time;; between this event and the last event is greater than;; drag-divider-event-lag.;; do nothing if this is any other kind of event.(cond((or(misc-user-event-pevent)(key-press-event-pevent))(setqunread-command-events(nconcunread-command-events(listevent))donet))((button-release-event-pevent)(setqdonet);; Consider we have a mouse click neither X pos (modeline;; scroll) nore Y pos (modeline drag) have changed.(andmodeline-click-swaps-buffers(=depress-line(event-yevent));; (= start-hscroll (modeline-hscroll start-event-window))(modeline-swap-buffersevent)))((button-event-pevent)(setqdonet))((not(motion-event-pevent))(dispatch-eventevent))((not(eqstart-event-frame(event-frameevent)))(setqdonet))((<(abs(-(event-timestampevent)last-timestamp))drag-divider-event-lag)nil)(t;; (set-modeline-hscroll start-event-window;; (+ (/ (- (event-x-pixel event) ;; start-x-pixel);; hscroll-delta);; start-hscroll))(setqlast-timestamp(event-timestampevent)y(event-y-pixelevent)edges(window-pixel-edgesstart-event-window)top(nth1edges)bot(nth3edges));; scale back a move that would make the;; window too short.(cond((<(-ytop(-modeline-height))min-height)(setqy(+topmin-height(-modeline-height)))));; compute size change needed(setqgrowth(-ybot(/(-modeline-height)2))wconfig(current-window-configuration));; grow/shrink minibuffer?(ifshould-enlarge-minibuffer(progn;; yes. scale back shrinkage if it;; would make the minibuffer less than 1;; line tall.;;;; also flip the sign of the computed growth,;; since if we want to grow the window with the;; modeline we need to shrink the minibuffer;; and vice versa.(if(and(>growth0)(<(-(window-pixel-heightminibuffer)growth)default-line-height))(setqgrowth(-(window-pixel-heightminibuffer)default-line-height)))(setqgrowth(-growth))));; window grow and shrink by lines not pixels, so;; divide the pixel height by the height of the;; default face.(setqgrowth(/growthdefault-line-height));; grow/shrink the window(enlarge-windowgrowthnil(ifshould-enlarge-minibufferminibufferstart-event-window));; if this window's growth caused another;; window to be deleted because it was too;; short, rescind the change.;;;; if size change caused space to be stolen;; from a window above this one, rescind the;; change, but only if we didn't grow/shrink;; the minibuffer. minibuffer size changes;; can cause all windows to shrink... no way;; around it.(if(or(/=start-nwindows(count-windowst))(and(notshould-enlarge-minibuffer)(/=top(nth1(window-pixel-edgesstart-event-window)))))(set-window-configurationwconfig))))))));; from Bob Weiner (bob_weiner@pts.mot.com);; Whether this function should be called is now decided in;; mouse-drag-modeline - dverna feb. 98(defunmodeline-swap-buffers(event)"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 occurred on the modeline."(or(event-over-modeline-pevent)(error"not over a modeline"))(or(button-release-event-pevent)(error"not a button release event"))(if(<(event-xevent)(/(window-width(event-windowevent))2));; On left half of modeline, bury current buffer,;; displaying second buffer on list.(mouse-bury-bufferevent);; On right half of modeline, raise and display bottommost;; buffer in buffer list.(mouse-unbury-bufferevent)))(defconstmodeline-menu'("Window Commands"["Delete Window Above"delete-windowt]["Delete Other Windows"delete-other-windowst]["Split Window Above"split-window-verticallyt]["Split Window Horizontally"split-window-horizontallyt]["Balance Windows"balance-windowst]))(defunmodeline-menu(event)(interactive"e")(popup-menu-and-execute-in-window(cons(format"Window Commands for %S:"(buffer-name(event-bufferevent)))(cdrmodeline-menu))event))(defvarmodeline-map(make-sparse-keymap'modeline-map)"Keymap consulted for mouse-clicks on the modeline of a window.This variable may be buffer-local; its value will be looked up inthe buffer of the window whose modeline was clicked upon.")(define-keymodeline-map'button1'mouse-drag-modeline);; button2 selects the window without setting point(define-keymodeline-map'button2(lambda()(interactive"@")))(define-keymodeline-map'button3'modeline-menu)(make-face'modeline-mousable"Face for mousable portions of the modeline.")(set-face-parent'modeline-mousable'modelinenil'(default))(when(featurep'window-system)(set-face-foreground'modeline-mousable'(((defaultcolorx)."firebrick")((defaultcolormswindows)."firebrick"))'global))(when(featurep'x)(set-face-font'modeline-mousable[bold]nil'(defaultmonox))(set-face-font'modeline-mousable[bold]nil'(defaultgrayscalex)))(defmacromake-modeline-command-wrapper(command)`#'(lambda(event)(interactive"e")(save-selected-window(select-window(event-windowevent))(call-interactively',(evalcommand)))));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Minor modes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defvarminor-mode-alistnil"Alist saying how to show minor modes in the modeline.Each element looks like (VARIABLE STRING);STRING is included in the modeline iff VARIABLE's value is non-nil.Actually, STRING need not be a string; any possible modeline elementis okay. See `modeline-format'.");; Used by C code (lookup-key and friends) but defined here.(defvarminor-mode-map-alistnil"Alist of keymaps to use for minor modes.Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to readkey sequences and look up bindings iff VARIABLE's value is non-nil.If two active keymaps bind the same key, the keymap appearing earlierin the list takes precedence.")(make-face'modeline-mousable-minor-mode"Face for mousable minor-mode strings in the modeline.")(set-face-parent'modeline-mousable-minor-mode'modeline-mousablenil'(default))(when(featurep'window-system)(set-face-foreground'modeline-mousable-minor-mode'(((defaultcolorx)."green4")((defaultcolorx)."forestgreen")((defaultcolormswindows)."green4")((defaultcolormswindows)."forestgreen"))'global))(defvarmodeline-mousable-minor-mode-extent(make-extentnilnil);; alliteration at its finest."Extent managing the mousable minor mode modeline strings.")(set-extent-facemodeline-mousable-minor-mode-extent'modeline-mousable-minor-mode);; This replaces the idiom;;;; (or (assq 'isearch-mode minor-mode-alist);; (setq minor-mode-alist;; (purecopy;; (append minor-mode-alist;; '((isearch-mode isearch-mode))))))(defunadd-minor-mode(togglename&optionalkeymapaftertoggle-fun)"Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.TOGGLE is a symbol whose value as a variable specifies whether theminor mode is active.NAME is the name that should appear in the modeline. It should eitherbe a string beginning with a space, or a symbol with a similar stringas its value.KEYMAP is a keymap to make active when the minor mode is active.AFTER is the toggling symbol used for another minor mode. If AFTER isnon-nil, then it is used to position the new mode in the minor-modealists.TOGGLE-FUN specifies an interactive function that is called to togglethe mode on and off; this affects what happens when button2 is pressedon the mode, and when button3 is pressed somewhere in the list ofmodes. If TOGGLE-FUN is nil and TOGGLE names an interactive function,TOGGLE is used as the toggle function.Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"(let*((add-elt#'(lambda(eltsym)(let(place)(cond((nullafter); add to front(pushelt(symbol-valuesym)))((and(not(eqaftert))(setqplace(memq(assqafter(symbol-valuesym))(symbol-valuesym))))(pushelt(cdrplace)))(t(setsym(append(symbol-valuesym)(listelt))))))(symbol-valuesym)))eltoggle-keymap)(iftoggle-fun(check-argument-type'commandptoggle-fun)(when(commandptoggle)(setqtoggle-funtoggle)))(when(andtoggle-funname)(setqtoggle-keymap(make-sparse-keymap(intern(concat"modeline-minor-"(symbol-nametoggle)"-map"))))(define-keytoggle-keymap'button2;; defeat the DUMB-ASS byte-compiler, which tries to;; expand the macro at compile time and fucks up.(eval'(make-modeline-command-wrappertoggle-fun)))(puttoggle'modeline-toggle-functiontoggle-fun))(whenname(let((hacked-name(iftoggle-keymap(cons(let((extent(make-extentnilnil)))(set-extent-keymapextenttoggle-keymap)(set-extent-propertyextent'help-echo(concat"button2 turns off "(if(symbolptoggle-fun)(symbol-nametoggle-fun)(symbol-nametoggle))))extent)(consmodeline-mousable-minor-mode-extentname))name)))(if(setqel(assqtoggleminor-mode-alist))(setcdrel(listhacked-name))(funcalladd-elt(listtogglehacked-name)'minor-mode-alist))))(whenkeymap(if(setqel(assqtoggleminor-mode-map-alist))(setcdrelkeymap)(funcalladd-elt(constogglekeymap)'minor-mode-map-alist)))));; #### TODO: Add `:menu-tag' keyword to add-minor-mode. Or create a;; separate function to manage the minor mode menu.;(put 'abbrev-mode :menu-tag "Abbreviation Expansion")(add-minor-mode'abbrev-mode" Abbrev");; only when visiting a file...(add-minor-mode'overwrite-mode'overwrite-mode);(put 'auto-fill-function :menu-tag "Auto Fill")(add-minor-mode'auto-fill-function" Fill"nilnil'auto-fill-mode);(put 'defining-kbd-macro :menu-tag "Keyboard Macro")(add-minor-mode'defining-kbd-macro" Def"nilnil(lambda()(interactive)(ifdefining-kbd-macro(progn;; #### This means to disregard the last event.;; It is needed because the last recorded;; event is usually the mouse event that;; invoked the menu item (and this function),;; and having it in the macro causes problems.(zap-last-kbd-macro-event)(end-kbd-macronil))(start-kbd-macronil))))(defunmodeline-minor-mode-menu(event)"The menu that pops up when you press `button3' inside theparentheses on the modeline."(interactive"e")(save-excursion(set-buffer(event-bufferevent))(popup-menu-and-execute-in-window(cons"Minor Mode Toggles"(sort(delqnil(mapcar#'(lambda(x)(let*((toggle-sym(carx))(toggle-fun(or(gettoggle-sym'modeline-toggle-function)(and(commandptoggle-sym)toggle-sym)))(menu-tag(symbol-name(if(symbolptoggle-fun)toggle-funtoggle-sym));; Here a function should;; maybe be invoked to;; beautify the symbol's;; menu appearance.))(andtoggle-fun(vectormenu-tagtoggle-fun;; The following two are wrong;; because of possible name;; clashes.;:active (get toggle-sym :active t);:included (get toggle-sym :included t):style'toggle:selected(and(boundptoggle-sym)toggle-sym)))))minor-mode-alist))(lambda(e1e2)(string<(arefe10)(arefe20)))))event)))(defvarmodeline-minor-mode-map(make-sparse-keymap'modeline-minor-mode-map)"Keymap consulted for mouse-clicks on the minor-mode modeline list.")(define-keymodeline-minor-mode-map'button3'modeline-minor-mode-menu)(defvarmodeline-minor-mode-extent(make-extentnilnil)"Extent covering the minor mode modeline strings.")(set-extent-facemodeline-minor-mode-extent'modeline-mousable)(set-extent-keymapmodeline-minor-mode-extentmodeline-minor-mode-map);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Other ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defunmodeline-buffers-menu(event)(interactive"e")(popup-menu-and-execute-in-window'("Buffers Popup Menu":filterbuffers-menu-filter["List All Buffers"list-bufferst]"--")event))(defvarmodeline-buffer-id-left-map(make-sparse-keymap'modeline-buffer-id-left-map)"Keymap consulted for mouse-clicks on the left half of the buffer-id string.")(defvarmodeline-buffer-id-right-map(make-sparse-keymap'modeline-buffer-id-right-map)"Keymap consulted for mouse-clicks on the right half of the buffer-id string.")(define-keymodeline-buffer-id-left-map'button2'mouse-unbury-buffer)(define-keymodeline-buffer-id-right-map'button2'mouse-bury-buffer)(define-keymodeline-buffer-id-left-map'button3'modeline-buffers-menu)(define-keymodeline-buffer-id-right-map'button3'modeline-buffers-menu)(make-face'modeline-buffer-id"Face for the buffer ID string in the modeline.")(set-face-parent'modeline-buffer-id'modelinenil'(default))(when(featurep'window-system)(set-face-foreground'modeline-buffer-id'(((defaultcolorx)."blue4")((defaultcolormswindows)."blue4"))'global))(when(featurep'x)(set-face-font'modeline-buffer-id[bold-italic]nil'(defaultmonox))(set-face-font'modeline-buffer-id[bold-italic]nil'(defaultgrayscalex)))(when(featurep'tty)(set-face-font'modeline-buffer-id[bold-italic]nil'(defaulttty)))(defvarmodeline-buffer-id-extent(make-extentnilnil)"Extent covering the whole of the buffer-id string.")(set-extent-facemodeline-buffer-id-extent'modeline-buffer-id)(defvarmodeline-buffer-id-left-extent(make-extentnilnil)"Extent covering the left half of the buffer-id string.")(set-extent-keymapmodeline-buffer-id-left-extentmodeline-buffer-id-left-map)(set-extent-propertymodeline-buffer-id-left-extent'help-echo"button2 cycles to the previous buffer")(defvarmodeline-buffer-id-right-extent(make-extentnilnil)"Extent covering the right half of the buffer-id string.")(set-extent-keymapmodeline-buffer-id-right-extentmodeline-buffer-id-right-map)(set-extent-propertymodeline-buffer-id-right-extent'help-echo"button2 cycles to the next buffer")(defconstmodeline-buffer-identification(list(consmodeline-buffer-id-left-extent(purecopy"XEmacs%N:")); this used to be "XEmacs:"(consmodeline-buffer-id-right-extent(purecopy" %17b")))"Modeline control for identifying the buffer being displayed.Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit thingsother 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;; kind of dirty. `add-minor-mode' started out as a simple substitute;; for (or (assq ...) ...) FSF stuff, but now is used for all kind of;; stuff. There should perhaps be a separate function to add toggles;; to the minor-mode-menu.(add-minor-mode'line-number-mode"")(add-minor-mode'column-number-mode"")(defconstmodeline-processnil"Modeline control for displaying info on process status.Normally nil in most modes, since there is no process to display.")(make-variable-buffer-local'modeline-process)(defvarmodeline-modified-map(make-sparse-keymap'modeline-modified-map)"Keymap consulted for mouse-clicks on the modeline-modified string.")(define-keymodeline-modified-map'button2(make-modeline-command-wrapper'modeline-toggle-read-only))(defvarmodeline-modified-extent(make-extentnilnil)"Extent covering the modeline-modified string.")(set-extent-facemodeline-modified-extent'modeline-mousable)(set-extent-keymapmodeline-modified-extentmodeline-modified-map)(set-extent-propertymodeline-modified-extent'help-echo"button2 toggles the buffer's read-only status")(defconstmodeline-modified(purecopy'("--%1*%1+-"))"Modeline control for displaying whether current buffer is modified.")(make-variable-buffer-local'modeline-modified)(defvarmodeline-narrowed-map(make-sparse-keymap'modeline-narrowed-map)"Keymap consulted for mouse-clicks on the modeline-narrowed string.")(define-keymodeline-narrowed-map'button2(make-modeline-command-wrapper'widen))(defvarmodeline-narrowed-extent(make-extentnilnil)"Extent covering the modeline-narrowed string.")(set-extent-facemodeline-narrowed-extent'modeline-mousable)(set-extent-keymapmodeline-narrowed-extentmodeline-narrowed-map)(set-extent-propertymodeline-narrowed-extent'help-echo"button2 widens the buffer")(setq-defaultmodeline-format(list(purecopy"")(consmodeline-modified-extent'modeline-modified)(consmodeline-buffer-id-extent'modeline-buffer-identification)(purecopy" ")'global-mode-string(purecopy" %[(")(consmodeline-minor-mode-extent(list(purecopy"")'mode-name'minor-mode-alist))(consmodeline-narrowed-extent(purecopy"%n"))'modeline-process(purecopy")%]----")(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;;; present, and its symbols are not visible this early in the dump if it;;; is.(defunmodeline-toggle-read-only()"Change whether this buffer is visiting its file read-only.With arg, set read-only iff arg is positive.This function is designed to be called when the read-only indicator on themodeline is clicked. It will call `vc-toggle-read-only' if available,otherwise it will call the usual `toggle-read-only'."(interactive)(if(fboundp'vc-toggle-read-only)(vc-toggle-read-only)(toggle-read-only)));;; modeline.el ends here