Skip to content
Snippets Groups Projects
Commit 951faf4e authored by cer's avatar cer
Browse files

random changes.

parent a1642ca2
No related branches found
No related tags found
No related merge requests found
-------------------------------------------------------------------------------
from cer: Fri Jun 4 09:05:19 PDT 1993
Makefile.defs hacking for 2.0.beta2
......
# $fiHeader: Makefile.generic,v 1.11 1993/05/05 01:38:00 cer Exp $
# $fiHeader: Makefile.generic,v 1.12 1993/06/04 16:06:14 cer Exp $
#
# Makefile.generic for CLIM 2.0
#
......@@ -176,6 +176,11 @@ clim-small: FORCE
train : FORCE
$(TRAIN_TEXT)
profile : FORCE
$(ECHO) "\
(clim-user::run-profile-clim-tests) \
" | $(CLIM) $(CLOPTS) -batch
benchmark:
$(ECHO) "\
(clim-user::benchmark-clim $(BENCHMARK_FILE)) \
......
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
;; $fiHeader: db-layout.lisp,v 1.32 93/04/16 09:45:22 cer Exp $
;; $fiHeader: db-layout.lisp,v 1.33 1993/05/05 01:39:39 cer Exp $
(in-package :silica)
......@@ -426,15 +426,39 @@
;;--- What is the correct behavior. Should it take a space requirement?
;;--- and just call ALLOCATE-SPACE?
(defclass bboard-pane (space-requirement-mixin layout-pane) ())
(defclass bboard-pane (space-requirement-mixin layout-pane)
((contents :initarg :contents :initform nil)))
(defmethod handle-event :after ((pane bboard-pane) (event pointer-motion-event))
(deallocate-event event))
(defmethod initialize-instance :after ((pane bboard-pane) &key contents)
(dolist (item contents)
(destructuring-bind (position child) item
(check-type position (or position cons))
(sheet-adopt-child pane child))))
(defmethod allocate-space ((pane bboard-pane) width height)
(declare (ignore width height))
(dolist (child (sheet-children pane))
(let ((space-req (compose-space child)))
(resize-sheet child
(space-requirement-width space-req)
(space-requirement-height space-req)))))
(with-slots (contents) pane
(destructuring-bind (position child) item
(let ((space-req (compose-space child)))
(multiple-value-bind (x y)
(typecase position
(point (values (point-x position)
(point-y position)))
(cons
(values (first position)
(second position)))))
(move-and-resize-sheet
child x y
(space-requirement-width space-req)
(space-requirement-height space-req))))))
(defmacro bulletin-board (options &rest contents)
`(make-pane 'bboard-pane
(list ,@(mapcar #'(lambda (item)
(destructuring-bind (position sheet) item
`(list (list ,@position ,sheet))))
contents))
,@options))
......@@ -20,7 +20,7 @@
;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
;; applicable.
;;
;; $fiHeader: test-clim.lisp,v 1.8 1993/06/02 18:42:01 cer Exp $
;; $fiHeader: test-clim.lisp,v 1.9 1993/06/04 16:06:46 cer Exp $
(in-package :clim-user)
......@@ -609,14 +609,14 @@
(exit-clim-tests))))
(define-profile-clim-tests))
(defun run-profile-clim-tests ()
(defun run-profile-clim-tests (&optional (prefix "notes/profiles"))
(let ((prof::*hidden-packages* nil)
(prof::*significance-threshold* 0.001)
(prof::*fractional-significance-threshold* .002))
(with-test-success-expected ('run-profile-clim-tests-time)
(do-frame-test-with-profiling 'profile-clim-tests :type :time))
(do-frame-test-with-profiling 'profile-clim-tests :prefix prefix :type :time))
(with-test-success-expected ('run-profile-clim-tests-space)
(do-frame-test-with-profiling 'profile-clim-tests :type :space))))
(do-frame-test-with-profiling 'profile-clim-tests :prefix prefix :type :space))))
;;
......
......@@ -740,7 +740,7 @@
(eval-when (compile load eval)
(require :prof))
(defun do-frame-test-with-profiling (test &key (type :time))
(defun do-frame-test-with-profiling (test &key (type :time) prefix)
(flet ((profiling-hook (invocation command continuation)
;;-- it would be nice to restrict it to the invocation process
(if (or (atom command)
......@@ -752,10 +752,10 @@
(prof::start-profiler :type type :verbose nil)
(funcall continuation))
(profiler:stop-profiler))
(with-open-file (*standard-output* (format nil "notes/profiles/~A.~A-tree.lisp" (car command) type)
(with-open-file (*standard-output* (format nil "~A/~A.~A-tree.lisp" prefix (car command) type)
:direction :output :if-exists :supersede)
(prof:show-call-graph))
(with-open-file (*standard-output* (format nil "notes/profiles/~A.~A-flat.lisp" (car command) type)
(with-open-file (*standard-output* (format nil "~A/~A.~A-flat.lisp" prefix (car command) type)
:direction :output :if-exists :supersede)
(prof:show-flat-profile))))))
(let ((*execute-one-command-hook* #'profiling-hook))
......
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
;; $fiHeader: transformations.lisp,v 1.9 92/08/18 17:24:17 cer Exp $
;; $fiHeader: transformations.lisp,v 1.10 92/11/06 19:05:24 cer Exp $
(in-package :clim-utils)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment