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

Contents of /climacs/gui.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5