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

;;;  (c) copyright 1998,1999,2000 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)

(defvar *application-frame* nil)
(defvar *default-frame-manager* nil)

;;; Application-Frame class

(defclass application-frame ()
  ((port :initform nil
	 :initarg :port
	 :accessor port)
   (graft :initform nil
	  :initarg :graft
	  :accessor graft)
   (name :initarg :name
	 :reader frame-name)
   (pretty-name :initarg :pretty-name
		:accessor frame-pretty-name)
   (command-table :initarg :command-table
		  :initform nil
		  :accessor frame-command-table)
   (disabled-commands :initarg :disabled-commands
		      :initform nil
		      :accessor frame-disabled-commands)
   (pane :reader frame-pane)
   (panes :initform nil
	  :reader frame-panes)
   (layouts :initform nil
	    :initarg :layouts
	    :reader frame-layouts)
   (current-layout :initform nil
		   :initarg :current-layout
		   :reader frame-current-layout)
   (top-level-sheet :initform nil
		    :reader frame-top-level-sheet)
   (menu-bar :initarg :menu-bar
	     :initform nil)
   (calling-frame :initarg :calling-frame
		  :initform nil)
   (state :initarg :state
	  :initform nil
	  :accessor frame-state)
   (manager :initform nil
	    :reader frame-manager)
   (properties :initarg :properties
	       :initform nil)
   (top-level :initform '(default-frame-top-level)
	      :initarg :top-level
	      :reader frame-top-level)
   ))

(defun application-frame-p (x)
  (typep x 'application-frame))

(defmethod initialize-instance :after ((frame application-frame) &rest args)
  (declare (ignore args))
  )

(defclass standard-application-frame (application-frame)
  ())

(defmethod (setf frame-manager) (fm (frame application-frame))
  (let ((old-manager (frame-manager frame)))
    (setf (slot-value frame 'manager) nil)
    (when old-manager
      (disown-frame old-manager frame)
      (setf (slot-value frame 'panes) nil)
      (setf (slot-value frame 'layouts) nil))
    (setf (slot-value frame 'manager) fm)))

(defmethod calculate-standard-panes ((frame application-frame))
  ;; Should find the panes for 
  )

(defmethod (setf frame-current-layout) (name (frame application-frame))
  (declare (ignore name))
  (generate-panes (frame-manager frame) frame))

(defmethod generate-panes :before (fm  (frame application-frame))
  (declare (ignore fm))
  (when (and (slot-boundp frame 'pane)
	     (frame-pane frame))
    (unrealize-mirror (port frame) (frame-pane frame))
    (sheet-disown-child (frame-top-level-sheet frame) (frame-pane frame))))

(defmethod generate-panes :after (fm  (frame application-frame))
  (declare (ignore fm))
  (sheet-adopt-child (frame-top-level-sheet frame) (frame-pane frame))
  (let ((space (compose-space (frame-top-level-sheet frame))))
    (setf (sheet-region (frame-top-level-sheet frame))
      (make-bounding-rectangle 100 100
			       (+ 100 (space-requirement-width space))
			       (+ 100 (space-requirement-height space))))
    (allocate-space (frame-top-level-sheet frame)
		    (space-requirement-width space) (space-requirement-height space)))
  (realize-mirror (port frame) (frame-top-level-sheet frame))
  (calculate-standard-panes frame))

(defmethod find-pane-named ((frame application-frame) name)
  (loop for pane in (frame-panes frame)
      if (eq (pane-name pane) name)
      return pane))

(defmethod layout-frame ((frame application-frame) &optional width height)
  (let ((pane (frame-pane frame)))
    (if (and  width (not height))
	(error "LAYOUT-FRAME must be called with both WIDTH and HEIGHT or neither"))
    (if (and (null width) (null height))
	(let ((space (compose-space pane)))
	  (setq width (space-requirement-width space))
	  (setq height (space-requirement-height space))))
    (allocate-space pane width height)))

(defmethod frame-standard-output ((frame application-frame))
  (or (loop for pane in (frame-panes frame)
	  if (typep pane 'application-pane)
	  return pane
	  finally (return nil))
      (loop for pane in (frame-panes frame)
	  if (typep pane 'interactor-pane)
	  return pane
	  finally (return nil))))

(defmethod frame-standard-input ((frame application-frame))
  (or (loop for pane in (frame-panes frame)
	  if (typep pane 'interactor-pane)
	  return pane
	  finally (return nil))
      (frame-standard-output frame)))

(defmethod frame-query-io ((frame application-frame))
  (or (frame-standard-input frame)
      (frame-standard-output frame)))

(defmethod frame-error-output ((frame application-frame))
  (frame-standard-output frame))

(defvar *pointer-documentation-output* nil)

(defmethod frame-pointer-documentation-output ((frame application-frame))
  (loop for pane in (frame-panes frame)
      if (typep pane 'pointer-documentation-pane)
      return pane
      finally (return nil)))

;;; Command loop interface

(defmethod run-frame-top-level ((frame application-frame))
  (apply (first (frame-top-level frame)) frame (rest (frame-top-level frame))))

(defmethod run-frame-top-level :around ((frame application-frame))
  (let ((*application-frame* frame)
	(*input-context* nil)
	(*input-wait-test* nil)
	(*input-wait-handler* nil)
	(*pointer-button-press-handler* nil))
    (declare (special *input-context* *input-wait-test* *input-wait-handler*
		      *pointer-button-press-handler*))
    (call-next-method)))

(defmethod default-frame-top-level
    ((frame application-frame)
     &key (command-parser 'command-line-command-parser)
	  (command-unparser 'command-line-command-unparser)
	  (partial-command-parser
	   'command-line-read-remaining-arguments-for-partial-command)
	  (prompt "Command: "))
  (let ((*standard-input* (frame-standard-input frame))
	(*standard-output* (frame-standard-output frame))
	(*query-io* (frame-query-io frame))
	(*error-output* (frame-error-output frame))
	(*command-parser* command-parser)
	(*command-unparser* command-unparser)
	(*partial-command-parser* partial-command-parser)
	(prompt-style (make-text-style :fixed :italic :normal))
	results)
    (setf (cursor-visibility (stream-text-cursor *standard-input*)) t)
    (loop do<commit_msg>Don't redirect *error-output* during development to faclitate debugging<commit_after>;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-

;;;  (c) copyright 1998,1999,2000 by Michael McDonald (<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)

(defvar *application-frame* nil)
(defvar *default-frame-manager* nil)

;;; Application-Frame class

(defclass application-frame ()
  ((port :initform nil
	 :initarg :port
	 :accessor port)
   (graft :initform nil
	  :initarg :graft
	  :accessor graft)
   (name :initarg :name
	 :reader frame-name)
   (pretty-name :initarg :pretty-name
		:accessor frame-pretty-name)
   (command-table :initarg :command-table
		  :initform nil
		  :accessor frame-command-table)
   (disabled-commands :initarg :disabled-commands
		      :initform nil
		      :accessor frame-disabled-commands)
   (pane :reader frame-pane)
   (panes :initform nil
	  :reader frame-panes)
   (layouts :initform nil
	    :initarg :layouts
	    :reader frame-layouts)
   (current-layout :initform nil
		   :initarg :current-layout
		   :reader frame-current-layout)
   (top-level-sheet :initform nil
		    :reader frame-top-level-sheet)
   (menu-bar :initarg :menu-bar
	     :initform nil)
   (calling-frame :initarg :calling-frame
		  :initform nil)
   (state :initarg :state
	  :initform nil
	  :accessor frame-state)
   (manager :initform nil
	    :reader frame-manager)
   (properties :initarg :properties
	       :initform nil)
   (top-level :initform '(default-frame-top-level)
	      :initarg :top-level
	      :reader frame-top-level)
   ))

(defun application-frame-p (x)
  (typep x 'application-frame))

(defmethod initialize-instance :after ((frame application-frame) &rest args)
  (declare (ignore args))
  )

(defclass standard-application-frame (application-frame)
  ())

(defmethod (setf frame-manager) (fm (frame application-frame))
  (let ((old-manager (frame-manager frame)))
    (setf (slot-value frame 'manager) nil)
    (when old-manager
      (disown-frame old-manager frame)
      (setf (slot-value frame 'panes) nil)
      (setf (slot-value frame 'layouts) nil))
    (setf (slot-value frame 'manager) fm)))

(defmethod calculate-standard-panes ((frame application-frame))
  ;; Should find the panes for 
  )

(defmethod (setf frame-current-layout) (name (frame application-frame))
  (declare (ignore name))
  (generate-panes (frame-manager frame) frame))

(defmethod generate-panes :before (fm  (frame application-frame))
  (declare (ignore fm))
  (when (and (slot-boundp frame 'pane)
	     (frame-pane frame))
    (unrealize-mirror (port frame) (frame-pane frame))
    (sheet-disown-child (frame-top-level-sheet frame) (frame-pane frame))))

(defmethod generate-panes :after (fm  (frame application-frame))
  (declare (ignore fm))
  (sheet-adopt-child (frame-top-level-sheet frame) (frame-pane frame))
  (let ((space (compose-space (frame-top-level-sheet frame))))
    (setf (sheet-region (frame-top-level-sheet frame))
      (make-bounding-rectangle 100 100
			       (+ 100 (space-requirement-width space))
			       (+ 100 (space-requirement-height space))))
    (allocate-space (frame-top-level-sheet frame)
		    (space-requirement-width space) (space-requirement-height space)))
  (realize-mirror (port frame) (frame-top-level-sheet frame))
  (calculate-standard-panes frame))

(defmethod find-pane-named ((frame application-frame) name)
  (loop for pane in (frame-panes frame)
      if (eq (pane-name pane) name)
      return pane))

(defmethod layout-frame ((frame application-frame) &optional width height)
  (let ((pane (frame-pane frame)))
    (if (and  width (not height))
	(error "LAYOUT-FRAME must be called with both WIDTH and HEIGHT or neither"))
    (if (and (null width) (null height))
	(let ((space (compose-space pane)))
	  (setq width (space-requirement-width space))
	  (setq height (space-requirement-height space))))
    (allocate-space pane width height)))

(defmethod frame-standard-output ((frame application-frame))
  (or (loop for pane in (frame-panes frame)
	  if (typep pane 'application-pane)
	  return pane
	  finally (return nil))
      (loop for pane in (frame-panes frame)
	  if (typep pane 'interactor-pane)
	  return pane
	  finally (return nil))))

(defmethod frame-standard-input ((frame application-frame))
  (or (loop for pane in (frame-panes frame)
	  if (typep pane 'interactor-pane)
	  return pane
	  finally (return nil))
      (frame-standard-output frame)))

(defmethod frame-query-io ((frame application-frame))
  (or (frame-standard-input frame)
      (frame-standard-output frame)))

(defmethod frame-error-output ((frame application-frame))
  (frame-standard-output frame))

(defvar *pointer-documentation-output* nil)

(defmethod frame-pointer-documentation-output ((frame application-frame))
  (loop for pane in (frame-panes frame)
      if (typep pane 'pointer-documentation-pane)
      return pane
      finally (return nil)))

;;; Command loop interface

(defmethod run-frame-top-level ((frame application-frame))
  (apply (first (frame-top-level frame)) frame (rest (frame-top-level frame))))

(defmethod run-frame-top-level :around ((frame application-frame))
  (let ((*application-frame* frame)
	(*input-context* nil)
	(*input-wait-test* nil)
	(*input-wait-handler* nil)
	(*pointer-button-press-handler* nil))
    (declare (special *input-context* *input-wait-test* *input-wait-handler*
		      *pointer-button-press-handler*))
    (call-next-method)))

(defmethod default-frame-top-level
    ((frame application-frame)
     &key (command-parser 'command-line-command-parser)
	  (command-unparser 'command-line-command-unparser)
	  (partial-command-parser
	   'command-line-read-remaining-arguments-for-partial-command)
	  (prompt "Command: "))
  (let ((*standard-input* (frame-standard-input frame))
	(*standard-output* (frame-standard-output frame))
	(*query-io* (frame-query-io frame))
	;; during development, don't alter *error-output*
	;(*error-output* (frame-error-output frame))
	(*command-parser* command-parser)
	(*command-unparser* command-unparser)
	(*partial-command-parser* partial-command-parser)
	(prompt-style (make-text-style :fixed :italic :normal))
	results)
    (setf (cursor-visibility (stream-text-cursor *standard-input*)) t)
    (loop do
{'fraction_non_alphanumeric': 0.1336312527028975, 'fraction_numerical': 0.005622026812743261, 'mean_word_length': 3.892454160789845, 'pattern_counts': {'":': 0, '<': 6, '<?xml version=': 0, '>': 6, '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': '854206', 'n_tokens_mistral': 4590, 'n_tokens_neox': 4330, 'n_words': 1274}