source: trunk/source/cocoa-ide/defsystem.lisp @ 11991

Last change on this file since 11991 was 11991, checked in by rme, 11 years ago

Add an Experiments menu. The idea is that this menu will include,
er, experimental stuff.

The first experiment: a redesigned and simplified apropos dialog.

At the moment, this code won't work on Tiger. Tiger users will
get an error if they to pick anything from the Experiments menu.
(The IDE should still load, though, thanks to a kludge in the
BUILD-IDE function.)

File size: 3.2 KB
Line 
1;;-*-Mode: LISP; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2007 Clozure Associates
4;;;
5
6(in-package "CCL")
7
8(eval-when (:compile-toplevel :execute)
9  (use-interface-dir :cocoa))
10
11;; These are used to communicate with ide-bundle, which must be loaded before objc-support.
12;; They are defvar'ed so the caller can set them before loading us.
13(defvar *cocoa-application-path* nil)
14(defvar *cocoa-application-copy-headers-p* nil)
15(require "IDE-BUNDLE")
16
17(require "OBJC-SUPPORT")
18
19(defpackage "GUI"
20  (:use :common-lisp :ccl)
21  (:import-from
22   "CCL"
23   ;; symbols defined here
24   *cocoa-application-path*
25   *cocoa-application-copy-headers-p*
26   load-ide
27   build-ide
28   ;; Misc symbols that perhaps should be exported from CCL but currently aren't.
29   report-bad-arg
30   native-translated-namestring
31   make-id-map
32   assign-id-map-id
33   id-map-free-object
34   process-thread
35   process-serial-number
36   ensure-directory-pathname
37   recursive-copy-directory
38   application
39   ;; Symbols that perhaps should be exported by ObjC support but aren't
40   @selector
41   *nsapp*
42   with-nsstr
43   %make-nsstring
44   lisp-string-from-nsstring
45   with-autorelease-pool
46   ns-height
47   ns-width
48   *cocoa-event-process*
49   create-autorelease-pool
50   release-autorelease-pool
51   release-canonical-nsobject
52   objc-message-send
53   open-main-bundle
54   )
55  (:export
56   ))
57
58(defparameter *ide-files*
59  '(;"ide-bundle" - loaded by hand above
60    "cocoa-utils"
61    "cocoa-defaults"
62    "cocoa-prefs"
63    "cocoa-typeout"
64    "console-window"
65    "cocoa-window"
66    "cocoa-doc"
67    "compile-hemlock"
68    "hemlock"  ;; treated specially below, compile-hemlock must come before.
69    "cocoa-editor"
70    "cocoa-listener"
71    "cocoa-grep"
72    "cocoa-backtrace"
73    "inspector"
74    "preferences"
75    "processes-window"
76    "apropos-window"
77    "file-dialogs"
78    "app-delegate"
79    "ide-self-update"
80    "search-files"
81    "start"
82    ))
83
84(defparameter *experimental-ide-files*
85  '("xapropos"))
86
87(defun load-ide (&optional force-compile)
88  (declare (special *hemlock-files*)) ;; kludge
89  (let ((src-dir "ccl:cocoa-ide;")
90        (bin-dir "ccl:cocoa-ide;fasls;"))
91    (ensure-directories-exist bin-dir)
92    ;; kludge to limit experimental files to Leopard
93    (rlet ((p :int))
94      (#_Gestalt #$gestaltSystemVersion p)
95      (when (>= (%get-long p) #x1050)
96        (format t "~&;Running on Leopard.  Will load experimental files.")
97        (setq *ide-files* (append *ide-files* *experimental-ide-files*))))
98    (with-compilation-unit ()
99      (dolist (name *ide-files*)
100        (let* ((source (make-pathname :name name :type (pathname-type *.lisp-pathname*)
101                                      :defaults src-dir))
102               (fasl (make-pathname :name name :type (pathname-type *.fasl-pathname*)
103                                    :defaults bin-dir))
104               (sources (cons source
105                              (and (equalp name "hemlock")
106                                   ;; This is defined in compile-hemlock, which is loaded first
107                                   (mapcar #'hemlock-source-pathname *hemlock-files*)))))
108          (if (needs-compile-p fasl sources force-compile)
109            (progn
110              ;; Once compile something, keep compiling, in case macros changed.
111              (setq force-compile t)
112              (compile-file source :output-file fasl :verbose t :load t))
113            (load fasl :verbose t)))))
114    (provide "COCOA")))
Note: See TracBrowser for help on using the repository browser.