Mercurial > hg > xemacs-beta

comparison lisp/electric/electric.el @ 72:b9518feda344 r20-0b31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b31
author cvs
date Mon, 13 Aug 2007 09:03:46 +0200
parents 131b0175ea99
children 585fb297b004
comparison
equal deleted inserted replaced
71:bae944334fa4 72:b9518feda344
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, 1992, 1995 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 1986, 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, 675 Mass Ave, Cambridge, MA 02139, USA. 23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
24 24 ;; 02111-1307, USA.
25 ;;; Synched up with: FSF 19.30.97. 25
26 ;;; Synched up with: FSF 19.34.
26 27
27 ;;; Commentary: 28 ;;; Commentary:
28 29
29 ; zaaaaaaap 30 ; zaaaaaaap
30 31
66 (if (not (stringp prompt-string)) 67 (if (not (stringp prompt-string))
67 (if (eq prompt-string 'noprompt) 68 (if (eq prompt-string 'noprompt)
68 (setq prompt-string nil) 69 (setq prompt-string nil)
69 (setq prompt-string "->"))) 70 (setq prompt-string "->")))
70 (setq cmd (read-key-sequence prompt-string)) 71 (setq cmd (read-key-sequence prompt-string))
72 ;; XEmacs
71 (or prefix-arg (setq last-command this-command)) 73 (or prefix-arg (setq last-command this-command))
72 (setq last-command-event (aref cmd (1- (length cmd))) 74 (setq last-command-event (aref cmd (1- (length cmd)))
73 current-mouse-event 75 current-mouse-event
74 (and (or (button-press-event-p last-command-event) 76 (and (or (button-press-event-p last-command-event)
75 (button-release-event-p last-command-event) 77 (button-release-event-p last-command-event)
80 (key-binding cmd t)) 82 (key-binding cmd t))
81 cmd this-command) 83 cmd this-command)
82 ;; This makes universal-argument-other-key work. 84 ;; This makes universal-argument-other-key work.
83 (setq universal-argument-num-events 0) 85 (setq universal-argument-num-events 0)
84 (if (or (prog1 quit-flag (setq quit-flag nil)) 86 (if (or (prog1 quit-flag (setq quit-flag nil))
87 ;; XEmacs
85 (eq (event-to-character last-input-event) (quit-char))) 88 (eq (event-to-character last-input-event) (quit-char)))
86 (progn (setq unread-command-events nil 89 (progn (setq unread-command-events nil
87 prefix-arg nil) 90 prefix-arg nil)
88 ;; If it wasn't cancelling a prefix character, then quit. 91 ;; If it wasn't cancelling a prefix character, then quit.
89 (if (or (= (length (this-command-keys)) 1) 92 (if (or (= (length (this-command-keys)) 1)
93 (throw return-tag nil)) 96 (throw return-tag nil))
94 (setq cmd nil)))) 97 (setq cmd nil))))
95 (setq current-prefix-arg prefix-arg) 98 (setq current-prefix-arg prefix-arg)
96 (if cmd 99 (if cmd
97 (condition-case conditions 100 (condition-case conditions
101 ;; XEmacs
98 (progn (if (eventp cmd) 102 (progn (if (eventp cmd)
99 (progn 103 (progn
100 (let ((b (current-buffer))) 104 (let ((b (current-buffer)))
101 (dispatch-event cmd) 105 (dispatch-event cmd)
102 (if (not (eq b (current-buffer))) 106 (if (not (eq b (current-buffer)))
103 (throw return-tag (current-buffer))))) 107 (throw return-tag (current-buffer)))))
104 (command-execute cmd)) 108 (command-execute cmd))
105 (setq last-command this-command) 109 (setq last-command this-command)
106 (if (or (prog1 quit-flag (setq quit-flag nil)) 110 (if (or (prog1 quit-flag (setq quit-flag nil))
111 ;; XEmacs
107 (eq (event-to-character last-input-event) 112 (eq (event-to-character last-input-event)
108 (quit-char))) 113 (quit-char)))
109 (progn (setq unread-command-events nil) 114 (progn (setq unread-command-events nil)
110 (if (not inhibit-quit) 115 (if (not inhibit-quit)
116 ;; XEmacs
111 (progn (ding nil 'quit) 117 (progn (ding nil 'quit)
112 (message "Quit") 118 (message "Quit")
113 (throw return-tag nil)) 119 (throw return-tag nil))
114 (message "Quit inhibited") 120 (message "Quit inhibited")
115 (ding))))) 121 (ding)))))
116 (error (command-error conditions) ; XEmacs 122 (buffer-read-only (if loop-function
117 (sit-for 2))) 123 (setq err conditions)
118 (ding nil 'undefined-key)) 124 (ding)
119 (and (not (eq (current-buffer) electrified-buffer)) ; XEmacs - 125 (message "Buffer is read-only")
120 (not (eq (selected-window) (minibuffer-window))) 126 (sit-for 2)))
121 (progn (ding nil 'quit) 127 (beginning-of-buffer (if loop-function
122 (message "Leaving electric command loop %s." 128 (setq err conditions)
123 "because buffer has changed") 129 (ding)
124 (sit-for 2) 130 (message "Beginning of Buffer")
125 (throw return-tag nil))) 131 (sit-for 2)))
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))
126 (if loop-function (funcall loop-function loop-state err)))) 146 (if loop-function (funcall loop-function loop-state err))))
127 ;; ####> - huh? It should be impossible to ever get here... 147 ;; XEmacs - huh? It should be impossible to ever get here...
128 (ding nil 'alarm) 148 (ding nil 'alarm)
129 (throw return-tag nil)) 149 (throw return-tag nil))
130 150
131 ;; This function is like pop-to-buffer, sort of. 151 ;; This function is like pop-to-buffer, sort of.
132 ;; The algorithm is 152 ;; The algorithm is
176 (progn (goto-char (window-start win)) 196 (progn (goto-char (window-start win))
177 (enlarge-window (- target-height (window-height win))))) 197 (enlarge-window (- target-height (window-height win)))))
178 (goto-char (point-min)) 198 (goto-char (point-min))
179 win))) 199 win)))
180 200
181 (provide 'electric) ; zaaaaaaap 201 (provide 'electric)
182 202
183 ;;; electric.el ends here 203 ;;; electric.el ends here