[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Sun Nov 19 11:39:45 UTC 2006
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."))
More information about the Mcclim-cvs
mailing list