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

;;;  (c) copyright 1998,1999,2000 by <NAME> (<EMAIL>)
;;;  (c) copyright 2001,2002 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.

;;; Implementation of the presentation type system, presentation generic
;;; functions and methods, presentation translators, finding an applicable
;;;presentation.

(in-package :clim-internals)

;;; PRESENTATION class

(defvar *allow-sensitive-inferiors* t)

(defclass presentation-mixin (presentation)
  ((object :accessor presentation-object :initarg :object)
   (type :accessor presentation-type :initarg :type)
   (view :accessor presentation-view :initarg :view)
   (single-box :accessor presentation-single-box :initarg :single-box
	       :initform nil)
   (modifier :reader presentation-modifier :initarg :modifier :initform nil)
   (is-sensitive :reader is-sensitive :initarg :is-sensitive
		 :initform *allow-sensitive-inferiors*)))


(defclass standard-presentation
    (presentation-mixin standard-sequence-output-record)
  ())

(defvar *print-presentation-verbose* nil)

(defmethod print-object ((self standard-presentation) stream)
  (print-unreadable-object (self stream :type t :identity t)
    (with-bounding-rectangle* (x1 y1 x2 y2)
	self
      (format stream "~D:~D,~D:~D ~S" x1 x2 y1 y2 (presentation-type self))
      (when *print-presentation-verbose*
	(format stream " ~S" (presentation-object self))))))

(defmacro with-output-as-presentation ((stream object type
					       &rest key-args
					       &key modifier single-box
					       (allow-sensitive-inferiors t)
					       parent
					       (record-type
						''standard-presentation)
					       &allow-other-keys)
				       &body body)
  (declare (ignore parent single-box modifier))
  (setq stream (stream-designator-symbol stream '*standard-output*))
  (multiple-value-bind (decls with-body)
      (get-body-declarations body)
    (with-gensyms (record-arg continuation)
      (with-keywords-removed (key-args (:record-type
					:allow-sensitive-inferiors))
	`(flet ((,continuation ()
		  ,@decls
		  ,@with-body))
	   (declare (dynamic-extent #',continuation))
	   (if (and (output-recording-stream-p ,stream)
		    *allow-sensitive-inferiors*)
	       (with-new-output-record
		   (,stream ,record-type ,record-arg
			    :object ,object
			    :type (expand-presentation-type-abbreviation
				   ,type)
			    ,@key-args)
		 (let ((*allow-sensitive-inferiors*
			,allow-sensitive-inferiors))
		   (,continuation)))
	       (,continuation)))))))

(defgeneric ptype-specializer (type)
  (:documentation "The specializer to use for this type in a presentation
method lambda list"))

;;; Metaclass for presentation types.  For presentation types not associated
;;; with CLOS classes, objects with this metaclass are used as a proxy for the
;;; type during presentation method dispatch. We don't prevent these
;;; presentation proxies from being subclasses of standard-object,
;;; but in presentation method dispatch we remove methods on standard
;;; object for presentation types that are not CLOS classes. The
;;; presentation type metaclass for T is the builtin object T instead
;;; of a presentation-type-class; in this way we can avoid weirdness
;;; with T being a subtype of standard-object!
;;;

(defclass presentation-type ()
  ((type-name :accessor type-name :initarg :type-name
	      :documentation "The name assigned to the presentation
type, as opposed to the name constructed for the class")
   (ptype-specializer :accessor ptype-specializer :initarg :ptype-specializer)
   (parameters :accessor parameters :initarg :parameters :initform nil)
   (parameters-lambda-list :accessor parameters-lambda-list
			   :initarg :parameters-lambda-list
			   :initform nil
			   :documentation "The parameters lambda list, altered for use in destructuring bind")
   (options :accessor options :initarg :options :initform nil)
   (options-lambda-list :accessor options-lambda-list
			:initarg :options-lambda-list<commit_msg>Wrapped DEFGENERIC form in EVAL-WHEN for compile-time effect.<commit_after>;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-

;;;  (c) copyright 1998,1999,2000 by <NAME> (<EMAIL>)
;;;  (c) copyright 2001,2002 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.

;;; Implementation of the presentation type system, presentation generic
;;; functions and methods, presentation translators, finding an applicable
;;;presentation.

(in-package :clim-internals)

;;; PRESENTATION class

(defvar *allow-sensitive-inferiors* t)

(defclass presentation-mixin (presentation)
  ((object :accessor presentation-object :initarg :object)
   (type :accessor presentation-type :initarg :type)
   (view :accessor presentation-view :initarg :view)
   (single-box :accessor presentation-single-box :initarg :single-box
	       :initform nil)
   (modifier :reader presentation-modifier :initarg :modifier :initform nil)
   (is-sensitive :reader is-sensitive :initarg :is-sensitive
		 :initform *allow-sensitive-inferiors*)))


(defclass standard-presentation
    (presentation-mixin standard-sequence-output-record)
  ())

(defvar *print-presentation-verbose* nil)

(defmethod print-object ((self standard-presentation) stream)
  (print-unreadable-object (self stream :type t :identity t)
    (with-bounding-rectangle* (x1 y1 x2 y2)
	self
      (format stream "~D:~D,~D:~D ~S" x1 x2 y1 y2 (presentation-type self))
      (when *print-presentation-verbose*
	(format stream " ~S" (presentation-object self))))))

(defmacro with-output-as-presentation ((stream object type
					       &rest key-args
					       &key modifier single-box
					       (allow-sensitive-inferiors t)
					       parent
					       (record-type
						''standard-presentation)
					       &allow-other-keys)
				       &body body)
  (declare (ignore parent single-box modifier))
  (setq stream (stream-designator-symbol stream '*standard-output*))
  (multiple-value-bind (decls with-body)
      (get-body-declarations body)
    (with-gensyms (record-arg continuation)
      (with-keywords-removed (key-args (:record-type
					:allow-sensitive-inferiors))
	`(flet ((,continuation ()
		  ,@decls
		  ,@with-body))
	   (declare (dynamic-extent #',continuation))
	   (if (and (output-recording-stream-p ,stream)
		    *allow-sensitive-inferiors*)
	       (with-new-output-record
		   (,stream ,record-type ,record-arg
			    :object ,object
			    :type (expand-presentation-type-abbreviation
				   ,type)
			    ,@key-args)
		 (let ((*allow-sensitive-inferiors*
			,allow-sensitive-inferiors))
		   (,continuation)))
	       (,continuation)))))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defgeneric ptype-specializer (type)
    (:documentation "The specializer to use for this type in a presentation
method lambda list")))

;;; Metaclass for presentation types.  For presentation types not associated
;;; with CLOS classes, objects with this metaclass are used as a proxy for the
;;; type during presentation method dispatch. We don't prevent these
;;; presentation proxies from being subclasses of standard-object,
;;; but in presentation method dispatch we remove methods on standard
;;; object for presentation types that are not CLOS classes. The
;;; presentation type metaclass for T is the builtin object T instead
;;; of a presentation-type-class; in this way we can avoid weirdness
;;; with T being a subtype of standard-object!
;;;

(defclass presentation-type ()
  ((type-name :accessor type-name :initarg :type-name
	      :documentation "The name assigned to the presentation
type, as opposed to the name constructed for the class")
   (ptype-specializer :accessor ptype-specializer :initarg :ptype-specializer)
   (parameters :accessor parameters :initarg :parameters :initform nil)
   (parameters-lambda-list :accessor parameters-lambda-list
			   :initarg :parameters-lambda-list
			   :initform nil
			   :documentation "The parameters lambda list, altered for use in destructuring bind")
   (options :accessor options :initarg :options :initform nil)
   (options-lambda-list :accessor options-lambda-list
			:initarg :options-lambda-list
{'fraction_non_alphanumeric': 0.11047360734404339, 'fraction_numerical': 0.0089714166492802, 'mean_word_length': 3.967357512953368, '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': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6229777', 'n_tokens_mistral': 3032, 'n_tokens_neox': 2685, 'n_words': 960}