/[climacs]/climacs/gui.lisp
ViewVC logotype

Contents of /climacs/gui.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.43 - (show annotations)
Sat Jan 1 19:58:40 2005 UTC (9 years, 3 months ago) by rstrandh
Branch: MAIN
Changes since 1.42: +47 -12 lines
Patch from Christophe Rhodes implementing transpose-objects and
transpose-words.  Thank you.
1 ;;; -*- Mode: Lisp; Package: CLIMACS-GUI -*-
2
3 ;;; (c) copyright 2004 by
4 ;;; Robert Strandh (strandh@labri.fr)
5 ;;; (c) copyright 2004 by
6 ;;; Elliott Johnson (ejohnson@fasl.info)
7
8 ;;; This library is free software; you can redistribute it and/or
9 ;;; modify it under the terms of the GNU Library General Public
10 ;;; License as published by the Free Software Foundation; either
11 ;;; version 2 of the License, or (at your option) any later version.
12 ;;;
13 ;;; This library is distributed in the hope that it will be useful,
14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;;; Library General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU Library General Public
19 ;;; License along with this library; if not, write to the
20 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;;; Boston, MA 02111-1307 USA.
22
23 ;;; GUI for the Climacs editor.
24
25 (in-package :climacs-gui)
26
27 (defclass filename-mixin ()
28 ((filename :initform nil :accessor filename)))
29
30 (defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin name-mixin)
31 ((needs-saving :initform nil :accessor needs-saving))
32 (:default-initargs :name "*scratch*"))
33
34
35 (defclass climacs-pane (application-pane)
36 ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer)
37 (point :initform nil :initarg :point :reader point)
38 (syntax :initarg :syntax :accessor syntax)
39 (mark :initform nil :initarg :mark :reader mark)))
40
41 (defmethod initialize-instance :after ((pane climacs-pane) &rest args)
42 (declare (ignore args))
43 (with-slots (buffer point syntax mark) pane
44 (when (null point)
45 (setf point (make-instance 'standard-right-sticky-mark
46 :buffer buffer)))
47 (when (null mark)
48 (setf mark (make-instance 'standard-right-sticky-mark
49 :buffer buffer)))
50 (setf syntax (make-instance 'texinfo-syntax :pane pane))))
51
52 (defclass minibuffer-pane (application-pane) ())
53
54 (defmethod stream-accept :before ((pane minibuffer-pane) type &rest args)
55 (declare (ignore type args))
56 (window-clear pane))
57
58 (define-application-frame climacs ()
59 ((win :reader win))
60 (:panes
61 (win (make-pane 'climacs-pane
62 :width 900 :height 400
63 :name 'win
64 :incremental-redisplay t
65 :display-function 'display-win))
66 (info :application
67 :width 900 :height 20 :max-height 20
68 :name 'info :background +light-gray+
69 :scroll-bars nil
70 :incremental-redisplay t
71 :display-function 'display-info)
72 (int (make-pane 'minibuffer-pane
73 :width 900 :height 20 :max-height 20 :min-height 20
74 :scroll-bars nil)))
75 (:layouts
76 (default
77 (vertically (:scroll-bars nil)
78 (scrolling (:width 900 :height 400) win)
79 info
80 int)))
81 (:top-level (climacs-top-level)))
82
83 (defmethod redisplay-frame-panes :after ((frame climacs) &rest args)
84 (declare (ignore args))
85 (clear-modify (buffer (win frame))))
86
87 (defun climacs ()
88 "Starts up a climacs session"
89 (let ((frame (make-application-frame 'climacs)))
90 (run-frame-top-level frame)))
91
92 (defun display-message (format-string &rest format-args)
93 (apply #'format *standard-input* format-string format-args))
94
95 (defun display-info (frame pane)
96 (let* ((win (win frame))
97 (buf (buffer win))
98 (name-info (format nil " ~a ~a Syntax: ~a"
99 (if (needs-saving buf) "**" "--")
100 (name buf)
101 (name (syntax win)))))
102 (princ name-info pane)))
103
104 (defun display-win (frame pane)
105 "The display function used by the climacs application frame."
106 (declare (ignore frame))
107 (redisplay-pane pane))
108
109 (defun find-gestures (gestures start-table)
110 (loop with table = (find-command-table start-table)
111 for (gesture . rest) on gestures
112 for item = (find-keystroke-item gesture table :errorp nil)
113 while item
114 do (if (eq (command-menu-item-type item) :command)
115 (return (if (null rest) item nil))
116 (setf table (command-menu-item-value item)))
117 finally (return item)))
118
119 (defvar *kill-ring* (initialize-kill-ring 7))
120 (defparameter *current-gesture* nil)
121
122 (defun meta-digit (gesture)
123 (position gesture
124 '((#\0 :meta) (#\1 :meta) (#\2 :meta) (#\3 :meta) (#\4 :meta)
125 (#\5 :meta) (#\6 :meta) (#\7 :meta) (#\8 :meta) (#\9 :meta))
126 :test #'event-matches-gesture-name-p))
127
128 (defun read-numeric-argument (&key (stream *standard-input*))
129 (let ((gesture (read-gesture :stream stream)))
130 (cond ((event-matches-gesture-name-p gesture '(#\u :control))
131 (let ((numarg 4))
132 (loop for gesture = (read-gesture :stream stream)
133 while (event-matches-gesture-name-p gesture '(#\u :control))
134 do (setf numarg (* 4 numarg))
135 finally (unread-gesture gesture :stream stream))
136 (let ((gesture (read-gesture :stream stream)))
137 (cond ((and (characterp gesture)
138 (digit-char-p gesture 10))
139 (setf numarg (- (char-code gesture) (char-code #\0)))
140 (loop for gesture = (read-gesture :stream stream)
141 while (and (characterp gesture)
142 (digit-char-p gesture 10))
143 do (setf gesture (+ (* 10 numarg)
144 (- (char-code gesture) (char-code #\0))))
145 finally (unread-gesture gesture :stream stream)
146 (return (values numarg t))))
147 (t
148 (values numarg t))))))
149 ((meta-digit gesture)
150 (let ((numarg (meta-digit gesture)))
151 (loop for gesture = (read-gesture :stream stream)
152 while (meta-digit gesture)
153 do (setf numarg (+ (* 10 numarg) (meta-digit gesture)))
154 finally (unread-gesture gesture :stream stream)
155 (return (values numarg t)))))
156 (t (unread-gesture gesture :stream stream)
157 (values 1 nil)))))
158
159 (defun climacs-top-level (frame &key
160 command-parser command-unparser
161 partial-command-parser prompt)
162 (declare (ignore command-parser command-unparser partial-command-parser prompt))
163 (setf (slot-value frame 'win) (find-pane-named frame 'win))
164 (let ((*standard-output* (find-pane-named frame 'win))
165 (*standard-input* (find-pane-named frame 'int))
166 (*print-pretty* nil)
167 (*abort-gestures* nil))
168 (redisplay-frame-panes frame :force-p t)
169 (loop with gestures = '()
170 with numarg = 1 ; FIXME (read-numeric-argument :stream *standard-input*)
171 do (setf *current-gesture* (read-gesture :stream *standard-input*))
172 (when (or (characterp *current-gesture*)
173 (and (typep *current-gesture* 'keyboard-event)
174 (or (keyboard-event-character *current-gesture*)
175 (not (member (keyboard-event-key-name
176 *current-gesture*)
177 '(:control-left :control-right
178 :shift-left :shift-right
179 :meta-left :meta-right
180 :super-left :super-right
181 :hyper-left :hyper-right
182 :shift-lock :caps-lock))))))
183 (setf gestures (nconc gestures (list *current-gesture*)))
184 (let ((item (find-gestures gestures 'global-climacs-table)))
185 (cond ((not item)
186 (beep) (setf gestures '()))
187 ((eq (command-menu-item-type item) :command)
188 (let ((command (command-menu-item-value item)))
189 (unless (consp command)
190 (setf command (list command)))
191 (setf command (substitute-numeric-argument-marker command numarg))
192 (handler-case
193 (execute-frame-command frame command)
194 (error (condition)
195 (beep)
196 (format *error-output* "~a~%" condition)))
197 (setf gestures '())))
198 (t nil))))
199 (let ((buffer (buffer (win frame))))
200 (when (modified-p buffer)
201 (setf (needs-saving buffer) t)))
202 (redisplay-frame-panes frame))))
203
204 (defmacro define-named-command (command-name args &body body)
205 `(define-climacs-command ,(if (listp command-name) `(,@command-name :name t) `(,command-name :name t)) ,args ,@body))
206
207 (define-named-command (com-quit) ()
208 (frame-exit *application-frame*))
209
210 (define-command com-self-insert ()
211 (unless (constituentp *current-gesture*)
212 (possibly-expand-abbrev (point (win *application-frame*))))
213 (insert-object (point (win *application-frame*)) *current-gesture*))
214
215 (define-named-command com-beginning-of-line ()
216 (beginning-of-line (point (win *application-frame*))))
217
218 (define-named-command com-end-of-line ()
219 (end-of-line (point (win *application-frame*))))
220
221 (define-named-command com-delete-object ()
222 (delete-range (point (win *application-frame*))))
223
224 (define-named-command com-backward-delete-object ()
225 (delete-range (point (win *application-frame*)) -1))
226
227 (define-named-command com-transpose-objects ()
228 (let* ((point (point (win *application-frame*))))
229 (unless (beginning-of-buffer-p point)
230 (when (end-of-line-p point)
231 (backward-object point))
232 (let ((object (object-after point)))
233 (delete-range point)
234 (backward-object point)
235 (insert-object point object)
236 (forward-object point)))))
237
238 (defgeneric backward-object (mark &optional count))
239 (defmethod backward-object ((mark climacs-buffer::mark-mixin)
240 &optional (count 1))
241 (decf (offset mark) count))
242
243 (defgeneric forward-object (mark &optional count))
244 (defmethod forward-object ((mark climacs-buffer::mark-mixin)
245 &optional (count 1))
246 (incf (offset mark) count))
247
248 (define-named-command com-backward-object ()
249 (backward-object (point (win *application-frame*))))
250
251 (define-named-command com-forward-object ()
252 (forward-object (point (win *application-frame*))))
253
254 (define-named-command com-transpose-words ()
255 (let* ((point (point (win *application-frame*))))
256 (let (bw1 bw2 ew1 ew2)
257 (backward-word point)
258 (setf bw1 (offset point))
259 (forward-word point)
260 (setf ew1 (offset point))
261 (forward-word point)
262 (when (= (offset point) ew1)
263 ;; this is emacs' message in the minibuffer
264 (error "Don't have two things to transpose"))
265 (setf ew2 (offset point))
266 (backward-word point)
267 (setf bw2 (offset point))
268 (let ((w2 (buffer-sequence (buffer point) bw2 ew2))
269 (w1 (buffer-sequence (buffer point) bw1 ew1)))
270 (delete-word point)
271 (insert-sequence point w1)
272 (backward-word point)
273 (backward-word point)
274 (delete-word point)
275 (insert-sequence point w2)
276 (forward-word point)))))
277
278 (define-named-command com-previous-line ()
279 (previous-line (point (win *application-frame*))))
280
281 (define-named-command com-next-line ()
282 (next-line (point (win *application-frame*))))
283
284 (define-named-command com-open-line ()
285 (open-line (point (win *application-frame*))))
286
287 (define-named-command com-kill-line ()
288 (kill-line (point (win *application-frame*))))
289
290 (define-named-command com-forward-word ()
291 (forward-word (point (win *application-frame*))))
292
293 (define-named-command com-backward-word ()
294 (backward-word (point (win *application-frame*))))
295
296 (define-named-command com-delete-word ()
297 (delete-word (point (win *application-frame*))))
298
299 (define-named-command com-backward-delete-word ()
300 (backward-delete-word (point (win *application-frame*))))
301
302 (define-named-command com-toggle-layout ()
303 (setf (frame-current-layout *application-frame*)
304 (if (eq (frame-current-layout *application-frame*) 'default)
305 'with-interactor
306 'default)))
307
308 (define-command com-extended-command ()
309 (let ((item (accept 'command :prompt "Extended Command")))
310 (execute-frame-command *application-frame* item)))
311
312 (eval-when (:compile-toplevel :load-toplevel)
313 (define-presentation-type completable-pathname ()
314 :inherit-from 'pathname))
315
316 (defun filename-completer (so-far mode)
317 (flet ((remove-trail (s)
318 (subseq s 0 (let ((pos (position #\/ s :from-end t)))
319 (if pos (1+ pos) 0)))))
320 (let* ((directory-prefix
321 (if (and (plusp (length so-far)) (eql (aref so-far 0) #\/))
322 ""
323 (namestring #+sbcl (car (directory ".")) #+cmu (ext:default-directory))))
324 (full-so-far (concatenate 'string directory-prefix so-far))
325 (pathnames
326 (loop with length = (length full-so-far)
327 for path in (directory (concatenate 'string
328 (remove-trail so-far)
329 "*.*"))
330 when (let ((mismatch (mismatch (namestring path) full-so-far)))
331 (or (null mismatch) (= mismatch length)))
332 collect path))
333 (strings (mapcar #'namestring pathnames))
334 (first-string (car strings))
335 (length-common-prefix nil)
336 (completed-string nil)
337 (full-completed-string nil))
338 (unless (null pathnames)
339 (setf length-common-prefix
340 (loop with length = (length first-string)
341 for string in (cdr strings)
342 do (setf length (min length (or (mismatch string first-string) length)))
343 finally (return length))))
344 (unless (null pathnames)
345 (setf completed-string
346 (subseq first-string (length directory-prefix)
347 (if (null (cdr pathnames)) nil length-common-prefix)))
348 (setf full-completed-string
349 (concatenate 'string directory-prefix completed-string)))
350 (case mode
351 ((:complete-limited :complete-maximal)
352 (cond ((null pathnames)
353 (values so-far nil nil 0 nil))
354 ((null (cdr pathnames))
355 (values completed-string t (car pathnames) 1 nil))
356 (t
357 (values completed-string nil nil (length pathnames) nil))))
358 (:complete
359 (cond ((null pathnames)
360 (values so-far t so-far 1 nil))
361 ((null (cdr pathnames))
362 (values completed-string t (car pathnames) 1 nil))
363 ((find full-completed-string strings :test #'string-equal)
364 (let ((pos (position full-completed-string strings :test #'string-equal)))
365 (values completed-string
366 t (elt pathnames pos) (length pathnames) nil)))
367 (t
368 (values completed-string nil nil (length pathnames) nil))))
369 (:possibilities
370 (values nil nil nil (length pathnames)
371 (loop with length = (length directory-prefix)
372 for name in pathnames
373 collect (list (subseq (namestring name) length nil)
374 name))))))))
375
376 (define-presentation-method accept
377 ((type completable-pathname) stream (view textual-view) &key)
378 (multiple-value-bind (pathname success string)
379 (complete-input stream
380 #'filename-completer
381 :partial-completers '(#\Space)
382 :allow-any-input t)
383 (declare (ignore success))
384 (or pathname string)))
385
386 (defun pathname-filename (pathname)
387 (if (null (pathname-type pathname))
388 (pathname-name pathname)
389 (concatenate 'string (pathname-name pathname)
390 "." (pathname-type pathname))))
391
392 (define-named-command com-find-file ()
393 (let ((filename (accept 'completable-pathname
394 :prompt "Find File")))
395 (with-slots (buffer point syntax) (win *application-frame*)
396 (setf buffer (make-instance 'climacs-buffer)
397 point (make-instance 'standard-right-sticky-mark :buffer buffer)
398 syntax (make-instance 'texinfo-syntax :pane (win *application-frame*)))
399 (with-open-file (stream filename :direction :input :if-does-not-exist :create)
400 (input-from-stream stream buffer 0))
401 (setf (filename buffer) filename
402 (name buffer) (pathname-filename filename)
403 (needs-saving buffer) nil)
404 (beginning-of-buffer point)
405 ;; this one is needed so that the buffer modification protocol
406 ;; resets the low and high marks after redisplay
407 (redisplay-frame-panes *application-frame*))))
408
409 (define-named-command com-save-buffer ()
410 (let* ((buffer (buffer (win *application-frame*)))
411 (filename (or (filename buffer)
412 (accept 'completable-pathname
413 :prompt "Save Buffer to File"))))
414 (if (or (null (filename buffer))
415 (needs-saving buffer))
416 (progn (with-open-file (stream filename :direction :output :if-exists :supersede)
417 (output-to-stream stream buffer 0 (size buffer)))
418 (setf (filename buffer) filename
419 (name buffer) (pathname-filename filename))
420 (display-message "Wrote: ~a" (filename buffer)))
421 (display-message "No changes need to be saved from ~a" (name buffer)))
422 (setf (needs-saving buffer) nil)))
423
424 (define-named-command com-write-buffer ()
425 (let ((filename (accept 'completable-pathname
426 :prompt "Write Buffer to File"))
427 (buffer (buffer (win *application-frame*))))
428 (with-open-file (stream filename :direction :output :if-exists :supersede)
429 (output-to-stream stream buffer 0 (size buffer)))
430 (setf (filename buffer) filename
431 (name buffer) (pathname-filename filename)
432 (needs-saving buffer) nil)
433 (display-message "Wrote: ~a" (filename buffer))))
434
435 (define-named-command com-beginning-of-buffer ()
436 (beginning-of-buffer (point (win *application-frame*))))
437
438 (define-named-command com-page-down ()
439 (let ((pane (win *application-frame*)))
440 (page-down pane (syntax pane))))
441
442 (define-named-command com-page-up ()
443 (let ((pane (win *application-frame*)))
444 (page-up pane (syntax pane))))
445
446 (define-named-command com-end-of-buffer ()
447 (end-of-buffer (point (win *application-frame*))))
448
449 (define-named-command com-back-to-indentation ()
450 (let ((point (point (win *application-frame*))))
451 (beginning-of-line point)
452 (loop until (end-of-line-p point)
453 while (whitespacep (object-after point))
454 do (incf (offset point)))))
455
456 (define-named-command com-goto-position ()
457 (setf (offset (point (win *application-frame*)))
458 (accept 'integer :prompt "Goto Position")))
459
460 (define-named-command com-goto-line ()
461 (loop with mark = (make-instance 'standard-right-sticky-mark
462 :buffer (buffer (win *application-frame*)))
463 do (end-of-line mark)
464 until (end-of-buffer-p mark)
465 repeat (accept 'integer :prompt "Goto Line")
466 do (incf (offset mark))
467 (end-of-line mark)
468 finally (beginning-of-line mark)
469 (setf (offset (point (win *application-frame*)))
470 (offset mark))))
471
472 (define-named-command com-browse-url ()
473 (accept 'url :prompt "Browse URL"))
474
475 (define-named-command com-set-mark ()
476 (with-slots (point mark) (win *application-frame*)
477 (setf mark (clone-mark point))))
478
479 (define-named-command com-set-syntax ()
480 (setf (syntax (win *application-frame*))
481 (make-instance (accept 'syntax :prompt "Set Syntax")
482 :pane (win *application-frame*))))
483
484 ;;;;;;;;;;;;;;;;;;;;
485 ;; Kill ring commands
486
487 ;; Copies an element from a kill-ring to a buffer at the given offset
488 (define-named-command com-copy-in ()
489 (insert-sequence (point (win *application-frame*)) (kr-copy *kill-ring*)))
490
491 ;; Cuts an element from a kill-ring out to a buffer at a given offset
492 (define-named-command com-cut-in ()
493 (insert-sequence (point (win *application-frame*)) (kr-pop *kill-ring*)))
494
495 ;; Destructively cut a given buffer region into the kill-ring
496 (define-named-command com-cut-out ()
497 (with-slots (buffer point mark)(win *application-frame*)
498 (if (< (offset point) (offset mark))
499 ((lambda (b o1 o2)
500 (kr-push *kill-ring* (buffer-sequence b o1 o2))
501 (delete-buffer-range b o1 (- o2 o1)))
502 buffer (offset point) (offset mark))
503 ((lambda (b o1 o2)
504 (kr-push *kill-ring* (buffer-sequence b o2 o1))
505 (delete-buffer-range b o1 (- o2 o1)))
506 buffer (offset mark) (offset point)))))
507
508
509 ;; Non destructively copies in buffer region to the kill ring
510 (define-named-command com-copy-out ()
511 (with-slots (buffer point mark)(win *application-frame*)
512 (let ((off1 (offset point))
513 (off2 (offset mark)))
514 (if (< off1 off2)
515 (kr-push *kill-ring* (buffer-sequence buffer off1 off2))
516 (kr-push *kill-ring* (buffer-sequence buffer off2 off1))))))
517
518 ;; Needs adjustment to be like emacs M-y
519 (define-named-command com-kr-rotate ()
520 (kr-rotate *kill-ring* -1))
521
522 ;; Not bound to a key yet
523 (define-named-command com-kr-resize ()
524 (let ((size (accept 'fixnum :prompt "New kill ring size: ")))
525 (kr-resize *kill-ring* size)))
526
527 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
528 ;;;
529 ;;; Global command table
530
531 (make-command-table 'global-climacs-table :errorp nil)
532
533 (defun global-set-key (gesture command)
534 (add-command-to-command-table command 'global-climacs-table
535 :keystroke gesture :errorp nil))
536
537 (loop for code from (char-code #\space) to (char-code #\~)
538 do (global-set-key (code-char code) 'com-self-insert))
539
540 (global-set-key #\newline 'com-self-insert)
541 (global-set-key #\tab 'com-self-insert)
542 (global-set-key '(#\f :control) 'com-forward-object)
543 (global-set-key '(#\b :control) 'com-backward-object)
544 (global-set-key '(#\a :control) 'com-beginning-of-line)
545 (global-set-key '(#\e :control) 'com-end-of-line)
546 (global-set-key '(#\d :control) 'com-delete-object)
547 (global-set-key '(#\p :control) 'com-previous-line)
548 (global-set-key '(#\n :control) 'com-next-line)
549 (global-set-key '(#\o :control) 'com-open-line)
550 (global-set-key '(#\k :control) 'com-kill-line)
551 (global-set-key '(#\t :control) 'com-transpose-objects)
552 (global-set-key '(#\Space :control) 'com-set-mark)
553 (global-set-key '(#\y :control) 'com-copy-in)
554 (global-set-key '(#\w :control) 'com-cut-out)
555 (global-set-key '(#\f :meta) 'com-forward-word)
556 (global-set-key '(#\b :meta) 'com-backward-word)
557 (global-set-key '(#\t :meta) 'com-transpose-words)
558 (global-set-key '(#\x :meta) 'com-extended-command)
559 (global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only
560 (global-set-key '(#\w :meta) 'com-copy-out)
561 (global-set-key '(#\v :control) 'com-page-down)
562 (global-set-key '(#\v :meta) 'com-page-up)
563 (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer)
564 (global-set-key '(#\> :shift :meta) 'com-end-of-buffer)
565 (global-set-key '(#\u :meta) 'com-browse-url)
566 (global-set-key '(#\m :meta) 'com-back-to-indentation)
567 (global-set-key '(#\d :meta) 'com-delete-word)
568 (global-set-key '(#\Backspace :meta) 'com-backward-delete-word)
569
570 (global-set-key '(:up) 'com-previous-line)
571 (global-set-key '(:down) 'com-next-line)
572 (global-set-key '(:left) 'com-backward-object)
573 (global-set-key '(:right) 'com-forward-object)
574 (global-set-key '(:left :control) 'com-backward-word)
575 (global-set-key '(:right :control) 'com-forward-word)
576 (global-set-key '(:home) 'com-beginning-of-line)
577 (global-set-key '(:end) 'com-end-of-line)
578 (global-set-key '(:home :control) 'com-beginning-of-buffer)
579 (global-set-key '(:end :control) 'com-end-of-buffer)
580 (global-set-key #\Rubout 'com-delete-object)
581 (global-set-key #\Backspace 'com-backward-delete-object)
582
583 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
584 ;;;
585 ;;; C-x command table
586
587 (make-command-table 'c-x-climacs-table :errorp nil)
588
589 (add-menu-item-to-command-table 'global-climacs-table "C-x"
590 :menu 'c-x-climacs-table
591 :keystroke '(#\x :control))
592
593 (defun c-x-set-key (gesture command)
594 (add-command-to-command-table command 'c-x-climacs-table
595 :keystroke gesture :errorp nil))
596
597 (c-x-set-key '(#\c :control) 'com-quit)
598 (c-x-set-key '(#\f :control) 'com-find-file)
599 (c-x-set-key '(#\s :control) 'com-save-buffer)
600 (c-x-set-key '(#\w :control) 'com-write-buffer)

  ViewVC Help
Powered by ViewVC 1.1.5