<commit_before>(module messagebox mzscheme
  (require (lib "class.ss")
	   (lib "class100.ss")
	   (lib "etc.ss")
	   (prefix wx: "kernel.ss")
	   "const.ss"
	   "check.ss"
	   "helper.ss"
	   "editor.ss"
	   "mrtop.ss"
	   "mrcanvas.ss"
	   "mrpopup.ss"
	   "mrmenu.ss"
	   "mritem.ss"
	   "mrpanel.ss")

  (provide message-box
	   message-box/custom
	   message+check-box
	   message+check-box/custom)

  (define do-message-box/custom
    (lambda (who title message
		 button1 button2 button3
		 parent style close-result
		 check? two-results? check-message)
      (check-label-string who title)
      (check-string/false who message)
      (when check?
	(check-label-string who check-message))
      (check-label-string-or-bitmap/false who button1)
      (check-label-string-or-bitmap/false who button2)
      (check-label-string-or-bitmap/false who button3)
      (check-top-level-parent/false who parent)
      (check-style who 
		   '(default=1 default=2 default=3 no-default) 
		   (let ([l '(disallow-close number-order caution stop)])
		     (if check?
			 (cons 'checked l)
			 l))
		   style)

      (let* ([strings (let loop ([s message])
			(let ([m (regexp-match #rx"([^\n]*)[\n](.*)" s)])
			  (if m
			      (cons (cadr m) (loop (caddr m)))
			      (list s))))]
	     [single? (and (< (length strings) 10) 
			   (andmap (lambda (s) (< (string-length s) 60)) strings))]
	     [f (make-object (class100 dialog% ()
			       (public
				 [get-message
				  (lambda () message)])
			       (augment
				[can-close? (lambda ()
					      (if (memq 'disallow-close style)
						  (begin
						    (wx:bell)
						    #f)
						  #t))])
			       (override
				 [on-subwindow-event 
				  (lambda (w e)
				    (if (send e button-down?)
					(if (is-a? w button%)
					    #f
					    (if (or (is-a? w message%)
						    (and
						     (is-a? w editor-canvas%)
						     (let-values ([(w h) (send w get-client-size)])
						       (< (send e get-x) w))))
						(begin
						  (send w popup-menu
							(let ([m (make-object popup-menu%)])
							  (make-object menu-item%
								       "Copy Message"
								       m
								       (lambda (i e)
									 (send (wx:get-the-clipboard)
									       set-clipboard-string
									       message
									       (send e get-time-stamp))))
							  m)
							(send e get-x)
							(send e get-y))
						  #t)
						#f))
					#f))])
			       (sequence
				 (super-init title parent box-width))))]
	     [result close-result]
	     [icon-id (cond
		       [(memq 'stop style) 'stop]
		       [(memq 'caution style) 'caution]
		       [else 'app])])
	(let-values ([(msg-pnl btn-pnl cb-pnl extra-width btn-h-align msg-h-align msg-v-align)
		      (case (system-type)
			[(macosx) (let ([p (make-object horizontal-pane% f)])
				    (send f min-width 300)
				    (send p set-alignment 'center 'top)
				    (let ([m (make-object message% icon-id p)])
				      (send m horiz-margin 16)
				      (send m vert-margin 16))
				    (let* ([rhs-pnl (make-object vertical-pane% p)]
					   [msg-pnl (make-object vertical-pane% rhs-pnl)]
					   [btn-pnl (make-object vertical-pane% rhs-pnl)])
				      (send msg-pnl vert-margin 16)
				      (when single?
					(send msg-pnl horiz-margin 8))
				      (send btn-pnl vert-margin 8)
				      (send msg-pnl min-height 64)
				      (send msg-pnl min-width 350)
				      (send btn-pnl stretchable-height #f)
				      (values msg-pnl btn-pnl btn-pnl 96 'right 'left 'top)))]
			[else (let ([p (new horizontal-pane% [parent f] [alignment '(center top)])])
				(let ([icon-msg (make-object message% icon-id p)]
				      [msg-pnl (new vertical-pane% [parent p])])
				  (values (if single?
					      (new horizontal-pane% 
						   [parent msg-pnl]
						   [alignment '(center top)]
						   [min-height (send icon-msg min-height)])
					      msg-pnl)
					  f msg-pnl 0 'center 'center 'center)))])])<commit_msg>adjusted sizes a little bit<commit_after>(module messagebox mzscheme
  (require (lib "class.ss")
	   (lib "class100.ss")
	   (lib "etc.ss")
	   (prefix wx: "kernel.ss")
	   "const.ss"
	   "check.ss"
	   "helper.ss"
	   "editor.ss"
	   "mrtop.ss"
	   "mrcanvas.ss"
	   "mrpopup.ss"
	   "mrmenu.ss"
	   "mritem.ss"
	   "mrpanel.ss")

  (provide message-box
	   message-box/custom
	   message+check-box
	   message+check-box/custom)

  (define do-message-box/custom
    (lambda (who title message
		 button1 button2 button3
		 parent style close-result
		 check? two-results? check-message)
      (check-label-string who title)
      (check-string/false who message)
      (when check?
	(check-label-string who check-message))
      (check-label-string-or-bitmap/false who button1)
      (check-label-string-or-bitmap/false who button2)
      (check-label-string-or-bitmap/false who button3)
      (check-top-level-parent/false who parent)
      (check-style who 
		   '(default=1 default=2 default=3 no-default) 
		   (let ([l '(disallow-close number-order caution stop)])
		     (if check?
			 (cons 'checked l)
			 l))
		   style)

      (let* ([strings (let loop ([s message])
			(let ([m (regexp-match #rx"([^\n]*)[\n](.*)" s)])
			  (if m
			      (cons (cadr m) (loop (caddr m)))
			      (list s))))]
	     [single? (and (< (length strings) 10) 
			   (andmap (lambda (s) (< (string-length s) 60)) strings))]
	     [f (make-object (class100 dialog% ()
			       (public
				 [get-message
				  (lambda () message)])
			       (augment
				[can-close? (lambda ()
					      (if (memq 'disallow-close style)
						  (begin
						    (wx:bell)
						    #f)
						  #t))])
			       (override
				 [on-subwindow-event 
				  (lambda (w e)
				    (if (send e button-down?)
					(if (is-a? w button%)
					    #f
					    (if (or (is-a? w message%)
						    (and
						     (is-a? w editor-canvas%)
						     (let-values ([(w h) (send w get-client-size)])
						       (< (send e get-x) w))))
						(begin
						  (send w popup-menu
							(let ([m (make-object popup-menu%)])
							  (make-object menu-item%
								       "Copy Message"
								       m
								       (lambda (i e)
									 (send (wx:get-the-clipboard)
									       set-clipboard-string
									       message
									       (send e get-time-stamp))))
							  m)
							(send e get-x)
							(send e get-y))
						  #t)
						#f))
					#f))])
			       (sequence
				 (super-init title parent box-width))))]
	     [result close-result]
	     [icon-id (cond
		       [(memq 'stop style) 'stop]
		       [(memq 'caution style) 'caution]
		       [else 'app])])
	(let-values ([(msg-pnl btn-pnl cb-pnl extra-width btn-h-align msg-h-align msg-v-align)
		      (case (system-type)
			[(macosx) (let ([p (make-object horizontal-pane% f)])
				    (send f min-width 300)
				    (send p set-alignment 'center 'top)
				    (let ([m (make-object message% icon-id p)])
				      (send m horiz-margin 16)
				      (send m vert-margin 16))
				    (let* ([rhs-pnl (make-object vertical-pane% p)]
					   [msg-pnl (make-object vertical-pane% rhs-pnl)]
					   [btn-pnl (make-object vertical-pane% rhs-pnl)])
				      (send msg-pnl vert-margin 16)
				      (when single?
					(send msg-pnl horiz-margin 8))
				      (send btn-pnl vert-margin 8)
				      (send msg-pnl min-height 40)
				      (send msg-pnl min-width 300)
				      (send btn-pnl stretchable-height #f)
				      (values msg-pnl btn-pnl btn-pnl 96 'right 'left 'top)))]
			[else (let ([p (new horizontal-pane% [parent f] [alignment '(center top)])])
				(let ([icon-msg (make-object message% icon-id p)]
				      [msg-pnl (new vertical-pane% [parent p])])
				  (values (if single?
					      (new horizontal-pane% 
						   [parent msg-pnl]
						   [alignment '(center top)]
						   [min-height (send icon-msg min-height)])
					      msg-pnl)
					  f msg-pnl 0 'center 'center 'center)))])])
{'fraction_non_alphanumeric': 0.15274949083503056, 'fraction_numerical': 0.009674134419551934, 'mean_word_length': 1.864382063434196, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 3, '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': '1062398', 'n_tokens_mistral': 3572, 'n_tokens_neox': 2666, 'n_words': 703}