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

Diff of /climacs/gui.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by strandh, Wed Dec 22 14:43:18 2004 UTC revision 1.7 by strandh, Thu Dec 23 07:01:56 2004 UTC
# Line 22  Line 22 
22    
23  (in-package :climacs-gui)  (in-package :climacs-gui)
24    
25    (defclass filename-mixin ()
26      ((filename :initform nil :accessor filename)))
27    
28    (defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin) ())
29    
30    (defclass climacs-pane (application-pane)
31      ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer)
32       (point :initform nil :initarg :point :reader point)))
33    
34    (defmethod initialize-instance :after ((pane climacs-pane) &rest args)
35      (declare (ignore args))
36      (with-slots (buffer point) pane
37         (when (null point)
38           (setf point (make-instance 'standard-right-sticky-mark
39                          :buffer buffer)))))
40    
41  (define-application-frame climacs ()  (define-application-frame climacs ()
42    ((buffer :initform (make-instance 'abbrev-buffer)    ((win :reader win))
            :accessor buffer)  
    (point :initform nil :reader point))  
43    (:panes    (:panes
44     (win :application :width 600 :height 400     (win (make-pane 'climacs-pane
45          :display-function 'display-win)                     :width 600 :height 400
46                       :name 'win
47                       :display-function 'display-win))
48     (int :interactor :width 600 :height 50))     (int :interactor :width 600 :height 50))
49    (:layouts    (:layouts
50     (default     (default
51         (vertically () win int)))         (vertically ()
52             (scrolling (:width 600 :height 400) win)
53             int)))
54    (:top-level (climacs-top-level)))    (:top-level (climacs-top-level)))
55    
 (defmethod initialize-instance :after ((frame climacs) &rest args)  
   (declare (ignore args))  
   (setf (slot-value frame 'point)  
         (make-instance 'standard-right-sticky-mark  
            :buffer (buffer frame))))  
   
56  (defun climacs ()  (defun climacs ()
57    (let ((frame (make-application-frame 'climacs)))    (let ((frame (make-application-frame 'climacs)))
58      (run-frame-top-level frame)))      (run-frame-top-level frame)))
# Line 50  Line 62 
62           (style (medium-text-style medium))           (style (medium-text-style medium))
63           (height (text-style-height style medium))           (height (text-style-height style medium))
64           (width (text-style-width style medium))           (width (text-style-width style medium))
65           (buffer (buffer frame))           (buffer (buffer (win frame)))
66           (size (size (buffer frame)))           (size (size (buffer (win frame))))
67           (offset 0)           (offset 0)
68           (offset1 nil)           (offset1 nil)
69           (cursor-x nil)           (cursor-x nil)
# Line 63  Line 75 
75                          :stream pane)                          :stream pane)
76                 (setf offset1 nil)))                 (setf offset1 nil)))
77             (display-line ()             (display-line ()
78               (loop when (= offset (offset (point frame)))               (loop when (= offset (offset (point (win frame))))
79                       do (multiple-value-bind (x y) (stream-cursor-position pane)                       do (multiple-value-bind (x y) (stream-cursor-position pane)
80                            (setf cursor-x (+ x (if (null offset1)                            (setf cursor-x (+ x (if (null offset1)
81                                                    0                                                    0
# Line 89  Line 101 
101                             (terpri pane))))                             (terpri pane))))
102        (loop while (< offset size)        (loop while (< offset size)
103              do (display-line))              do (display-line))
104        (when (= offset (offset (point frame)))        (when (= offset (offset (point (win frame))))
105          (multiple-value-bind (x y) (stream-cursor-position pane)          (multiple-value-bind (x y) (stream-cursor-position pane)
106            (setf cursor-x x            (setf cursor-x x
107                  cursor-y y))))                  cursor-y y))))
# Line 114  Line 126 
126                            command-parser command-unparser                            command-parser command-unparser
127                            partial-command-parser prompt)                            partial-command-parser prompt)
128    (declare (ignore command-parser command-unparser partial-command-parser prompt))    (declare (ignore command-parser command-unparser partial-command-parser prompt))
129      (setf (slot-value frame 'win) (find-pane-named frame 'win))
130    (let ((*standard-output* (frame-standard-output frame))    (let ((*standard-output* (frame-standard-output frame))
131          (*standard-input* (frame-standard-input frame))          (*standard-input* (frame-standard-input frame))
132          (*print-pretty* nil))          (*print-pretty* nil))
# Line 142  Line 155 
155    
156  (define-command com-self-insert ()  (define-command com-self-insert ()
157    (unless (constituentp *current-gesture*)    (unless (constituentp *current-gesture*)
158      (possibly-expand-abbrev (point *application-frame*)))      (possibly-expand-abbrev (point (win *application-frame*))))
159    (insert-object (point *application-frame*) *current-gesture*))    (insert-object (point (win *application-frame*)) *current-gesture*))
160    
161  (define-command com-backward-object ()  (define-command com-backward-object ()
162    (decf (offset (point *application-frame*))))    (decf (offset (point (win *application-frame*)))))
163    
164  (define-command com-forward-object ()  (define-command com-forward-object ()
165    (incf (offset (point *application-frame*))))    (incf (offset (point (win *application-frame*)))))
166    
167  (define-command com-beginning-of-line ()  (define-command com-beginning-of-line ()
168    (beginning-of-line (point *application-frame*)))    (beginning-of-line (point (win *application-frame*))))
169    
170  (define-command com-end-of-line ()  (define-command com-end-of-line ()
171    (end-of-line (point *application-frame*)))    (end-of-line (point (win *application-frame*))))
172    
173  (define-command com-delete-object ()  (define-command com-delete-object ()
174    (delete-range (point *application-frame*)))    (delete-range (point (win *application-frame*))))
175    
176  (define-command com-previous-line ()  (define-command com-previous-line ()
177    (previous-line (point *application-frame*)))    (previous-line (point (win *application-frame*))))
178    
179  (define-command com-next-line ()  (define-command com-next-line ()
180    (next-line (point *application-frame*)))    (next-line (point (win *application-frame*))))
181    
182  (define-command com-open-line ()  (define-command com-open-line ()
183    (open-line (point *application-frame*)))    (open-line (point (win *application-frame*))))
184    
185  (define-command com-kill-line ()  (define-command com-kill-line ()
186    (kill-line (point *application-frame*)))    (kill-line (point (win *application-frame*))))
187    
188  (define-command com-forward-word ()  (define-command com-forward-word ()
189    (forward-word (point *application-frame*)))    (forward-word (point (win *application-frame*))))
190    
191  (define-command com-backward-word ()  (define-command com-backward-word ()
192    (backward-word (point *application-frame*)))    (backward-word (point (win *application-frame*))))
193    
194  (define-command com-toggle-layout ()  (define-command com-toggle-layout ()
195    (setf (frame-current-layout *application-frame*)    (setf (frame-current-layout *application-frame*)
# Line 190  Line 203 
203  (defclass weird () ())  (defclass weird () ())
204    
205  (define-command com-insert-weird-stuff ()  (define-command com-insert-weird-stuff ()
206    (insert-object (point *application-frame*) (make-instance 'weird)))    (insert-object (point (win *application-frame*)) (make-instance 'weird)))
207    
 (define-command com-insert-number ()  
   (insert-sequence (point *application-frame*)  
                    (format nil "~a" (accept 'number :prompt "Insert Number"))))  
208    
209  (define-presentation-type completable-pathname ()  (define-presentation-type completable-pathname ()
210    :inherit-from 'pathname)    :inherit-from 'pathname)
# Line 270  Line 280 
280      (or pathname string)))      (or pathname string)))
281    
282  (define-command com-find-file ()  (define-command com-find-file ()
283    (let ((filename (handler-case (accept 'completable-pathname    (let ((filename (accept 'completable-pathname
284                                          :prompt "Find File")                            :prompt "Find File"))
285                      (simple-parse-error () (error 'file-not-found))))          (buffer (make-instance 'climacs-buffer)))
286          (buffer (make-instance 'abbrev-buffer)))      (setf (buffer (win *application-frame*)) buffer)
     (setf (buffer *application-frame*) buffer)  
287      (with-open-file (stream filename :direction :input)      (with-open-file (stream filename :direction :input)
288        (input-from-stream stream buffer 0))        (input-from-stream stream buffer 0))
289      (setf (slot-value *application-frame* 'point)      (setf (slot-value (win *application-frame*) 'point)
290            (make-instance 'standard-right-sticky-mark :buffer buffer))))            (make-instance 'standard-right-sticky-mark :buffer buffer))))
291    
292    (define-command com-save-buffer ()
293      (let ((filename (or (filename (buffer (win *application-frame*)))
294                          (accept 'completable-pathname
295                                  :prompt "Save Buffer to File")))
296            (buffer (buffer (win *application-frame*))))
297        (with-open-file (stream filename :direction :output :if-exists :supersede)
298          (output-to-stream stream buffer 0 (size buffer)))))
299    
300  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
301  ;;;  ;;;
302  ;;; Global command table  ;;; Global command table
# Line 307  Line 324 
324  (global-set-key '(#\b :meta) 'com-backward-word)  (global-set-key '(#\b :meta) 'com-backward-word)
325  (global-set-key '(#\x :meta) 'com-extended-command)  (global-set-key '(#\x :meta) 'com-extended-command)
326  (global-set-key '(#\a :meta) 'com-insert-weird-stuff)  (global-set-key '(#\a :meta) 'com-insert-weird-stuff)
 (global-set-key '(#\c :meta) 'com-insert-number)  
327    
328  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
329  ;;;  ;;;
# Line 327  Line 343 
343  (add-command-to-command-table 'com-find-file 'c-x-climacs-table  (add-command-to-command-table 'com-find-file 'c-x-climacs-table
344                                :keystroke '(#\f :control))                                :keystroke '(#\f :control))
345    
346    (add-command-to-command-table 'com-save-buffer 'c-x-climacs-table
347                                  :keystroke '(#\s :control))
348    
349    
350    

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

  ViewVC Help
Powered by ViewVC 1.1.5