Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv8661/Drei
Modified Files: drei-redisplay.lisp drei.lisp kill-ring.lisp packages.lisp undo.lisp Log Message: Docstring additions and added some undo-related symbols to the export-list for the DREI package.
--- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2006/11/17 20:18:56 1.4 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2006/11/19 11:39:44 1.5 @@ -47,8 +47,26 @@ ;;; The basic Drei redisplay functions:
(defgeneric display-drei-contents (stream drei syntax) - (:documentation "Display the contents of the Drei instance -`drei', which is in the syntax `syntax', to `stream'.") + (:documentation "The purpose of this function is to display the +buffer contents of a Drei instance to some output +surface. `Stream' is the CLIM output stream that redisplay should +be performed on, `drei' is the Drei instance that is being +redisplayed, and `syntax' is the syntax object of the buffer in +`drei'. Methods defined for this generic function can draw +whatever they want, but they should not assume that they are the +only user of `stream', unless the `stream' argument has been +specialized to some application-specific pane class that can +guarantee this. For example, when accepting multiple values using +the `accepting-values' macro, several Drei instances will be +displayed simultaneously on the same stream. It is permitted to +only specialise `stream' on `clim-stream-pane' and not +`extended-output-stream'. When writing methods for this function, +be aware that you cannot assume that the buffer will contain only +characters, and that any subsequence of the buffer is coercable +to a string. Drei buffers can contain arbitrary objects, and +redisplay methods are required to handle this (though they are +not required to handle it nicely, they can just ignore the +object, or display the `princ'ed representation.)") (:method :around ((stream extended-output-stream) (drei drei) (syntax syntax)) (letf (((stream-default-view stream) (view drei))) (call-next-method)))) @@ -64,7 +82,26 @@ (setf (output-record-position record) (stream-cursor-position stream))))
(defgeneric display-drei-cursor (stream drei cursor syntax) - (:documentation "Display the given cursor to `stream'.") + (:documentation "The purpose of this function is to display a +visible indication of a cursor of a Drei instance to some output +surface. `Stream' is the CLIM output stream that drawing should +be performed on, `drei' is the Drei instance that is being +redisplayed, `cursor' is the cursor object to be displayed (a +subclass of `drei-cursor') and `syntax' is the syntax object of +the buffer in `drei'}. Methods on this generic function can draw +whatever they want, but they should not assume that they are the +only user of `stream', unless the `stream' argument has been +specialized to some application-specific pane class that can +guarantee this. It is permitted to only specialise `stream' on +`clim-stream-pane' and not `extended-output-stream'. It is +recommended to use the function `offset-to-screen-position' to +determine where to draw the visual representation for the +cursor. It is also recommended to use the ink specified by +`cursor' to perform the drawing, if applicable. This method will +only be called by the Drei redisplay engine when the cursor is +active and the buffer position it refers to is on display - +therefore, `offset-to-screen-position' is *guaranteed* to not +return NIL or T.") (:method :around ((stream extended-output-stream) (drei drei) (cursor drei-cursor) (syntax syntax)) (when (visible cursor drei) --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/18 20:59:28 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/19 11:39:45 1.8 @@ -129,24 +129,67 @@ ;;; Undo
(defclass undo-mixin () - ((tree :initform (make-instance 'standard-undo-tree) :reader undo-tree) - (undo-accumulate :initform '() :accessor undo-accumulate) - (performing-undo :initform nil :accessor performing-undo))) + ((tree :initform (make-instance 'standard-undo-tree) + :reader undo-tree + :documentation "Returns the undo-tree of the buffer.") + (undo-accumulate :initform '() + :accessor undo-accumulate + :documentation "The list returned by this +function is initially NIL (the empty list). The :before methods +on `insert-buffer-object', `insert-buffer-sequence', and +`delete-buffer-range' push undo records on to this list.") + (performing-undo :initform nil + :accessor performing-undo + :documentation "This is initially NIL. +The :before methods on `insert-buffer-object', +`insert-buffer-sequence', and `delete-buffer-range' push undo +records onto the undo accumulator only if this slot is NIL so +that no undo information is added as a result of an undo +operation.")) + (:documentation "This is a mixin class that buffer classes can +inherit from. It contains an undo tree, an undo accumulator and a +flag specifyng whether or not it is currently performing +undo. The undo tree and undo accumulators are initially empty."))
(defclass drei-undo-record (standard-undo-record) - ((buffer :initarg :buffer))) + ((buffer :initarg :buffer + :documentation "The buffer to which the record +belongs.")) + (:documentation "A base class for all output records in +Drei."))
(defclass simple-undo-record (drei-undo-record) - ((offset :initarg :offset :reader undo-offset))) + ((offset :initarg :offset + :reader undo-offset + :documentation "The offset that determines the +position at which the undo operation is to be executed.")) + (:documentation "A base class for output records that modify +buffer contents at a specific offset."))
(defclass insert-record (simple-undo-record) - ((objects :initarg :objects))) + ((objects :initarg :objects + :documentation "The sequence of objects that are to +be inserted whenever flip-undo-record is called on an instance of +insert-record.")) + (:documentation "Whenever objects are deleted, the sequence of +objects is stored in an insert record containing a mark."))
(defclass delete-record (simple-undo-record) - ((length :initarg :length))) + ((length :initarg :length + :documentation "The length of the sequence of objects +to be deleted whenever `flip-undo-record' is called on an +instance of `delete-record'.")) + (:documentation "Whenever objects are inserted, a +`delete-record' containing a mark is created and added to the +undo tree."))
(defclass compound-record (drei-undo-record) - ((records :initform '() :initarg :records))) + ((records :initform '() + :initarg :records + :documentation "The undo records contained by this +compound record.")) + (:documentation "This record simply contains a list of other +records."))
(defmethod print-object ((object delete-record) stream) (with-slots (offset length) object @@ -181,12 +224,16 @@ (undo-accumulate buffer))))
(defmacro with-undo ((get-buffers-exp) &body body) - "Evaluate `body', registering any changes to buffer contents in -the undo memory for the respective buffer, permitting individual -undo for each buffer. `get-buffers-exp' should be a form, that -will be evaluated whenever a complete list of buffers is -needed (to set up all buffers to prepare for undo, and to check -them all for changes after `body' has run)." + "This macro executes the forms of `body', registering changes +made to the list of buffers retrieved by evaluating +`get-buffers-exp'. When `body' has run, for each buffer it will +call `add-undo' with an undo record and the undo tree of the +buffer. If the changes done by `body' to the buffer has resulted +in only a single undo record, it is passed as is to `add-undo'. +If it contains several undo records, a compound undo record is +constructed out of the list and passed to `add-undo'. Finally, +if the buffer has no undo records, `add-undo' is not called at +all." (with-gensyms (buffer) `(progn (dolist (,buffer ,get-buffers-exp) --- /project/mcclim/cvsroot/mcclim/Drei/kill-ring.lisp 2006/11/08 01:15:33 1.1 +++ /project/mcclim/cvsroot/mcclim/Drei/kill-ring.lisp 2006/11/19 11:39:45 1.2 @@ -26,12 +26,21 @@
(defclass kill-ring () ((max-size :type (integer 5 *) ;5 element minimum from flexichain protocol - :initarg :max-size) + :initarg :max-size + :documentation "The limitation placed upon the +number of elements held by the kill ring. Once the maximum size +has been reached, older entries must first be removed before new +ones can be added. When altered, any surplus elements will be +silently dropped.") (cursorchain :type standard-cursorchain :accessor kill-ring-chain - :initform (make-instance 'standard-cursorchain)) + :initform (make-instance 'standard-cursorchain) + :documentation "The cursorchain associated with +the kill ring.") (yankpoint :type left-sticky-flexicursor - :accessor kill-ring-cursor) + :accessor kill-ring-cursor + :documentation "The flexicursor associated with +the kill ring.") (append-next-p :type boolean :initform nil :accessor append-next-p)) (:documentation "A class for all kill rings")) @@ -51,38 +60,40 @@ (setf yankpoint (make-instance 'left-sticky-flexicursor :chain cursorchain))))
(defgeneric kill-ring-length (kr) - (:documentation "Returns the current length of the kill ring")) + (:documentation "Returns the current length of the kill-ring. +Note this is different than `kill-ring-max-size'."))
(defgeneric kill-ring-max-size (kr) - (:documentation "Returns the value of a kill ring's maximum size")) + (:documentation "Returns the value of the kill ring's maximum +size"))
(defgeneric (setf kill-ring-max-size) (kr size) - (:documentation "Alters the maximum size of a kill ring, even + (:documentation "Alters the maximum size of the kill ring, even if it means dropping elements to do so."))
(defgeneric reset-yank-position (kr) - (:documentation "Moves the current yank point back to the start of - of kill ring position")) + (:documentation "Moves the current yank point back to the start +of of kill ring position"))
(defgeneric rotate-yank-position (kr &optional times) - (:documentation "Moves the yank point associated with a kill-ring - one or times many positions away from the start - of ring position. If times is greater than the - current length then the cursor will wrap to the - start of ring position and continue rotating.")) + (:documentation "Moves the yank point associated with a +kill-ring one or times many positions away from the start of ring +position. If times is greater than the current length then the +cursor will wrap to the start of ring position and continue +rotating."))
(defgeneric kill-ring-standard-push (kr vector) - (:documentation "Pushes a vector of objects onto the kill ring creating a new -start of ring position. This function is much like an every- -day lisp push with size considerations. If the length of the -kill ring is greater than the maximum size, then "older" -elements will be removed from the ring until the maximum size -is reached.")) + (:documentation "Pushes a vector of objects onto the kill ring +creating a new start of ring position. This function is much +like an everyday Lisp push with size considerations. If the +length of the kill ring is greater than the maximum size, then +"older" elements will be removed from the ring until the +maximum size is reached."))
(defgeneric kill-ring-concatenating-push (kr vector) - (:documentation "Concatenates the contents of vector onto the end - of the current contents of the top of the kill ring. - If the kill ring is empty the a new entry is pushed.")) + (:documentation "Concatenates the contents of vector onto the +end of the current contents of the top of the kill ring. If the +kill ring is empty the a new entry is pushed."))
(defgeneric kill-ring-reverse-concatenating-push (kr vector) (:documentation "Concatenates the contents of vector onto the front @@ -91,12 +102,10 @@
(defgeneric kill-ring-yank (kr &optional reset) (:documentation "Returns the vector of objects currently - pointed to by the cursor. If reset is T, a - call to reset-yank-position is called before - the object is yanked. The default for reset - is NIL. If the kill ring is empty, a - condition of type `empty-kill-ring' is - signalled.")) +pointed to by the cursor. If `reset' is T, a call to +`reset-yank-position' is called before the object is yanked. The +default for reset is NIL. If the kill ring is empty, a condition +of type `empty-kill-ring' is signalled."))
(defmethod kill-ring-length ((kr kill-ring)) (nb-elements (kill-ring-chain kr))) @@ -172,4 +181,4 @@
(defparameter *kill-ring* nil "This special variable is bound to the kill ring of the running -application or DREI instance whenever a command is executed.") \ No newline at end of file +application or Drei instance whenever a command is executed.") --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2006/11/14 10:31:37 1.5 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2006/11/19 11:39:45 1.6 @@ -72,7 +72,7 @@
(defpackage :drei-kill-ring (:use :clim-lisp :flexichain) - (:export #:kill-ring + (:export #:kill-ring #:kill-ring-chain #:kill-ring-cursor #:empty-kill-ring #:kill-ring-length #:kill-ring-max-size #:append-next-p @@ -192,6 +192,15 @@ #:isearch-state #:search-string #:search-mark #:search-forward-p #:search-success-p #:query-replace-state #:string1 #:string2 #:buffers #:mark #:occurrences + + ;; Undo. + #:undo-mixin #:undo-tree #:undo-accumulate #:performing-undo + #:drei-undo-record + #:simple-undo-record + #:insert-record + #:delete-record + #:compound-record + #:with-undo #:drei-buffer #:drei-textual-view #:+drei-textual-view+ --- /project/mcclim/cvsroot/mcclim/Drei/undo.lisp 2006/11/08 01:15:33 1.1 +++ /project/mcclim/cvsroot/mcclim/Drei/undo.lisp 2006/11/19 11:39:45 1.2 @@ -34,35 +34,36 @@ one of its child states.
Client code is required to supply methods for this function on -client-specific subclasses of undo-record.")) +client-specific subclasses of `undo-record'."))
(defgeneric undo (undo-tree &optional n) - (:documentation "Move the current state n steps up the undo tree and -call flip-undo-record on each step. If the current state is at a -level less than n, a no-more-undo condition is signaled and the -current state is not moved (and no calls to flip-undo-record are -made). + (:documentation "Move the current state `n' steps up the undo +tree and call `flip-undo-record' on each step. If the current +state is at a level less than `n', a `no-more-undo' condition is +signaled and the current state is not moved (and no calls to +`flip-undo-record' are made).
As long as no new record are added to the tree, the undo module remembers which branch it was in before a sequence of calls to undo."))
(defgeneric redo (undo-tree &optional n) - (:documentation "Move the current state n steps down the remembered -branch of the undo tree and call flip-undo-record on each step. If -the remembered branch is shorter than n, a no-more-undo condition is -signaled and the current state is not moved (and no calls to -flip-undo-record are made).")) + (:documentation "Move the current state `n' steps down the +remembered branch of the undo tree and call `flip-undo-record' on +each step. If the remembered branch is shorter than `n', a +`no-more-undo' condition is signaled and the current state is not +moved (and no calls to `flip-undo-record' are made)."))
(define-condition no-more-undo (simple-error) () (:report (lambda (condition stream) (declare (ignore condition)) (format stream "No more undo"))) - (:documentation "This condition is signaled whenever an attempt is made to -call undo on a tree that is in its initial state.")) + (:documentation "A condition of this type is signaled whenever +an attempt is made to call undo when the application is in its +initial state."))
(defclass undo-tree () () - (:documentation "Protocol class for all undo trees")) + (:documentation "The base class for all undo trees."))
(defclass standard-undo-tree (undo-tree) ((current-record :accessor current-record) @@ -70,7 +71,10 @@ (redo-path :initform '() :accessor redo-path) (children :initform '() :accessor children) (depth :initform 0 :reader depth)) - (:documentation "Standard instantiable class for undo trees.")) + (:documentation "The base class for all undo records. + +Client code typically derives subclasses of this class that are +specific to the application."))
(defmethod initialize-instance :after ((tree standard-undo-tree) &rest args) (declare (ignore args)) @@ -78,11 +82,14 @@ (leaf-record tree) tree))
(defclass undo-record () () - (:documentation "The protocol class for all undo records.")) + (:documentation "The base class for all undo records."))
(defclass standard-undo-record (undo-record) ((parent :initform nil :accessor parent) - (tree :initform nil :accessor undo-tree) + (tree :initform nil + :accessor undo-tree + :documentation "The undo tree to which the undo record +belongs.") (children :initform '() :accessor children) (depth :initform nil :accessor depth)) (:documentation "Standard instantiable class for undo records."))