Mercurial > hg > xemacs-beta

comparison lisp/electric/electric.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents b82b59fe008d
children b9518feda344
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; electric.el --- window maker and Command loop for `electric' modes. 1 ;;; electric.el --- window maker and Command loop for `electric' modes.
2 2
3 ;; Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 1986, 1992, 1995 Free Software Foundation, Inc.
4 4
5 ;; Author: K. Shane Hartman 5 ;; Author: K. Shane Hartman
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 ;; Keywords: extensions 7 ;; Keywords: extensions
8 8
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details. 19 ;; General Public License for more details.
20 20
21 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free 22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 23 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24 ;; 02111-1307, USA.
25 24
26 ;;; Synched up with: FSF 19.34. 25 ;;; Synched up with: FSF 19.30.97.
27 26
28 ;;; Commentary: 27 ;;; Commentary:
29 28
30 ; zaaaaaaap 29 ; zaaaaaaap
31 30
67 (if (not (stringp prompt-string)) 66 (if (not (stringp prompt-string))
68 (if (eq prompt-string 'noprompt) 67 (if (eq prompt-string 'noprompt)
69 (setq prompt-string nil) 68 (setq prompt-string nil)
70 (setq prompt-string "->"))) 69 (setq prompt-string "->")))
71 (setq cmd (read-key-sequence prompt-string)) 70 (setq cmd (read-key-sequence prompt-string))
72 ;; XEmacs
73 (or prefix-arg (setq last-command this-command)) 71 (or prefix-arg (setq last-command this-command))
74 (setq last-command-event (aref cmd (1- (length cmd))) 72 (setq last-command-event (aref cmd (1- (length cmd)))
75 current-mouse-event 73 current-mouse-event
76 (and (or (button-press-event-p last-command-event) 74 (and (or (button-press-event-p last-command-event)
77 (button-release-event-p last-command-event) 75 (button-release-event-p last-command-event)
82 (key-binding cmd t)) 80 (key-binding cmd t))
83 cmd this-command) 81 cmd this-command)
84 ;; This makes universal-argument-other-key work. 82 ;; This makes universal-argument-other-key work.
85 (setq universal-argument-num-events 0) 83 (setq universal-argument-num-events 0)
86 (if (or (prog1 quit-flag (setq quit-flag nil)) 84 (if (or (prog1 quit-flag (setq quit-flag nil))
87 ;; XEmacs
88 (eq (event-to-character last-input-event) (quit-char))) 85 (eq (event-to-character last-input-event) (quit-char)))
89 (progn (setq unread-command-events nil 86 (progn (setq unread-command-events nil
90 prefix-arg nil) 87 prefix-arg nil)
91 ;; If it wasn't cancelling a prefix character, then quit. 88 ;; If it wasn't cancelling a prefix character, then quit.
92 (if (or (= (length (this-command-keys)) 1) 89 (if (or (= (length (this-command-keys)) 1)
96 (throw return-tag nil)) 93 (throw return-tag nil))
97 (setq cmd nil)))) 94 (setq cmd nil))))
98 (setq current-prefix-arg prefix-arg) 95 (setq current-prefix-arg prefix-arg)
99 (if cmd 96 (if cmd
100 (condition-case conditions 97 (condition-case conditions
101 ;; XEmacs
102 (progn (if (eventp cmd) 98 (progn (if (eventp cmd)
103 (progn 99 (progn
104 (let ((b (current-buffer))) 100 (let ((b (current-buffer)))
105 (dispatch-event cmd) 101 (dispatch-event cmd)
106 (if (not (eq b (current-buffer))) 102 (if (not (eq b (current-buffer)))
107 (throw return-tag (current-buffer))))) 103 (throw return-tag (current-buffer)))))
108 (command-execute cmd)) 104 (command-execute cmd))
109 (setq last-command this-command) 105 (setq last-command this-command)
110 (if (or (prog1 quit-flag (setq quit-flag nil)) 106 (if (or (prog1 quit-flag (setq quit-flag nil))
111 ;; XEmacs
112 (eq (event-to-character last-input-event) 107 (eq (event-to-character last-input-event)
113 (quit-char))) 108 (quit-char)))
114 (progn (setq unread-command-events nil) 109 (progn (setq unread-command-events nil)
115 (if (not inhibit-quit) 110 (if (not inhibit-quit)
116 ;; XEmacs
117 (progn (ding nil 'quit) 111 (progn (ding nil 'quit)
118 (message "Quit") 112 (message "Quit")
119 (throw return-tag nil)) 113 (throw return-tag nil))
120 (message "Quit inhibited") 114 (message "Quit inhibited")
121 (ding))))) 115 (ding)))))
122 (buffer-read-only (if loop-function 116 (error (command-error conditions) ; XEmacs
123 (setq err conditions) 117 (sit-for 2)))
124 (ding) 118 (ding nil 'undefined-key))
125 (message "Buffer is read-only") 119 (and (not (eq (current-buffer) electrified-buffer)) ; XEmacs -
126 (sit-for 2))) 120 (not (eq (selected-window) (minibuffer-window)))
127 (beginning-of-buffer (if loop-function 121 (progn (ding nil 'quit)
128 (setq err conditions) 122 (message "Leaving electric command loop %s."
129 (ding) 123 "because buffer has changed")
130 (message "Beginning of Buffer") 124 (sit-for 2)
131 (sit-for 2))) 125 (throw return-tag nil)))
132 (end-of-buffer (if loop-function
133 (setq err conditions)
134 (ding)
135 (message "End of Buffer")
136 (sit-for 2)))
137 (error (if loop-function
138 (setq err conditions)
139 (ding)
140 (message "Error: %s"
141 (if (eq (car conditions) 'error)
142 (car (cdr conditions))
143 (prin1-to-string conditions)))
144 (sit-for 2))))
145 (ding))
146 (if loop-function (funcall loop-function loop-state err)))) 126 (if loop-function (funcall loop-function loop-state err))))
147 ;; XEmacs - huh? It should be impossible to ever get here... 127 ;; ####> - huh? It should be impossible to ever get here...
148 (ding nil 'alarm) 128 (ding nil 'alarm)
149 (throw return-tag nil)) 129 (throw return-tag nil))
150 130
151 ;; This function is like pop-to-buffer, sort of. 131 ;; This function is like pop-to-buffer, sort of.
152 ;; The algorithm is 132 ;; The algorithm is
196 (progn (goto-char (window-start win)) 176 (progn (goto-char (window-start win))
197 (enlarge-window (- target-height (window-height win))))) 177 (enlarge-window (- target-height (window-height win)))))
198 (goto-char (point-min)) 178 (goto-char (point-min))
199 win))) 179 win)))
200 180
201 (provide 'electric) 181 (provide 'electric) ; zaaaaaaap
202 182
203 ;;; electric.el ends here 183 ;;; electric.el ends here