1;;; electric.el --- window maker and Command loop for `electric' modes 2 3;; Copyright (C) 1985, 1986, 1995, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: K. Shane Hartman 7;; Maintainer: FSF 8;; Keywords: extensions 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29; zaaaaaaap 30 31;;; Code: 32 33;; This loop is the guts for non-standard modes which retain control 34;; until some event occurs. It is a `do-forever', the only way out is 35;; to throw. It assumes that you have set up the keymap, window, and 36;; everything else: all it does is read commands and execute them - 37;; providing error messages should one occur (if there is no loop 38;; function - which see). The required argument is a tag which should 39;; expect a value of nil if the user decides to punt. The second 40;; argument is the prompt to be used: if nil, use "->", if 'noprompt, 41;; don't use a prompt, if a string, use that string as prompt, and if 42;; a function of no variable, it will be evaluated in every iteration 43;; of the loop and its return value, which can be nil, 'noprompt or a 44;; string, will be used as prompt. Given third argument non-nil, it 45;; INHIBITS quitting unless the user types C-g at toplevel. This is 46;; so user can do things like C-u C-g and not get thrown out. Fourth 47;; argument, if non-nil, should be a function of two arguments which 48;; is called after every command is executed. The fifth argument, if 49;; provided, is the state variable for the function. If the 50;; loop-function gets an error, the loop will abort WITHOUT throwing 51;; (moral: use unwind-protect around call to this function for any 52;; critical stuff). The second argument for the loop function is the 53;; conditions for any error that occurred or nil if none. 54 55(defun Electric-command-loop (return-tag 56 &optional prompt inhibit-quit 57 loop-function loop-state) 58 59 (let (cmd 60 (err nil) 61 (prompt-string prompt)) 62 (while t 63 (if (not (or (stringp prompt) (eq prompt nil) (eq prompt 'noprompt))) 64 (setq prompt-string (funcall prompt))) 65 (if (not (stringp prompt-string)) 66 (if (eq prompt-string 'noprompt) 67 (setq prompt-string nil) 68 (setq prompt-string "->"))) 69 (setq cmd (read-key-sequence prompt-string)) 70 (setq last-command-char (aref cmd (1- (length cmd))) 71 this-command (key-binding cmd t) 72 cmd this-command) 73 ;; This makes universal-argument-other-key work. 74 (setq universal-argument-num-events 0) 75 (if (or (prog1 quit-flag (setq quit-flag nil)) 76 (eq last-input-char ?\C-g)) 77 (progn (setq unread-command-events nil 78 prefix-arg nil) 79 ;; If it wasn't cancelling a prefix character, then quit. 80 (if (or (= (length (this-command-keys)) 1) 81 (not inhibit-quit)) ; safety 82 (progn (ding) 83 (message "Quit") 84 (throw return-tag nil)) 85 (setq cmd nil)))) 86 (setq current-prefix-arg prefix-arg) 87 (if cmd 88 (condition-case conditions 89 (progn (command-execute cmd) 90 (setq last-command this-command) 91 (if (or (prog1 quit-flag (setq quit-flag nil)) 92 (eq last-input-char ?\C-g)) 93 (progn (setq unread-command-events nil) 94 (if (not inhibit-quit) 95 (progn (ding) 96 (message "Quit") 97 (throw return-tag nil)) 98 (ding))))) 99 (buffer-read-only (if loop-function 100 (setq err conditions) 101 (ding) 102 (message "Buffer is read-only") 103 (sit-for 2))) 104 (beginning-of-buffer (if loop-function 105 (setq err conditions) 106 (ding) 107 (message "Beginning of Buffer") 108 (sit-for 2))) 109 (end-of-buffer (if loop-function 110 (setq err conditions) 111 (ding) 112 (message "End of Buffer") 113 (sit-for 2))) 114 (error (if loop-function 115 (setq err conditions) 116 (ding) 117 (message "Error: %s" 118 (if (eq (car conditions) 'error) 119 (car (cdr conditions)) 120 (prin1-to-string conditions))) 121 (sit-for 2)))) 122 (ding)) 123 (if loop-function (funcall loop-function loop-state err)))) 124 (ding) 125 (throw return-tag nil)) 126 127;; This function is like pop-to-buffer, sort of. 128;; The algorithm is 129;; If there is a window displaying buffer 130;; Select it 131;; Else if there is only one window 132;; Split it, selecting the window on the bottom with height being 133;; the lesser of max-height (if non-nil) and the number of lines in 134;; the buffer to be displayed subject to window-min-height constraint. 135;; Else 136;; Switch to buffer in the current window. 137;; 138;; Then if max-height is nil, and not all of the lines in the buffer 139;; are displayed, grab the whole frame. 140;; 141;; Returns selected window on buffer positioned at point-min. 142 143(defun Electric-pop-up-window (buffer &optional max-height) 144 (let* ((win (or (get-buffer-window buffer) (selected-window))) 145 (buf (get-buffer buffer)) 146 (one-window (one-window-p t)) 147 (pop-up-windows t) 148 (pop-up-frames nil)) 149 (if (not buf) 150 (error "Buffer %s does not exist" buffer) 151 (cond ((and (eq (window-buffer win) buf)) 152 (select-window win)) 153 (one-window 154 (pop-to-buffer buffer) 155 (setq win (selected-window))) 156 (t 157 (switch-to-buffer buf))) 158 (fit-window-to-buffer win max-height) 159 (goto-char (point-min)) 160 win))) 161 162(provide 'electric) 163 164;;; arch-tag: dae045eb-dc2d-4fb7-9f27-9cc2ce277be8 165;;; electric.el ends here 166