This file is indexed.

/usr/share/common-lisp/source/mcclim/output.lisp is in cl-mcclim 0.9.6.dfsg.cvs20100315-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-

;;;  (c) copyright 1998,1999,2000 by Michael McDonald (mikemac@mikemac.com)

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the 
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
;;; Boston, MA  02111-1307  USA.

(in-package :clim-internals)

(defclass standard-sheet-output-mixin ()
  (
   ))

(defclass sheet-mute-output-mixin ()
  (
   ))

(defclass sheet-with-medium-mixin ()
  ((medium :initform nil
           :reader sheet-medium
           :writer (setf %sheet-medium))))

(macrolet ((frob (fn &rest args)
	     `(defmethod ,fn ,(substitute '(medium sheet-with-medium-mixin)
					  'medium
					  args)
	        ;; medium arg is really a sheet
		(let ((medium (sheet-medium medium)))
		  ,(if (symbolp fn)
		       `(,fn ,@args)
		       `(funcall #',fn ,@args))))))
  (frob medium-foreground medium)
  (frob medium-background medium)
  (frob (setf medium-foreground) design medium)
  (frob (setf medium-background) design medium)
  (frob medium-ink medium)
  (frob (setf medium-ink) design medium)
  (frob medium-transformation medium)
  (frob (setf medium-transformation) transformation medium)
  (frob medium-clipping-region medium)
  (frob (setf medium-clipping-region) region medium)
  (frob medium-line-style medium)
  (frob (setf medium-line-style) line-style medium)
  (frob medium-default-text-style medium)
  (frob (setf medium-default-text-style) text-style medium)
  (frob medium-text-style medium)
  (frob (setf medium-text-style) text-style medium)
  (frob medium-current-text-style medium)
  (frob medium-beep medium))
  
(defclass temporary-medium-sheet-output-mixin (sheet-with-medium-mixin)
  ())

(defclass permanent-medium-sheet-output-mixin (sheet-with-medium-mixin)
  ())

(defmethod initialize-instance :after ((sheet permanent-medium-sheet-output-mixin) &rest args)
  (declare (ignore args))
  ;; hmm, 
  (setf (%sheet-medium sheet) (make-medium (port sheet) sheet))
  ;; hmm...
  (engraft-medium (sheet-medium sheet) (port sheet) sheet))

(defmacro with-sheet-medium ((medium sheet) &body body)
  (check-type medium symbol)
  (let ((fn (gensym)))
    `(labels ((,fn (,medium)
                ,(declare-ignorable-form* medium)
               ,@body))
      (declare (dynamic-extent #',fn))
      (invoke-with-sheet-medium-bound #',fn nil ,sheet))))

(defmacro with-sheet-medium-bound ((sheet medium) &body body)
  (check-type medium symbol)
  (let ((fn (gensym)))
    `(labels ((,fn  (,medium)
                ,(declare-ignorable-form* medium)
               ,@body))
      (declare (dynamic-extent #',fn))
      (invoke-with-sheet-medium-bound #',fn ,medium ,sheet))))

(defmethod invoke-with-sheet-medium-bound (continuation (medium null) (sheet permanent-medium-sheet-output-mixin))
  (funcall continuation (sheet-medium sheet)))

; BTS added this. CHECKME
(defmethod invoke-with-sheet-medium-bound (continuation (medium null) (sheet mirrored-pixmap))
  (funcall continuation (pixmap-medium sheet)))

(defmethod invoke-with-sheet-medium-bound (continuation (medium null) (sheet temporary-medium-sheet-output-mixin))
  (let ((old-medium (sheet-medium sheet))
        (new-medium (allocate-medium (port sheet) sheet)))
    (unwind-protect
         (progn
           (engraft-medium new-medium (port sheet) sheet)
           (setf (%sheet-medium sheet) new-medium)
           (funcall continuation new-medium))
      (setf (%sheet-medium sheet) old-medium)
      (degraft-medium new-medium (port sheet) sheet)
      (deallocate-medium (port sheet) new-medium))))

;; The description of WITH-SHEET-MEDIUM-BOUND in the spec, seems to be
;; extremly bogus, what is its purpose?

(defmethod invoke-with-sheet-medium-bound (continuation
                                           (medium basic-medium)
                                           (sheet permanent-medium-sheet-output-mixin))
  ;; this seems to be extremly bogus to me.
  (funcall continuation medium))

(defmethod invoke-with-sheet-medium-bound (continuation
                                           (medium basic-medium)
                                           (sheet temporary-medium-sheet-output-mixin))
  (cond ((not (null (sheet-medium sheet)))
         (funcall continuation medium))
        (t
         (let ((old-medium (sheet-medium sheet))
               (new-medium medium))
           (unwind-protect
                (progn
                  (engraft-medium new-medium (port sheet) sheet)
                  (setf (%sheet-medium sheet) new-medium)
                  (funcall continuation new-medium))
             (setf (%sheet-medium sheet) old-medium)
             (degraft-medium new-medium (port sheet) sheet) )))))

(defmethod invoke-with-special-choices (continuation (sheet sheet-with-medium-mixin))
  (with-sheet-medium (medium sheet)
    (with-special-choices (medium)
      (funcall continuation sheet))))