;;; electric.el --- window maker and Command loop for `electric' modes.;; Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc.;; Author: K. Shane Hartman;; Maintainer: FSF;; Keywords: extensions;; 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, Inc., 59 Temple Place - Suite 330, Boston, MA;; 02111-1307, USA.;;; Synched up with: FSF 19.34.;;; Commentary:; zaaaaaaap;;; Code:;; This loop is the guts for non-standard modes which retain control;; until some event occurs. It is a `do-forever', the only way out is;; to throw. It assumes that you have set up the keymap, window, and;; everything else: all it does is read commands and execute them -;; providing error messages should one occur (if there is no loop;; function - which see). The required argument is a tag which should;; expect a value of nil if the user decides to punt. The second;; argument is the prompt to be used: if nil, use "->", if 'noprompt,;; don't use a prompt, if a string, use that string as prompt, and if;; a function of no variable, it will be evaluated in every iteration;; of the loop and its return value, which can be nil, 'noprompt or a;; string, will be used as prompt. Given third argument non-nil, it;; INHIBITS quitting unless the user types C-g at toplevel. This is;; so user can do things like C-u C-g and not get thrown out. Fourth;; argument, if non-nil, should be a function of two arguments which;; is called after every command is executed. The fifth argument, if;; provided, is the state variable for the function. If the;; loop-function gets an error, the loop will abort WITHOUT throwing;; (moral: use unwind-protect around call to this function for any;; critical stuff). The second argument for the loop function is the;; conditions for any error that occurred or nil if none.(defunElectric-command-loop(return-tag&optionalpromptinhibit-quitloop-functionloop-state)(let(cmd(errnil)(electrified-buffer(current-buffer)); XEmacs -(prompt-stringprompt))(whilet(if(not(or(stringpprompt)(eqpromptnil)(eqprompt'noprompt)))(setqprompt-string(funcallprompt)))(if(not(stringpprompt-string))(if(eqprompt-string'noprompt)(setqprompt-stringnil)(setqprompt-string"->")))(setqcmd(read-key-sequenceprompt-string));; XEmacs(orprefix-arg(setqlast-commandthis-command))(setqlast-command-event(arefcmd(1-(lengthcmd)))current-mouse-event(and(or(button-press-event-plast-command-event)(button-release-event-plast-command-event)(misc-user-event-plast-command-event))last-command-event)this-command(if(misc-user-event-plast-command-event)last-command-event(key-bindingcmdt))cmdthis-command);; This makes universal-argument-other-key work.(setquniversal-argument-num-events0)(if(or(prog1quit-flag(setqquit-flagnil));; XEmacs(eq(event-to-characterlast-input-event)(quit-char)))(progn(setqunread-command-eventsnilprefix-argnil);; If it wasn't cancelling a prefix character, then quit.(if(or(=(length(this-command-keys))1)(notinhibit-quit)); safety(progn(dingnil'quit); XEmacs - (message"Quit")(throwreturn-tagnil))(setqcmdnil))))(setqcurrent-prefix-argprefix-arg)(ifcmd(condition-caseconditions;; XEmacs(progn(if(eventpcmd)(progn(let((b(current-buffer)))(dispatch-eventcmd)(if(not(eqb(current-buffer)))(throwreturn-tag(current-buffer)))))(command-executecmd))(setqlast-commandthis-command)(if(or(prog1quit-flag(setqquit-flagnil));; XEmacs(eq(event-to-characterlast-input-event)(quit-char)))(progn(setqunread-command-eventsnil)(if(notinhibit-quit);; XEmacs(progn(dingnil'quit)(message"Quit")(throwreturn-tagnil))(message"Quit inhibited")(ding)))))(buffer-read-only(ifloop-function(setqerrconditions)(ding)(message"Buffer is read-only")(sit-for2)))(beginning-of-buffer(ifloop-function(setqerrconditions)(ding)(message"Beginning of Buffer")(sit-for2)))(end-of-buffer(ifloop-function(setqerrconditions)(ding)(message"End of Buffer")(sit-for2)))(error(ifloop-function(setqerrconditions)(ding)(message"Error: %s"(if(eq(carconditions)'error)(car(cdrconditions))(prin1-to-stringconditions)))(sit-for2))))(ding))(and(not(eq(current-buffer)electrified-buffer)); XEmacs -(not(eq(selected-window)(minibuffer-window)))(progn(dingnil'quit)(message"Leaving electric command loop %s.""because buffer has changed")(sit-for2)(throwreturn-tagnil)))(ifloop-function(funcallloop-functionloop-stateerr))));; XEmacs - huh? It should be impossible to ever get here...(dingnil'alarm)(throwreturn-tagnil));; This function is like pop-to-buffer, sort of. ;; The algorithm is;; If there is a window displaying buffer;; Select it;; Else if there is only one window;; Split it, selecting the window on the bottom with height being;; the lesser of max-height (if non-nil) and the number of lines in;; the buffer to be displayed subject to window-min-height constraint.;; Else;; Switch to buffer in the current window.;;;; Then if max-height is nil, and not all of the lines in the buffer;; are displayed, grab the whole frame.;;;; Returns selected window on buffer positioned at point-min.(defunElectric-pop-up-window(buffer&optionalmax-height)(let*((win(or(get-buffer-windowbuffer)(selected-window)))(buf(get-bufferbuffer))(one-window(one-window-pt))(pop-up-windowst)(target-height)(lines))(if(notbuf)(error"Buffer %s does not exist"buffer)(save-excursion(set-bufferbuf)(setqlines(count-lines(point-min)(point-max)))(setqtarget-height(min(max(ifmax-height(minmax-height(1+lines))(1+lines))window-min-height)(save-window-excursion(delete-other-windows)(1-(window-height(selected-window)))))))(cond((and(eq(window-bufferwin)buf))(select-windowwin))(one-window(goto-char(window-startwin))(pop-to-bufferbuffer)(setqwin(selected-window))(enlarge-window(-target-height(window-heightwin))))(t(switch-to-bufferbuf)))(if(and(notmax-height)(>target-height(window-height(selected-window))))(progn(goto-char(window-startwin))(enlarge-window(-target-height(window-heightwin)))))(goto-char(point-min))win)))(provide'electric);;; electric.el ends here