<commit_before>;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-

;;;  (c) copyright 1998,1999,2000 by <NAME> (<EMAIL>)
;;;  (c) copyright 2001 by <NAME> (<EMAIL>)

;;; 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)

(defmethod do-graphics-with-options ((sheet sheet) func &rest options)
  (with-sheet-medium (medium sheet)
    (apply #'do-graphics-with-options-internal medium sheet func options)))

(defmethod do-graphics-with-options ((medium medium) func &rest options)
  (apply #'do-graphics-with-options-internal medium medium func options))

(defmethod do-graphics-with-options ((sheet t) func &rest options)
  (declare (ignore options))
  (if sheet
      (funcall func sheet)))

(defmethod do-graphics-with-options ((pixmap pixmap) func &rest options)
  (with-pixmap-medium (medium pixmap)
    (apply #'do-graphics-with-options-internal medium medium func options)))

(defmethod do-graphics-with-options-internal ((medium medium) orig-medium func
				     &rest args
				     &key ink clipping-region transformation
					  line-style line-unit line-thickness
					  (line-dashes nil dashes-p)
					  line-joint-shape line-cap-shape
					  (text-style nil text-style-p)
					  (text-family nil text-family-p)
					  (text-face nil text-face-p)
					  (text-size nil text-size-p)
				     &allow-other-keys)
  (declare (ignore args))
  (let ((old-ink (medium-ink medium))
	(old-clip (medium-clipping-region medium))
	(old-transform (medium-transformation medium))
	(old-line-style (medium-line-style medium))
	(old-text-style (medium-text-style medium)))
    (unwind-protect
	(progn
	  (if ink
	      (setf (medium-ink medium) ink))
	  (if transformation
	      (setf (medium-transformation medium)
		(compose-transformations old-transform transformation)))
	  (if clipping-region
	      (setf (medium-clipping-region medium)
		(region-intersection old-clip
				     (transform-region clipping-region
						       (medium-transformation medium)))))
	  (if (null line-style)
	      (setf line-style old-line-style))
	  (if (or line-unit line-thickness dashes-p line-joint-shape line-cap-shape)
	      (setf line-style (make-line-style
				:unit (or line-unit
					  (line-style-unit line-style))
				:thickness (or line-thickness
					       (line-style-thickness line-style))
				:dashes (or line-dashes
					    (line-style-dashes line-style))
				:joint-shape (or line-joint-shape
						 (line-style-joint-shape line-style))
				:cap-shape (or line-cap-shape
					       (line-style-cap-shape line-style)))))
	  (setf (medium-line-style medium) line-style)
	  (if text-style-p
	      (setf text-style (merge-text-styles text-style
						  (medium-merged-text-style medium)))
	    (setf text-style (medium-merged-text-style medium)))
	  (if (or text-family-p text-face-p text-size-p)
	      (setf text-style (merge-text-styles (make-text-style text-family
								   text-face
								   text-size)
						  text-style)))
	  (setf (medium-text-style medium) text-style)
	  (when orig-medium
	    (funcall func orig-medium)))
      (setf (medium-ink medium) old-ink)
      (setf (medium-clipping-region medium) old-clip)
      (setf (medium-transformation medium) old-transform)
      (setf (medium-line-style medium) old-line-style)
      (setf (medium-text-style medium) old-text-style))))

(defmacro with-medium-options ((sheet args)
			       &body body)
  `(flet ((graphics-op (medium)
	    ,@body))
     #-clisp (declare (dynamic-extent #'graphics-op))
     (apply #'do-graphics-with-options ,sheet #'graphics-op ,args)))

(defun draw-point (sheet point
		   &rest args
		   &key ink clipping-region transformation
			line-style line-thickness line-unit)
  (declare (ignore ink clipping-region transformation
		   line-style line-thickness line-unit))
  (with-medium-options (sheet args)
    (multiple-value-bind (x y) (point-position point)
      (medium-draw-point* medium x y))))
<commit_msg>Implemented with-drawing-options. As a result, with- transformation macros are now working.<commit_after>;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-

;;;  (c) copyright 1998,1999,2000 by <NAME> (<EMAIL>)
;;;  (c) copyright 2001 by <NAME> (<EMAIL>)

;;; 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)

(defmethod do-graphics-with-options ((sheet sheet) func &rest options)
  (with-sheet-medium (medium sheet)
    (apply #'do-graphics-with-options-internal medium sheet func options)))

(defmethod do-graphics-with-options ((medium medium) func &rest options)
  (apply #'do-graphics-with-options-internal medium medium func options))

(defmethod do-graphics-with-options ((sheet t) func &rest options)
  (declare (ignore options))
  (if sheet
      (funcall func sheet)))

(defmethod do-graphics-with-options ((pixmap pixmap) func &rest options)
  (with-pixmap-medium (medium pixmap)
    (apply #'do-graphics-with-options-internal medium medium func options)))

(defmethod do-graphics-with-options-internal ((medium medium) orig-medium func
				     &rest args
				     &key ink clipping-region transformation
					  line-style line-unit line-thickness
					  (line-dashes nil dashes-p)
					  line-joint-shape line-cap-shape
					  (text-style nil text-style-p)
					  (text-family nil text-family-p)
					  (text-face nil text-face-p)
					  (text-size nil text-size-p)
				     &allow-other-keys)
  (declare (ignore args))
  (let ((old-ink (medium-ink medium))
	(old-clip (medium-clipping-region medium))
	(old-transform (medium-transformation medium))
	(old-line-style (medium-line-style medium))
	(old-text-style (medium-text-style medium)))
    (unwind-protect
	(progn
	  (if ink
	      (setf (medium-ink medium) ink))
	  (if transformation
	      (setf (medium-transformation medium)
		(compose-transformations old-transform transformation)))
	  (if clipping-region
	      (setf (medium-clipping-region medium)
		(region-intersection old-clip
				     (transform-region clipping-region
						       (medium-transformation medium)))))
	  (if (null line-style)
	      (setf line-style old-line-style))
	  (if (or line-unit line-thickness dashes-p line-joint-shape line-cap-shape)
	      (setf line-style (make-line-style
				:unit (or line-unit
					  (line-style-unit line-style))
				:thickness (or line-thickness
					       (line-style-thickness line-style))
				:dashes (or line-dashes
					    (line-style-dashes line-style))
				:joint-shape (or line-joint-shape
						 (line-style-joint-shape line-style))
				:cap-shape (or line-cap-shape
					       (line-style-cap-shape line-style)))))
	  (setf (medium-line-style medium) line-style)
	  (if text-style-p
	      (setf text-style (merge-text-styles text-style
						  (medium-merged-text-style medium)))
	    (setf text-style (medium-merged-text-style medium)))
	  (if (or text-family-p text-face-p text-size-p)
	      (setf text-style (merge-text-styles (make-text-style text-family
								   text-face
								   text-size)
						  text-style)))
	  (setf (medium-text-style medium) text-style)
	  (when orig-medium
	    (funcall func orig-medium)))
      (setf (medium-ink medium) old-ink)
      (setf (medium-clipping-region medium) old-clip)
      (setf (medium-transformation medium) old-transform)
      (setf (medium-line-style medium) old-line-style)
      (setf (medium-text-style medium) old-text-style))))

(defmacro with-medium-options ((sheet args)
			       &body body)
  `(flet ((graphics-op (medium)
	    ,@body))
     #-clisp (declare (dynamic-extent #'graphics-op))
     (apply #'do-graphics-with-options ,sheet #'graphics-op ,args)))

(defmacro with-drawing-options ((medium &rest drawing-options) &body body)
  (when (eq medium t)
    (setq medium '*standard-output*))
  (let ((gcontinuation (gensym)))
    `(flet ((,gcontinuation (,medium)
             ,@body))
      #-clisp (declare (dynamic-extent #',gcontinuation))
      (apply #'invoke-with-drawing-options
             ,medium #',gcontinuation (list ,@drawing-options)))))

(defmethod invoke-with-drawing-options ((medium medium) continuation
                                        &rest drawing-options
                                        &key ink transformation clipping-region
                                        line-style text-style)
  (declare (ignore ink transformation clipping-region line-style text-style))
  (with-medium-options (medium drawing-options)
    (funcall continuation medium)))

(defmethod invoke-with-drawing-options ((sheet sheet) continuation &rest drawing-options)
  (with-sheet-medium (medium sheet)
    (apply #'invoke-with-drawing-options medium continuation drawing-options)))

(defun draw-point (sheet point
		   &rest args
		   &key ink clipping-region transformation
			line-style line-thickness line-unit)
  (declare (ignore ink clipping-region transformation
		   line-style line-thickness line-unit))
  (with-medium-options (sheet args)
    (multiple-value-bind (x y) (point-position point)
      (medium-draw-point* medium x y))))

{'fraction_non_alphanumeric': 0.1263218611805422, 'fraction_numerical': 0.005960392232263027, 'mean_word_length': 3.1479266347687402, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '173738', 'n_tokens_mistral': 3544, 'n_tokens_neox': 3129, 'n_words': 932}