[climacs-cvs] CVS update: climacs/gui.lisp

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv7032

Modified Files:
	gui.lisp 
Log Message:
Nicer layout.

Buffer name and buffer modification flag shown on new status line.

write-buffer command. 


Date: Tue Dec 28 17:57:26 2004
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.21 climacs/gui.lisp:1.22
--- climacs/gui.lisp:1.21	Mon Dec 27 17:47:45 2004
+++ climacs/gui.lisp	Tue Dec 28 17:57:26 2004
@@ -27,7 +27,9 @@
 (defclass filename-mixin ()
   ((filename :initform nil :accessor filename)))
 
-(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin) ())
+(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin)
+  ((name :initform "*scratch*" :accessor name)
+   (modified :initform nil :accessor modified-p)))
 
 (defclass climacs-pane (application-pane)
   ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer)
@@ -50,11 +52,19 @@
 		   :name 'win
 		   :incremental-redisplay t
 		   :display-function 'display-win))
-   (int :interactor :width 900 :height 50 :max-height 50))
+    (info :application
+ 	 :width 900 :height 20 :max-height 20
+ 	 :name 'info :background +light-gray+
+	 :scroll-bars nil
+ 	 :incremental-redisplay t
+ 	 :display-function 'display-info)
+    (int :application :width 900 :height 20 :max-height 20
+	 :scroll-bars nil))
   (:layouts
    (default
-       (vertically ()
+       (vertically (:scroll-bars nil)
 	 (scrolling (:width 900 :height 400) win)
+	 info
 	 int)))
   (:top-level (climacs-top-level)))
 
@@ -63,6 +73,14 @@
   (let ((frame (make-application-frame 'climacs)))
     (run-frame-top-level frame)))
 
+(defun display-info (frame pane)
+  (let* ((win (win frame))
+	 (buf (buffer win))
+	 (name-info (format nil "   ~a   ~a"
+			    (if (modified-p buf) "**" "--")
+			    (name buf))))
+    (princ name-info pane)))
+
 (defun display-win (frame pane)
   "The display function used by the climacs application frame."
   (declare (ignore frame))
@@ -85,8 +103,10 @@
 			  partial-command-parser prompt)
   (declare (ignore command-parser command-unparser partial-command-parser prompt))
   (setf (slot-value frame 'win) (find-pane-named frame 'win))
-  (let ((*standard-output* (frame-standard-output frame))
-	(*standard-input* (frame-standard-input frame))
+;;  (let ((*standard-output* (frame-standard-output frame))
+;;	(*standard-input* (frame-standard-input frame))
+  (let ((*standard-output* (find-pane-named frame 'win))
+	(*standard-input* (find-pane-named frame 'int))
 	(*print-pretty* nil)
 	(*abort-gestures* nil))
     (redisplay-frame-panes frame :force-p t)
@@ -123,7 +143,8 @@
 (define-command com-self-insert ()
   (unless (constituentp *current-gesture*)
     (possibly-expand-abbrev (point (win *application-frame*))))
-  (insert-object (point (win *application-frame*)) *current-gesture*))
+  (insert-object (point (win *application-frame*)) *current-gesture*)
+  (setf (modified-p (buffer (win *application-frame*))) t))
 
 (define-command com-backward-object ()
   (decf (offset (point (win *application-frame*)))))
@@ -138,10 +159,12 @@
   (end-of-line (point (win *application-frame*))))
 
 (define-command com-delete-object ()
-  (delete-range (point (win *application-frame*))))
+  (delete-range (point (win *application-frame*)))
+  (setf (modified-p (buffer (win *application-frame*))) t))
 
 (define-command com-backward-delete-object ()
-  (delete-range (point (win *application-frame*)) -1))
+  (delete-range (point (win *application-frame*)) -1)
+  (setf (modified-p (buffer (win *application-frame*))) t))
 
 (define-command com-previous-line ()
   (previous-line (point (win *application-frame*))))
@@ -150,10 +173,12 @@
   (next-line (point (win *application-frame*))))
 
 (define-command com-open-line ()
-  (open-line (point (win *application-frame*))))
+  (open-line (point (win *application-frame*)))
+  (setf (modified-p (buffer (win *application-frame*))) t))
 
 (define-command com-kill-line ()
-  (kill-line (point (win *application-frame*))))
+  (kill-line (point (win *application-frame*)))
+  (setf (modified-p (buffer (win *application-frame*))) t))
 
 (define-command com-forward-word ()
   (forward-word (point (win *application-frame*))))
@@ -174,11 +199,13 @@
   (:documentation "An open ended class."))
 
 (define-command com-insert-weird-stuff ()
-  (insert-object (point (win *application-frame*)) (make-instance 'weird)))
+  (insert-object (point (win *application-frame*)) (make-instance 'weird))
+  (setf (modified-p (buffer (win *application-frame*))) t))
 
 (define-command com-insert-reversed-string ()
   (insert-sequence (point (win *application-frame*))
-		   (reverse (accept 'string))))
+		   (reverse (accept 'string)))
+  (setf (modified-p (buffer (win *application-frame*))) t))
 
 (define-presentation-type completable-pathname ()
   :inherit-from 'pathname)
@@ -227,7 +254,7 @@
 		(values completed-string nil nil (length pathnames) nil))))
 	(:complete
 	 (cond ((null pathnames)
-		(values so-far nil nil 0 nil))
+		(values so-far t so-far 1 nil))
 	       ((null (cdr pathnames))
 		(values completed-string t (car pathnames) 1 nil))
 	       ((find full-completed-string strings :test #'string-equal)
@@ -259,10 +286,11 @@
     (with-slots (buffer point syntax) (win *application-frame*)
        (setf buffer (make-instance 'climacs-buffer)
 	     point (make-instance 'standard-right-sticky-mark :buffer buffer)
-	     syntax (make-instance 'texinfo-syntax :pane (win *application-frame*))
-	     (filename buffer) filename)
-       (with-open-file (stream filename :direction :input)
+	     syntax (make-instance 'texinfo-syntax :pane (win *application-frame*)))
+       (with-open-file (stream filename :direction :input :if-does-not-exist :create)
 	 (input-from-stream stream buffer 0))
+       (setf (filename buffer) filename
+	     (name buffer) (pathname-name filename))
        (beginning-of-buffer point))))
 
 (define-command com-save-buffer ()
@@ -271,7 +299,18 @@
 			      :prompt "Save Buffer to File")))
 	(buffer (buffer (win *application-frame*))))
     (with-open-file (stream filename :direction :output :if-exists :supersede)
-      (output-to-stream stream buffer 0 (size buffer)))))
+      (output-to-stream stream buffer 0 (size buffer)))
+    (setf (modified-p (buffer (win *application-frame*))) nil)))
+
+(define-command com-write-buffer ()
+  (let ((filename (accept 'completable-pathname
+			  :prompt "Write Buffer to File"))
+	(buffer (buffer (win *application-frame*))))
+    (with-open-file (stream filename :direction :output :if-exists :supersede)
+      (output-to-stream stream buffer 0 (size buffer)))
+    (setf (filename buffer) filename
+	  (name buffer) (pathname-name filename))
+    (setf (modified-p (buffer (win *application-frame*))) nil)))
 
 (define-command com-beginning-of-buffer ()
   (beginning-of-buffer (point (win *application-frame*))))
@@ -345,3 +384,4 @@
 (c-x-set-key '(#\c :control) 'com-quit)
 (c-x-set-key '(#\f :control) 'com-find-file)
 (c-x-set-key '(#\s :control) 'com-save-buffer)
+(c-x-set-key '(#\w :control) 'com-write-buffer)