<commit_before>;;; -*- Mode: Lisp; Package: CLOUSEAU -*-

;;;  (c) copyright 2005 by
;;;           <NAME> (<EMAIL>)
;;;  (c) copyright 2005 by
;;;           <NAME>
;;;  (c) copyright 2005 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.

;;; CLIM inspector application

(in-package :clouseau)

(define-modify-macro togglef () not)

(define-application-frame inspector ()
  ((dico :initform (make-hash-table) :reader dico)
   (cons-cell-dico :initform (make-hash-table) :reader cons-cell-dico)
   (disassembly-dico :initform (make-hash-table) :reader disassembly-dico
		     :documentation "A hash table specifying which
functions should display disassembly")
   (print-length :initform (make-hash-table) :reader print-length
		 :documentation "A hash table mapping list objects to
their specific print lengths, if they have one.")
   (obj :initarg :obj :reader obj
	:documentation "The object being inspected"))
  (:pointer-documentation t)
  (:panes
   (app :application :width 600 :height 500
	:scroll-bars nil
	:text-style (make-text-style :sans-serif :roman :normal)
	:display-function 'display-app)
   (int :interactor :width 600 :height 100 :max-height 100))
  (:layouts
   (default (vertically () (scrolling () app) int))))

(defmethod initialize-instance :after ((frame inspector) &rest args)
  (declare (ignore args))
  (setf (gethash (obj frame) (dico frame)) t))

;; Remember the scrolling state between redisplays.
(defmethod redisplay-frame-panes :around ((frame inspector) &key force-p)
  (declare (ignore force-p))
  ;; `Make-clim-stream-pane' creates bizarro object hierarchies, so
  ;; getting the actual scrollable is not obvious.
  (let* ((scrollable-pane (sheet-parent (find-pane-named frame 'app)))
         (viewport (pane-viewport scrollable-pane)))
    (multiple-value-bind (x-displacement y-displacement)
        (transform-position (sheet-transformation scrollable-pane) 0 0)
      (call-next-method)
      (scroll-extent scrollable-pane
                     (min (- x-displacement)
                          (- (bounding-rectangle-width scrollable-pane)
                             (bounding-rectangle-width viewport)))
                     (min (- y-displacement)
                          (- (bounding-rectangle-height scrollable-pane)
                             (bounding-rectangle-height viewport)))))))

(defmethod redisplay-frame-pane :after ((frame inspector)
					(pane application-pane)
					&key force-p)
  (declare (ignore force-p))
  (change-space-requirements
   pane
   :height (bounding-rectangle-height (stream-output-history pane))))

(defun inspector (obj &key (new-process nil))
  (flet ((run ()
	   (let ((*print-length* 10)
		 (*print-level* 10))
	     (run-frame-top-level
	      (make-application-frame 'inspector :obj obj)))))
    (if new-process
	(clim-sys:make-process #'run
			       :name (format nil "Inspector Clouseau: ~S"
					     obj))
	(run))
    obj))

(defparameter *inspected-objects* '()
  "A list of objects which are currently being inspected with
INSPECT-OBJECT")

(defgeneric inspect-object-briefly (object pane)
  (:documentation "Inspect an object in a short form, displaying this
on PANE. For example, rather than displaying all the slots of a class,
only the class name would be shown."))

(defgeneric inspect-object (object pane)
  (:documentation "Inspect an object, displaying it on PANE. This can
be as verbose as you like; the important thing is that all the
information is present."))

(defmethod inspect-object :around (object pane)
  (cond ((member object *inspected-objects*)
         (with-output-as-presentation
             (pane object (presentation-type-of object))
           (princ "===" pane)))		; Prevent infinite loops
        ((not (gethash object (dico *application-frame*)))
         (inspect-object-briefly object pane))
        (t
	 (let ((*inspected-objects* (cons object *inspected-objects*))
               (*print-length* (or (gethash object (print-length
						    *application-frame*))
                                   *print-length*)))
           (call-next-method)))))

;; This behavior should be overridden by methods for specific object
;; types that have a more informative short representation. For
;; example, the symbol FOO would be printed as "FOO" instead of "...",
;; since that's just as short and more informative. When it's clicked
;; on, it can then go to a more verbose view.
(defmethod inspect-object-briefly (object pane)
  (with-output-as-presentation
      (pane object (presentation-type-of object))
    (princ "..." pane)))

(defmethod inspect-object (object pane)
  (with-output-as-presentation
      (pane object (presentation-type-of object))
    (prin1 object pane)))


(define-presentation-type settable-slot ()
  :inherit-from t)
(define-presentation-type cons ()
  :inherit-from t)
(define-presentation-type long-list-tail ()
  :inherit-from t)

(define-presentation-method present (object (type settable-slot)
					    stream
					    (view textual-view)
					    &key acceptably for-context-type)
  (declare (ignore acceptably for-context-type))
  (format stream "~s" (cdr object)))

(defmacro with-heading-style ((stream) &body body)
  "Cause text output from BODY to be formatted in a heading font. This
could be boldface, or a different style, or even another font."
  `(with-text-face (,stream :bold)
    ,@body))

(defmacro inspector-table ((object pane) header &body body)
  "Present OBJECT in tabular form on PANE, with HEADER evaluated to
print a label in a box at the top. BODY should output the rows of the
table, possibly using INSPECTOR-TABLE-ROW."
  (let ((evaluated-pane (gensym "pane"))
	(evaluated-object (gensym "object")))
    `(let ((,evaluated-pane ,pane)
	   (,evaluated-object ,object))
      (with-output-as-presentation
	  (pane ,evaluated-object
		(presentation-type-of ,evaluated-object))
	(formatting-table (,evaluated-pane)
	  (formatting-column (,evaluated-pane)
	    (formatting-cell (,evaluated-pane)
	      (surrounding-output-with-border (,evaluated-pane)
		(with-heading-style (,evaluated-pane)
		  ,header)))
	    (formatting-cell (,evaluated-pane)
	      (formatting-table (,evaluated-pane)
		,@body))))
	(print-documentation (if (eql (class-of ,evaluated-object)
				      (find-class 'standard-class))
				 ,evaluated-object
				 (class-of ,evaluated-object))
			     ,evaluated-pane)))))

(defmacro inspector-table-row ((pane) left right)
  "Output a table row with two items, produced by evaluating LEFT and
RIGHT, on PANE. This should be used only within INSPECTOR-TABLE."
  (let ((evaluated-pane (gensym "pane")))
    `(let ((,evaluated-pane ,pane))
      (formatting-row (,evaluated-pane)
	(formatting-cell (,evaluated-pane :align-x :right)
	  (with-heading-style (,evaluated-pane)
	    ,left))
	(formatting-cell (,evaluated-pane)
	  ,right)))))
<commit_msg>Use :single-box t to highlight presentations in Clouseau.<commit_after>;;; -*- Mode: Lisp; Package: CLOUSEAU -*-

;;;  (c) copyright 2005 by
;;;           <NAME> (<EMAIL>)
;;;  (c) copyright 2005 by
;;;           <NAME>
;;;  (c) copyright 2005 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.

;;; CLIM inspector application

(in-package :clouseau)

(define-modify-macro togglef () not)

(define-application-frame inspector ()
  ((dico :initform (make-hash-table) :reader dico)
   (cons-cell-dico :initform (make-hash-table) :reader cons-cell-dico)
   (disassembly-dico :initform (make-hash-table) :reader disassembly-dico
		     :documentation "A hash table specifying which
functions should display disassembly")
   (print-length :initform (make-hash-table) :reader print-length
		 :documentation "A hash table mapping list objects to
their specific print lengths, if they have one.")
   (obj :initarg :obj :reader obj
	:documentation "The object being inspected"))
  (:pointer-documentation t)
  (:panes
   (app :application :width 600 :height 500
	:scroll-bars nil
	:text-style (make-text-style :sans-serif :roman :normal)
	:display-function 'display-app)
   (int :interactor :width 600 :height 100 :max-height 100))
  (:layouts
   (default (vertically () (scrolling () app) int))))

(defmethod initialize-instance :after ((frame inspector) &rest args)
  (declare (ignore args))
  (setf (gethash (obj frame) (dico frame)) t))

;; Remember the scrolling state between redisplays.
(defmethod redisplay-frame-panes :around ((frame inspector) &key force-p)
  (declare (ignore force-p))
  ;; `Make-clim-stream-pane' creates bizarro object hierarchies, so
  ;; getting the actual scrollable is not obvious.
  (let* ((scrollable-pane (sheet-parent (find-pane-named frame 'app)))
         (viewport (pane-viewport scrollable-pane)))
    (multiple-value-bind (x-displacement y-displacement)
        (transform-position (sheet-transformation scrollable-pane) 0 0)
      (call-next-method)
      (scroll-extent scrollable-pane
                     (min (- x-displacement)
                          (- (bounding-rectangle-width scrollable-pane)
                             (bounding-rectangle-width viewport)))
                     (min (- y-displacement)
                          (- (bounding-rectangle-height scrollable-pane)
                             (bounding-rectangle-height viewport)))))))

(defmethod redisplay-frame-pane :after ((frame inspector)
					(pane application-pane)
					&key force-p)
  (declare (ignore force-p))
  (change-space-requirements
   pane
   :height (bounding-rectangle-height (stream-output-history pane))))

(defun inspector (obj &key (new-process nil))
  (flet ((run ()
	   (let ((*print-length* 10)
		 (*print-level* 10))
	     (run-frame-top-level
	      (make-application-frame 'inspector :obj obj)))))
    (if new-process
	(clim-sys:make-process #'run
			       :name (format nil "Inspector Clouseau: ~S"
					     obj))
	(run))
    obj))

(defparameter *inspected-objects* '()
  "A list of objects which are currently being inspected with
INSPECT-OBJECT")

(defgeneric inspect-object-briefly (object pane)
  (:documentation "Inspect an object in a short form, displaying this
on PANE. For example, rather than displaying all the slots of a class,
only the class name would be shown."))

(defgeneric inspect-object (object pane)
  (:documentation "Inspect an object, displaying it on PANE. This can
be as verbose as you like; the important thing is that all the
information is present."))

(defmethod inspect-object :around (object pane)
  (cond ((member object *inspected-objects*)
         (with-output-as-presentation
             (pane object (presentation-type-of object))
           (princ "===" pane)))		; Prevent infinite loops
        ((not (gethash object (dico *application-frame*)))
         (inspect-object-briefly object pane))
        (t
	 (let ((*inspected-objects* (cons object *inspected-objects*))
               (*print-length* (or (gethash object (print-length
						    *application-frame*))
                                   *print-length*)))
           (call-next-method)))))

;; This behavior should be overridden by methods for specific object
;; types that have a more informative short representation. For
;; example, the symbol FOO would be printed as "FOO" instead of "...",
;; since that's just as short and more informative. When it's clicked
;; on, it can then go to a more verbose view.
(defmethod inspect-object-briefly (object pane)
  (with-output-as-presentation
      (pane object (presentation-type-of object))
    (princ "..." pane)))

(defmethod inspect-object (object pane)
  (with-output-as-presentation
      (pane object (presentation-type-of object))
    (prin1 object pane)))


(define-presentation-type settable-slot ()
  :inherit-from t)
(define-presentation-type cons ()
  :inherit-from t)
(define-presentation-type long-list-tail ()
  :inherit-from t)

(define-presentation-method present (object (type settable-slot)
					    stream
					    (view textual-view)
					    &key acceptably for-context-type)
  (declare (ignore acceptably for-context-type))
  (format stream "~s" (cdr object)))

(defmacro with-heading-style ((stream) &body body)
  "Cause text output from BODY to be formatted in a heading font. This
could be boldface, or a different style, or even another font."
  `(with-text-face (,stream :bold)
    ,@body))

(defmacro inspector-table ((object pane) header &body body)
  "Present OBJECT in tabular form on PANE, with HEADER evaluated to
print a label in a box at the top. BODY should output the rows of the
table, possibly using INSPECTOR-TABLE-ROW."
  (let ((evaluated-pane (gensym "pane"))
	(evaluated-object (gensym "object")))
    `(let ((,evaluated-pane ,pane)
	   (,evaluated-object ,object))
      (with-output-as-presentation
	  (pane ,evaluated-object
		(presentation-type-of ,evaluated-object)
                :single-box t)
	(formatting-table (,evaluated-pane)
	  (formatting-column (,evaluated-pane)
	    (formatting-cell (,evaluated-pane)
	      (surrounding-output-with-border (,evaluated-pane)
		(with-heading-style (,evaluated-pane)
		  ,header)))
	    (formatting-cell (,evaluated-pane)
	      (formatting-table (,evaluated-pane)
		,@body))))
	(print-documentation (if (eql (class-of ,evaluated-object)
				      (find-class 'standard-class))
				 ,evaluated-object
				 (class-of ,evaluated-object))
			     ,evaluated-pane)))))

(defmacro inspector-table-row ((pane) left right)
  "Output a table row with two items, produced by evaluating LEFT and
RIGHT, on PANE. This should be used only within INSPECTOR-TABLE."
  (let ((evaluated-pane (gensym "pane")))
    `(let ((,evaluated-pane ,pane))
      (formatting-row (,evaluated-pane)
	(formatting-cell (,evaluated-pane :align-x :right)
	  (with-heading-style (,evaluated-pane)
	    ,left))
	(formatting-cell (,evaluated-pane)
	  ,right)))))

{'fraction_non_alphanumeric': 0.12578740157480314, 'fraction_numerical': 0.006430446194225722, 'mean_word_length': 3.3583071203889046, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1527699', 'n_tokens_mistral': 4981, 'n_tokens_neox': 4534, 'n_words': 1505}