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

Diff of /climacs/gui.lisp

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

revision 1.219 by thenriksen, Tue Jun 13 11:34:52 2006 UTC revision 1.220 by thenriksen, Tue Jul 11 14:20:20 2006 UTC
# Line 201  Line 201 
201    "Return the current buffer."    "Return the current buffer."
202    (buffer (current-window)))    (buffer (current-window)))
203    
 (defun climacs (&key new-process (process-name "Climacs")  
                 (width 900) (height 400))  
   "Starts up a climacs session"  
   (let ((frame (make-application-frame 'climacs :width width :height height)))  
     (flet ((run ()  
              (run-frame-top-level frame)))  
       (if new-process  
           (clim-sys:make-process #'run :name process-name)  
           (run)))))  
   
 (defun climacs-rv (&key new-process (process-name "Climacs")  
                 (width 900) (height 400))  
   "Starts up a climacs session"  
   ;; SBCL doesn't inherit dynamic bindings when starting new  
   ;; processes, so start a new processes and THEN setup the colors.  
   (flet ((run ()  
            (let ((*bg-color* +black+)  
                  (*fg-color* +gray+)  
                  (*info-bg-color* +darkslategray+)  
                  (*info-fg-color* +gray+)  
                  (*mini-bg-color* +black+)  
                  (*mini-fg-color* +white+))  
              (climacs :new-process nil :width width :height height))))  
     (if new-process  
       (clim-sys:make-process #'run :name process-name)  
       (run))))  
   
204  (define-presentation-type read-only ())  (define-presentation-type read-only ())
205  (define-presentation-method highlight-presentation  (define-presentation-method highlight-presentation
206      ((type read-only) record stream state)      ((type read-only) record stream state)
# Line 540  If the buffer needs saving, will prompt Line 513  If the buffer needs saving, will prompt
513           'pane-table           'pane-table
514           '((#\x :control) (#\k)))           '((#\x :control) (#\k)))
515    
 #+sbcl  
 (defun ed-in-climacs (thing)  
   (let ((frame-manager (find-frame-manager)))  
     (when frame-manager  
       (let ((climacs-frame (find-if (lambda (x) (typep x 'climacs))  
                                     (frame-manager-frames frame-manager))))  
         (when climacs-frame  
           (typecase thing  
             ((or pathname string)  
              (execute-frame-command  
               climacs-frame `(com-find-file ,(pathname thing)))  
              t)  
             ((or symbol cons)  
              ;; FIXME: do something  
              nil)))))))  
   
 #+sbcl  
 (pushnew 'ed-in-climacs sb-ext:*ed-functions*)  
   
516  ;;; For the ESA help functions.  ;;; For the ESA help functions.
517    
518  (defmethod help-stream ((frame climacs) title)  (defmethod help-stream ((frame climacs) title)

Legend:
Removed from v.1.219  
changed lines
  Added in v.1.220

  ViewVC Help
Powered by ViewVC 1.1.5