Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv18511
Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Modified the buffer protocol to contain a modification flag, and implemented the modification. Updated the documentation.
Added a flag to the climacs-buffer indicating whether the buffer needs saving. This is different from the modification flag, which is only valid during one iteration of the command loop. The needs-saving flag checks the modification flag, though, after each command execution.
Date: Wed Dec 29 07:58:53 2004 Author: rstrandh
Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.12 climacs/buffer.lisp:1.13 --- climacs/buffer.lisp:1.12 Tue Dec 28 07:58:36 2004 +++ climacs/buffer.lisp Wed Dec 29 07:58:53 2004 @@ -38,10 +38,13 @@
(defgeneric high-mark (buffer))
+(defgeneric modified-p (buffer)) + (defclass standard-buffer (buffer) ((contents :initform (make-instance 'standard-cursorchain)) (low-mark :reader low-mark) - (high-mark :reader high-mark)) + (high-mark :reader high-mark) + (modified :initform nil :reader modified-p)) (:documentation "The Climacs standard buffer [an instantable subclass of buffer]."))
(defgeneric buffer (mark) @@ -463,23 +466,27 @@ (setf (offset (low-mark buffer)) (min (offset (low-mark buffer)) offset)) (setf (offset (high-mark buffer)) - (max (offset (high-mark buffer)) offset))) + (max (offset (high-mark buffer)) offset)) + (setf (slot-value buffer 'modified) t))
(defmethod insert-buffer-sequence :before ((buffer standard-buffer) offset sequence) (declare (ignore sequence)) (setf (offset (low-mark buffer)) (min (offset (low-mark buffer)) offset)) (setf (offset (high-mark buffer)) - (max (offset (high-mark buffer)) offset))) + (max (offset (high-mark buffer)) offset)) + (setf (slot-value buffer 'modified) t))
(defmethod delete-buffer-range :before ((buffer standard-buffer) offset n) (setf (offset (low-mark buffer)) (min (offset (low-mark buffer)) offset)) (setf (offset (high-mark buffer)) - (max (offset (high-mark buffer)) (+ offset n)))) + (max (offset (high-mark buffer)) (+ offset n))) +(setf (slot-value buffer 'modified) t))
-(defgeneric reset-low-high-marks (buffer)) +(defgeneric clear-modify (buffer))
-(defmethod reset-low-high-marks ((buffer standard-buffer)) +(defmethod clear-modify ((buffer standard-buffer)) (beginning-of-buffer (high-mark buffer)) - (end-of-buffer (low-mark buffer))) + (end-of-buffer (low-mark buffer)) + (setf (slot-value buffer 'modified) nil))
Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.27 climacs/gui.lisp:1.28 --- climacs/gui.lisp:1.27 Wed Dec 29 06:55:26 2004 +++ climacs/gui.lisp Wed Dec 29 07:58:53 2004 @@ -29,7 +29,7 @@
(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin) ((name :initform "*scratch*" :accessor name) - (modified :initform nil :accessor modified-p))) + (needs-saving :initform nil :accessor needs-saving)))
(defclass climacs-pane (application-pane) ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) @@ -48,6 +48,12 @@ :buffer buffer))) (setf syntax (make-instance 'texinfo-syntax :pane pane))))
+(defclass minibuffer-pane (application-pane) ()) + +(defmethod stream-accept :before ((pane minibuffer-pane) type &rest args) + (declare (ignore type args)) + (window-clear pane)) + (define-application-frame climacs () ((win :reader win)) (:panes @@ -57,13 +63,14 @@ :incremental-redisplay t :display-function 'display-win)) (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)) + :width 900 :height 20 :max-height 20 + :name 'info :background +light-gray+ + :scroll-bars nil + :incremental-redisplay t + :display-function 'display-info) + (int (make-pane 'minibuffer-pane + :width 900 :height 20 :max-height 20 :min-height 20 + :scroll-bars nil))) (:layouts (default (vertically (:scroll-bars nil) @@ -72,6 +79,10 @@ int))) (:top-level (climacs-top-level)))
+(defmethod redisplay-frame-panes :after ((frame climacs) &rest args) + (declare (ignore args)) + (clear-modify (buffer (win frame)))) + (defun climacs () "Starts up a climacs session" (let ((frame (make-application-frame 'climacs))) @@ -81,7 +92,7 @@ (let* ((win (win frame)) (buf (buffer win)) (name-info (format nil " ~a ~a" - (if (modified-p buf) "**" "--") + (if (needs-saving buf) "**" "--") (name buf)))) (princ name-info pane)))
@@ -108,8 +119,6 @@ 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* (find-pane-named frame 'win)) (*standard-input* (find-pane-named frame 'int)) (*print-pretty* nil) @@ -140,6 +149,9 @@ (format *error-output* "~a~%" condition))) (setf gestures '())) (t nil)))) + (let ((buffer (buffer (win frame)))) + (when (modified-p buffer) + (setf (needs-saving buffer) t))) (redisplay-frame-panes frame))))
(define-command (com-quit :name "Quit" :command-table climacs) () @@ -148,8 +160,7 @@ (define-command com-self-insert () (unless (constituentp *current-gesture*) (possibly-expand-abbrev (point (win *application-frame*)))) - (insert-object (point (win *application-frame*)) *current-gesture*) - (setf (modified-p (buffer (win *application-frame*))) t)) + (insert-object (point (win *application-frame*)) *current-gesture*))
(define-command com-backward-object () (decf (offset (point (win *application-frame*))))) @@ -164,12 +175,10 @@ (end-of-line (point (win *application-frame*))))
(define-command com-delete-object () - (delete-range (point (win *application-frame*))) - (setf (modified-p (buffer (win *application-frame*))) t)) + (delete-range (point (win *application-frame*))))
(define-command com-backward-delete-object () - (delete-range (point (win *application-frame*)) -1) - (setf (modified-p (buffer (win *application-frame*))) t)) + (delete-range (point (win *application-frame*)) -1))
(define-command com-previous-line () (previous-line (point (win *application-frame*)))) @@ -178,12 +187,10 @@ (next-line (point (win *application-frame*))))
(define-command com-open-line () - (open-line (point (win *application-frame*))) - (setf (modified-p (buffer (win *application-frame*))) t)) + (open-line (point (win *application-frame*))))
(define-command com-kill-line () - (kill-line (point (win *application-frame*))) - (setf (modified-p (buffer (win *application-frame*))) t)) + (kill-line (point (win *application-frame*))))
(define-command com-forward-word () (forward-word (point (win *application-frame*)))) @@ -199,21 +206,8 @@
(define-command com-extended-command () (let ((item (accept 'command :prompt "Extended Command"))) - (window-clear *standard-input*) (execute-frame-command *application-frame* item)))
-(defclass weird () () - (:documentation "An open ended class.")) - -(define-command com-insert-weird-stuff () - (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))) - (setf (modified-p (buffer (win *application-frame*))) t)) - (define-presentation-type completable-pathname () :inherit-from 'pathname)
@@ -303,7 +297,11 @@ (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-filename filename)) + (name buffer) (pathname-filename filename) + (needs-saving buffer) nil) + ;; this one is needed so that the buffer modification protocol + ;; resets the low and high marks after redisplay + (redisplay-frame-panes *application-frame*) (beginning-of-buffer point))))
(define-command com-save-buffer () @@ -314,8 +312,8 @@ (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-filename filename)) - (setf (modified-p (buffer (win *application-frame*))) nil))) + (name buffer) (pathname-filename filename) + (needs-saving buffer) nil)))
(define-command com-write-buffer () (let ((filename (accept 'completable-pathname @@ -324,8 +322,8 @@ (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-filename filename)) - (setf (modified-p (buffer (win *application-frame*))) nil))) + (name buffer) (pathname-filename filename) + (needs-saving buffer) nil)))
(define-command com-beginning-of-buffer () (beginning-of-buffer (point (win *application-frame*)))) @@ -409,8 +407,6 @@ (global-set-key '(#\f :meta) 'com-forward-word) (global-set-key '(#\b :meta) 'com-backward-word) (global-set-key '(#\x :meta) 'com-extended-command) -(global-set-key '(#\a :meta) 'com-insert-weird-stuff) -(global-set-key '(#\c :meta) 'com-insert-reversed-string) (global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only (global-set-key '(#\w :meta) 'com-copy-out) (global-set-key '(#< :shift :meta) 'com-beginning-of-buffer)
Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.12 climacs/packages.lisp:1.13 --- climacs/packages.lisp:1.12 Wed Dec 29 06:45:37 2004 +++ climacs/packages.lisp Wed Dec 29 07:58:53 2004 @@ -38,7 +38,7 @@ #:delete-region #:buffer-object #:buffer-sequence #:object-before #:object-after #:region-to-sequence - #:low-mark #:high-mark #:reset-low-high-marks)) + #:low-mark #:high-mark #:modified-p #:clear-modify))
(defpackage :climacs-base (:use :clim-lisp :climacs-buffer)