/[mcclim]/mcclim/recording.lisp
ViewVC logotype

Diff of /mcclim/recording.lisp

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

revision 1.111 by moore, Fri Aug 13 14:10:11 2004 UTC revision 1.112 by moore, Sun Sep 26 15:57:39 2004 UTC
# Line 294  unspecified. ")) Line 294  unspecified. "))
294    (:method-combination and :most-specific-last))    (:method-combination and :most-specific-last))
295    
296  (defmethod output-record-equal :around (record1 record2)  (defmethod output-record-equal :around (record1 record2)
297    (if (eq (class-of record1) (class-of record2))    (cond ((eq record1 record2)
298        (call-next-method)           ;; Some unusual record -- like a Goatee screen line -- might
299        nil))           ;; exist in two trees at once
300             t)
301            ((eq (class-of record1) (class-of record2))
302             (let ((result (call-next-method)))
303               (if (eq result 'maybe)
304                   nil
305                   result)))
306            (t nil)))
307    
308    ;;; A fallback method so that something's always applicable.
309    
310    (defmethod output-record-equal and (record1 record2)
311      (declare (ignore record1 record2))
312      'maybe)
313    
314  ;;; The code for match-output-records-1 and output-record-equal  ;;; The code for match-output-records-1 and output-record-equal
315  ;;; methods are very similar, hence this macro.  In order to exploit  ;;; methods are very similar, hence this macro.  In order to exploit
# Line 1047  were added." Line 1060  were added."
1060  (defclass standard-displayed-output-record (gs-clip-mixin gs-ink-mixin  (defclass standard-displayed-output-record (gs-clip-mixin gs-ink-mixin
1061                                              basic-output-record                                              basic-output-record
1062                                              displayed-output-record)                                              displayed-output-record)
1063    ((ink :reader displayed-output-record-ink))    ((ink :reader displayed-output-record-ink)
1064    (:documentation "Implementation class for DISPLAYED-OUTPUT-RECORD."))     (stream :initarg :stream))
1065      (:documentation "Implementation class for DISPLAYED-OUTPUT-RECORD.")
1066      (:default-initargs :stream nil))
1067    
1068  (defclass gs-line-style-mixin (graphics-state)  (defclass gs-line-style-mixin (graphics-state)
1069    ((line-style :initarg :line-style :accessor graphics-state-line-style)))    ((line-style :initarg :line-style :accessor graphics-state-line-style)))
# Line 1730  were added." Line 1745  were added."
1745                start-x start-y                start-x start-y
1746                (mapcar #'styled-string-string strings)))))                (mapcar #'styled-string-string strings)))))
1747    
1748  (defmethod* (setf output-record-position) :before  (defmethod* (setf output-record-position) :around
1749      (nx ny (record standard-text-displayed-output-record))      (nx ny (record standard-text-displayed-output-record))
1750    (with-slots (x1 y1 start-x start-y end-x end-y strings) record    (with-slots (x1 y1 start-x start-y end-x end-y strings baseline)
1751          record
1752      (let ((dx (- nx x1))      (let ((dx (- nx x1))
1753            (dy (- ny y1)))            (dy (- ny y1)))
1754        (incf start-x dx)        (multiple-value-prog1
1755        (incf start-y dy)            (call-next-method)
1756        (incf end-x dx)          (incf start-x dx)
1757        (incf end-y dy)          (incf start-y dy)
1758        (loop for s in strings          (incf end-x dx)
1759              do (incf (slot-value s 'start-x) dx)))))          (incf end-y dy)
1760            ;(incf baseline dy)
1761            (loop for s in strings
1762               do (incf (slot-value s 'start-x) dx))))))
1763    
1764  (defmethod replay-output-record ((record standard-text-displayed-output-record)  (defmethod replay-output-record ((record standard-text-displayed-output-record)
1765                                   stream                                   stream
# Line 2102  according to the flags RECORD and DRAW." Line 2121  according to the flags RECORD and DRAW."
2121  (defmethod invoke-with-output-to-output-record  (defmethod invoke-with-output-to-output-record
2122      ((stream output-recording-stream) continuation record-type constructor      ((stream output-recording-stream) continuation record-type constructor
2123       &key)       &key)
2124      (declare (ignore record-type))
2125    (stream-close-text-output-record stream)    (stream-close-text-output-record stream)
2126    (let ((new-record (funcall constructor)))    (let ((new-record (funcall constructor)))
2127      (with-output-recording-options (stream :record t :draw nil)      (with-output-recording-options (stream :record t :draw nil)
# Line 2114  according to the flags RECORD and DRAW." Line 2134  according to the flags RECORD and DRAW."
2134  (defmethod invoke-with-output-to-output-record  (defmethod invoke-with-output-to-output-record
2135      ((stream output-recording-stream) continuation record-type (constructor null)      ((stream output-recording-stream) continuation record-type (constructor null)
2136       &rest initargs)       &rest initargs)
   (declare (ignore record-type))  
2137    (stream-close-text-output-record stream)    (stream-close-text-output-record stream)
2138    (let ((new-record (apply #'make-instance record-type initargs)))    (let ((new-record (apply #'make-instance record-type initargs)))
2139      (with-output-recording-options (stream :record t :draw nil)      (with-output-recording-options (stream :record t :draw nil)
# Line 2213  according to the flags RECORD and DRAW." Line 2232  according to the flags RECORD and DRAW."
2232    
2233  (defmethod output-record-baseline ((record output-record))  (defmethod output-record-baseline ((record output-record))
2234    "Fall back method"    "Fall back method"
2235    (values    (with-bounding-rectangle* (x1 y1 x2 y2)
2236     (bounding-rectangle-max-y record)        record
2237     nil))      (declare (ignore x1 x2))
2238        (values (- y2 y1) nil)))
2239    
2240  (defmethod output-record-baseline ((record standard-text-displayed-output-record))  (defmethod output-record-baseline ((record standard-text-displayed-output-record))
2241    (with-slots (baseline) record    (with-slots (baseline) record
# Line 2231  according to the flags RECORD and DRAW." Line 2251  according to the flags RECORD and DRAW."
2251                                   (return-from output-record-baseline                                   (return-from output-record-baseline
2252                                     (values baseline t)))))                                     (values baseline t)))))
2253                             record)                             record)
2254    (values (bounding-rectangle-max-y record) nil))    (call-next-method))
2255    
2256  ;;; ----------------------------------------------------------------------------  ;;; ----------------------------------------------------------------------------
2257  ;;;  copy-textual-output  ;;;  copy-textual-output

Legend:
Removed from v.1.111  
changed lines
  Added in v.1.112

  ViewVC Help
Powered by ViewVC 1.1.5