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

Diff of /climacs/gui.lisp

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

revision 1.184 by dmurray, Tue Aug 30 17:28:52 2005 UTC revision 1.185 by mretzlaff, Thu Sep 1 00:21:08 2005 UTC
# Line 47  Line 47 
47  (defclass climacs-minibuffer-pane (minibuffer-pane)  (defclass climacs-minibuffer-pane (minibuffer-pane)
48    ()    ()
49    (:default-initargs    (:default-initargs
50        :height 20 :max-height 20 :min-height 20))        :height 20 :max-height 20 :min-height 20
51          :default-view +climacs-textual-view+))
52    
53  (defparameter *with-scrollbars* t  (defparameter *with-scrollbars* t
54    "If T, classic look and feel. If NIL, stripped-down look (:")    "If T, classic look and feel. If NIL, stripped-down look (:")
# Line 98  Line 99 
99      (loop for buffer in buffers      (loop for buffer in buffers
100            do (clear-modify buffer))))            do (clear-modify buffer))))
101    
102  (defun climacs (&key (width 900) (height 400))  (defun climacs (&key new-process (process-name "Climacs")
103                    (width 900) (height 400))
104    "Starts up a climacs session"    "Starts up a climacs session"
105    (let ((frame (make-application-frame    (let ((frame (make-application-frame 'climacs :width width :height height)))
106                  'climacs :width width :height height)))      (flet ((run ()
107      (run-frame-top-level frame)))               (run-frame-top-level frame)))
108          (if new-process
109              (clim-sys:make-process #'run :name process-name)
110              (run)))))
111    
112  (defun display-info (frame pane)  (defun display-info (frame pane)
113    (declare (ignore frame))    (declare (ignore frame))
# Line 696  Line 701 
701  (set-key 'com-fill-paragraph 'global-climacs-table  (set-key 'com-fill-paragraph 'global-climacs-table
702           '((#\q :meta)))           '((#\q :meta)))
703    
 (eval-when (:compile-toplevel :load-toplevel)  
   (define-presentation-type completable-pathname ()  
   :inherit-from 'pathname))  
   
704  (defun filename-completer (so-far mode)  (defun filename-completer (so-far mode)
705    (flet ((remove-trail (s)    (flet ((remove-trail (s)
706             (subseq s 0 (let ((pos (position #\/ s :from-end t)))             (subseq s 0 (let ((pos (position #\/ s :from-end t)))
# Line 768  Line 769 
769                         collect (list (subseq (namestring name) length nil)                         collect (list (subseq (namestring name) length nil)
770                                       name))))))))                                       name))))))))
771    
772  (define-presentation-method present (object (type completable-pathname)  (define-presentation-method present (object (type pathname)
773                                              stream (view textual-view)                                              stream (view climacs-textual-view) &key)
                                             &key acceptably for-context-type)  
   (declare (ignore acceptably for-context-type))  
774    (princ (namestring object) stream))    (princ (namestring object) stream))
775    
776  (define-presentation-method accept  (define-presentation-method accept ((type pathname) stream (view climacs-textual-view)
777      ((type completable-pathname) stream (view textual-view) &key (default nil defaultp)                                      &key (default nil defaultp) (default-type type))
      (default-type type))  
778    (multiple-value-bind (pathname success string)    (multiple-value-bind (pathname success string)
779        (complete-input stream        (complete-input stream
780                        #'filename-completer                        #'filename-completer
# Line 851  Line 849 
849                   buffer))))))                   buffer))))))
850    
851  (define-named-command com-find-file ()  (define-named-command com-find-file ()
852    (let* ((filepath (accept 'completable-pathname    (let* ((filepath (accept 'pathname :prompt "Find File")))
                            :prompt "Find File")))  
853      (find-file filepath)))      (find-file filepath)))
854    
855  (set-key 'com-find-file 'global-climacs-table  (set-key 'com-find-file 'global-climacs-table
# Line 895  Line 892 
892                       nil)))))))                       nil)))))))
893    
894  (define-named-command com-find-file-read-only ()  (define-named-command com-find-file-read-only ()
895    (let ((filepath (accept 'completable-pathname :Prompt "Find file read only")))    (let ((filepath (accept 'pathname :Prompt "Find file read only")))
896      (find-file-read-only filepath)))      (find-file-read-only filepath)))
897    
898  (set-key 'com-find-file-read-only 'global-climacs-table  (set-key 'com-find-file-read-only 'global-climacs-table
# Line 914  Line 911 
911          (needs-saving buffer) t))          (needs-saving buffer) t))
912    
913  (define-named-command com-set-visited-file-name ()  (define-named-command com-set-visited-file-name ()
914    (let ((filename (accept 'completable-pathname :prompt "New file name")))    (let ((filename (accept 'pathname :prompt "New file name")))
915      (set-visited-file-name filename (buffer (current-window)))))      (set-visited-file-name filename (buffer (current-window)))))
916    
917  (define-named-command com-insert-file ()  (define-named-command com-insert-file ()
918    (let ((filename (accept 'completable-pathname    (let ((filename (accept 'pathname :prompt "Insert File"))
                           :prompt "Insert File"))  
919          (pane (current-window)))          (pane (current-window)))
920      (when (probe-file filename)      (when (probe-file filename)
921        (setf (mark pane) (clone-mark (point pane) :left))        (setf (mark pane) (clone-mark (point pane) :left))
# Line 970  Line 966 
966    
967  (defun save-buffer (buffer)  (defun save-buffer (buffer)
968    (let ((filepath (or (filepath buffer)    (let ((filepath (or (filepath buffer)
969                        (accept 'completable-pathname                        (accept 'pathname :prompt "Save Buffer to File"))))
                               :prompt "Save Buffer to File"))))  
970      (cond      (cond
971        ((directory-pathname-p filepath)        ((directory-pathname-p filepath)
972         (display-message "~A is a directory." filepath)         (display-message "~A is a directory." filepath)
# Line 1018  Line 1013 
1013      (call-next-method)))      (call-next-method)))
1014    
1015  (define-named-command com-write-buffer ()  (define-named-command com-write-buffer ()
1016    (let ((filepath (accept 'completable-pathname    (let ((filepath (accept 'pathname :prompt "Write Buffer to File"))
                           :prompt "Write Buffer to File"))  
1017          (buffer (buffer (current-window))))          (buffer (buffer (current-window))))
1018      (cond      (cond
1019        ((directory-pathname-p filepath)        ((directory-pathname-p filepath)
# Line 1146  Line 1140 
1140                  (beep))))))                  (beep))))))
1141    
1142  (define-named-command com-load-file ()  (define-named-command com-load-file ()
1143    (let ((filepath (accept 'completable-pathname    (let ((filepath (accept 'pathname :prompt "Load File")))
                           :prompt "Load File")))  
1144      (load-file filepath)))      (load-file filepath)))
1145    
1146  (set-key 'com-load-file 'global-climacs-table  (set-key 'com-load-file 'global-climacs-table

Legend:
Removed from v.1.184  
changed lines
  Added in v.1.185

  ViewVC Help
Powered by ViewVC 1.1.5