Changeset 7698


Ignore:
Timestamp:
Nov 20, 2007, 3:14:16 PM (14 years ago)
Author:
gz
Message:

A new package and a reorg:

I put all the cocoa-ide files (except for a greatly stripped-down
cocoa.lisp and cocoa-application.lisp) in a new package named "GUI".

The package is defined in defsystem.lisp, which also defines a
function to load all the files explicitly, putting the fasls in
cocoa-ide;fasls; I stripped out all pretense that the files can or
should be loaded individually. Also, it is no longer necessary or
appropriate to compile hemlock separately, as it now compiles as
needed as part of the normal loading sequence. (Over time I am hoping
to get hemlock more and more integrated into the IDE, and having to
maintain it as if it still were a separate package is an unnecessary
burden).

Updated the README file appropriately.

Location:
trunk/ccl/cocoa-ide
Files:
3 added
22 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/cocoa-ide/README

    r6955 r7698  
    1 July 22, 2007
     1November 20, 2007
    22
    33This directory contains sources and other resources needed to build
    4 a Cocoa-based IDE for OpenMCL on OSX.
     4a Cocoa-based IDE for Clozure CL on OSX.
    55
    66The IDE uses the ObjC bridge (in ccl/objc-bridge/) to communicate
    77with the ObjC runtime.
    88
    9 "./OpenMCL.app" is a skeletal application bundle which contains nib
    10 files, icons, and other resources used by the IDE.
     9The "./ide-contents" directory contains nib files, icons and other
     10resources used by the IDE.  These are copied to the application bundle
     11by the build process.
    1112
    1213The "./hemlock" directory contains a hacked up version of Portable
    13 Hemlock (forked from the main Portable Hemlock tree a few years ago.)
     14Hemlock (forked from the main Portable Hemlock tree some years ago.)
    1415Hemlock is public domain Emacs-like editor that comes with CMUCL;
    1516Portable Hemlock is an attempt to "free Hemlock from its CMUCL prison"
    1617(e.g., remove dependencies on CMUCL).  Hemlock (and Portable Hemlock)
    1718were designed to use CLX for display and event processing; the version
    18 distributed here tries to use the Cocoa text system for that
    19 functionality. Much of the initial work on Portable Hemlock was done
    20 by Gilbert Baumann.
     19distributed here uses the Cocoa text system for that functionality.
     20Much of the initial work on Portable Hemlock was done by Gilbert Baumann.
    2121
    22 To run the IDE from within an OpenMCL session (a shell, Emacs shell
     22To run the IDE from within a ccl command-line session (a shell, Emacs shell
    2323buffer, under SLIME or ILisp or ...), do:
    2424
    2525? (require "COCOA")
    2626
    27 The first time this is run, it'll compile the Hemlock sources; that'll
    28 take several seconds and generate lots of compiler warnings.  You'll
    29 also see messages noting that various new ObjC-callable methods are
    30 being define.  When the loading process completes, you should see
    31 a new menubar, an OpenMCL Dock icon (an aqua-colored Lambda originally
    32 contributed by Brendan Burns), and a Listener window.  The listener
    33 process from which the REQUIRE was issued will remain active; you
    34 may see warning/diagnostic/error messages from the IDE directed to
     27The first time this is run, it'll compile the sources, generating lots
     28of compiler warnings.  You'll also see messages noting that various
     29new ObjC-callable methods are being defined.  When the loading process
     30completes, it creates a temporary application bundle in "ccl:temp
     31bundle.app" and activates it.  You should see a new menubar, a
     32listener window, and a Clozure CL icon in the Dock. The non-GUI
     33listener process from which the REQUIRE was issued will remain active;
     34you may see warning/diagnostic/error messages from the IDE directed to
    3535the standard output/error streams associated with that listener.
    3636(Under SLIME, these messages might appear in the *inferior lisp*
    3737buffer.)
    3838
    39 It's also possible to populate the "OpenMCL.app" application bundle,
    40 effectively making it a double-clickable application.  To do this,
    41 you can do:
     39It's also possible to save the loaded IDE in a populated bundle,
     40effectively making it a double-clickable application.  To do this, you
     41can do:
    4242
    4343? (require "COCOA-APPLICATION")
    4444
    45 which will do what (REQUIRE "COCOA") does, then save an executable
    46 lisp image inside the "OpenMCL.app" bundle. Double-clicking on
     45which will create an application bundle in "ccl:Clozure CL.app"
     46and save an executable lisp image inside it. Double-clicking on
    4747that bundle in the Finder will launch the IDE; any diagnostic
    48 messages/warnings/etc. will be written to /var/log/system.log.
    49 (Probably; this may depend on OS version.)
     48messages/warnings/etc. will be written to the system log, which
     49can be examined with the Console application.
    5050
    5151The IDE depends on functionality introduced in OSX 10.4 (Tiger).
    5252
    53 Note: CCL directory and IDE, preferences changes.
    5453
    55 The IDE uses the value of a key in the application's preferences
    56 database in order to find the "ccl" directory (and to thereby
    57 enable M-. to find source files and to enable the FFI and ObjC
    58 bridge to find interface definitions, among other things.) 
    5954
    60 (Unlike some earlier versions, the IDE application itself shouldn't
    61 need access to interfaces at runtime.)
     55*Note: CCL directory and IDE Preferences
    6256
    63 The key can be set via the "CCL Directory" entry in the "Paths" pane
    64 of the Preferences dialog.  (The text associated with that entry is
    65 static; the "Select ..." button near that entry can be used to
    66 invoke a directory-selection dialog.)
     57Normally, the IDE assumes it is located at the top level of the "CCL"
     58directory.  It uses the CCL directory to enable Meta-. to find the
     59system source files and require'd modules, among other things.  If you
     60want to move the IDE somewhere else, e.g. to put it in the
     61Applications folder, but still want to be able to Meta-. and require
     62stuff from the CCL directory, you can set the "CCL Directory" entry in
     63the "Paths" pane of the Preferences dialog to the absolute path of the
     64directory containing the system sources.
    6765
    6866The values of changed application preferences are stored in
    69 "~/Library/Preferences/com.clozure.OpenMCL.plist"; if you have
     67"~/Library/Preferences/com.clozure.Clozure CL.plist"; if you have
    7068an old version of this file, it might be desirable to delete it
    7169before invoking the IDE for the first time.
    7270
    7371
    74 Note: rebuilding Hemlock
     72*Note: Interface files
    7573
    76 All of the Hemlock sources that are used in the IDE basically
    77 have to be recompiled whenever any of them change; some of the
    78 Hemlock files have load-time side-effects and can only be
    79 loaded once, and some files have to have been loaded in order
    80 for others to compile.  (Yes, this is possibly a job for
    81 ASDF or some other DEFSYSTEM-like thing.)
    82 
    83 To rebuild Hemlock (from the "tty" environment), do:
    84 
    85 ? (require "COMPILE-HEMLOCK")
    86 
    87 ? (ccl::compile-hemlock t)
    88 
    89 That'll compile all of the Hemlock sources that the IDE uses, then
    90 concatenate the resulting FASL files into a single
    91 "ccl:cocoa-ide;hemlock.FASL" (where "FASL" denotes the
    92 platform-specific FASL file extension.)
    93 
    94 This happens automatically when HEMLOCK is REQUIREd and
    95 "ccl:cocoa-ide;hemlock.lisp" is newer than the corresponding FASL (or
    96 the FASL is missing); if the Hemlock FASL is present, it'll be used
    97 (even if it's out-of-date with respect to the
    98 ccl:cocoa-ide;hemlock;src;*lisp" files from which it's derived.)
    99 
    100 In previous OpenMCL releases, "hemlock" and "OpenMCL" were both
    101 at top-level in the "ccl" tree, and many of the files in the
    102 "cocoa-ide" and "objc-bridge" directories were in "ccl:examples;".
    103 
    104 Note: This README file should be much longer.
     74The standalone IDE bundle contains a copy of the FFI/ObjC interface
     75definition databases (i.e. the .cdb files) for its target platform in
     76Clozure CL.app/Contents/Resources/xxx-headers.  If you create
     77additional databases that you want the IDE to access, you can just
     78copy them into the bundle.  Conversely, if you'd rather use the
     79interface definitions in the CCL directory, just delete the ones in
     80the bundle.
  • trunk/ccl/cocoa-ide/app-delegate.lisp

    r7612 r7698  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
    24
    3 (require "COCOA-DEFAULTS")
    4 (require "PREFERENCES")
    5 (require "PROCESSES-WINDOW")
    6 (require "APROPOS-WINDOW")
     5(in-package "GUI")
    76
    87(defclass lisp-application-delegate (ns:ns-object)
  • trunk/ccl/cocoa-ide/apropos-window.lisp

    r7643 r7698  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    26
    37(defclass package-combo-box (ns:ns-combo-box)
     
    9094        (if shows-external-symbols
    9195          (do-external-symbols (sym package)
    92             (when (%apropos-substring-p input (symbol-name sym))
     96            (when (ccl::%apropos-substring-p input (symbol-name sym))
    9397              (push sym symbol-list)))
    9498          (do-symbols (sym package)
    95             (when (%apropos-substring-p input (symbol-name sym))
     99            (when (ccl::%apropos-substring-p input (symbol-name sym))
    96100              (push sym symbol-list))))
    97101        (if shows-external-symbols
    98102          (dolist (p (list-all-packages))
    99103            (do-external-symbols (sym p)
    100               (when (%apropos-substring-p input (symbol-name sym))
     104              (when (ccl::%apropos-substring-p input (symbol-name sym))
    101105                (push sym symbol-list))))
    102106          (do-all-symbols (sym)
    103             (when (%apropos-substring-p input (symbol-name sym))
     107            (when (ccl::%apropos-substring-p input (symbol-name sym))
    104108              (push sym symbol-list)))))
    105109      (setf symbol-list (sort symbol-list #'string-lessp)))))
  • trunk/ccl/cocoa-ide/cocoa-application.lisp

    r7508 r7698  
    1818(in-package "CCL")                      ; for now.
    1919
    20 (eval-when (:compile-toplevel :execute)
    21   (use-interface-dir :cocoa))
    2220
    23 ;;; loading cocoa.lisp creates an IDE bundle in *cocoa-application-path*,
    24 ;;; perhaps copying headers as per *cocoa-application-copy-headers-p*
    2521(defvar *cocoa-application-path* "ccl:Clozure CL.app;")
    2622(defvar *cocoa-application-copy-headers-p* t)
    27 (require "COCOA")
    28 
    29 (defclass cocoa-application (application)
    30     ())
    31 
    32 (defmethod application-error ((a application) condition error-pointer)
    33   (break-loop-handle-error condition error-pointer))
    34 
    35 
    36 ;;; If we're launched via the Finder, the only argument we'll
    37 ;;; get is of the form -psnXXXXXX.  That's meaningless to us;
    38 ;;; it's easier to pretend that we didn't get any arguments.
    39 ;;; (If it seems like some of this needs to be thought out a
    40 ;;; bit better ... I'd tend to agree.)
    41 (defmethod parse-application-arguments ((a cocoa-application))
    42   (values nil nil nil nil))
    43 
    44 (defmethod toplevel-function ((a cocoa-application) init-file)
    45   (declare (ignore init-file))
    46   (when (< #&NSAppKitVersionNumber 824)
    47     (#_NSLog #@"This application requires features introduced in OSX 10.4.")
    48     (#_ _exit -1))
    49   (setq *standalone-cocoa-ide* t)
    50   ;; TODO: to avoid confusion, should now reset *cocoa-application-path* to
    51   ;; actual bundle path where started up.
    52   (start-cocoa-application))
    53 
    54 
    55   ;;; The saved image will be an instance of COCOA-APPLICATION (mostly
    56   ;;; so that it'll ignore its argument list.)  When it starts up, it'll
    57   ;;; run the Cocoa event loop in the cocoa event process.
    58   ;;; If you use an init file ("home:ccl-init"), it'll be loaded
    59   ;;; in an environment in which *STANDARD-INPUT* always generates EOF
    60   ;;; and where output and error streams are directed to the OSX console
    61   ;;; (see below).  If that causes problems, you may want to suppress
    62   ;;; the loading of your init file (via an :INIT-FILE nil arg to
    63   ;;; the call to SAVE-APPLICATION, below.)
    64 
    65 (defun build-ide (bundle-path)
    66   (setq bundle-path (ensure-directory-pathname bundle-path))
    67 
    68   ;; The bundle is expected to exists, we'll just add the executable into it.
    69   (assert (probe-file bundle-path))
    70 
    71   ;; Wait until we're sure that the Cocoa event loop has started.
    72   (wait-on-semaphore *cocoa-application-finished-launching*)
    73 
    74   (require :easygui)
    75 
    76   (maybe-map-objc-classes t)
    77   (let* ((missing ()))
    78     (do-interface-dirs (d)
    79       (cdb-enumerate-keys
    80        (db-objc-classes d)
    81        (lambda (name)
    82          (let* ((class (lookup-objc-class name nil))) (unless (objc-class-id  class) (push name missing))))))
    83     (when missing
    84       (break "ObjC classes ~{~&~a~} are declared but not defined." missing)))
    85 
    86   (touch bundle-path)
    87 
    88   (let ((image-file (make-pathname :name (standard-kernel-name) :type nil :version nil
    89                                    :defaults (merge-pathnames ";Contents;MacOS;" bundle-path))))
    90     (format *error-output* "~2%Saving application to ~a~2%" (truename bundle-path))
    91     (force-output *error-output*)
    92     (ensure-directories-exist image-file)
    93     (save-application image-file
    94                       :prepend-kernel t
    95                       :application-class 'cocoa-application)))
     23(load "ccl:cocoa-ide;defsystem.lisp")
     24(load-ide)
    9625
    9726;;; If things go wrong, you might see some debugging information via
  • trunk/ccl/cocoa-ide/cocoa-backtrace.lisp

    r7084 r7698  
    1 ; -*- Mode: Lisp; Package: CCL; -*-
    2 
    3 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    46
    57(defclass ns-lisp-string (ns:ns-string)
     
    5961(def-cocoa-default *backtrace-font-size* :float 9.0f0 "Size of font used in backtrace views")
    6062
     63
     64(defun context-process (context)
     65  (and context (ccl::tcr->process (ccl::bt.tcr context))))
    6166
    6267(objc:defmethod (#/windowDidLoad :void) ((self backtrace-window-controller))
     
    9297      (unless (%null-ptr-p window)
    9398        (let* ((context (backtrace-controller-context self))
    94                (process (tcr->process (bt.tcr context)))
     99               (process (context-process context))
    95100               (listener-window (if (typep process 'cocoa-listener-process)
    96101                                  (cocoa-listener-process-window process))))
     
    107112                                        (process-name process)
    108113                                        (process-serial-number process)
    109                                         (bt.break-level context)))))))))
     114                                        (ccl::bt.break-level context)))))))))
    110115
    111116(objc:defmethod (#/continue: :void) ((self backtrace-window-controller) sender)
    112117  (declare (ignore sender))
    113118  (let* ((context (backtrace-controller-context self))
    114          (process (and context (tcr->process (bt.tcr context)))))
     119         (process (context-process context)))
    115120    (when process (process-interrupt process #'continue))))
    116121
     
    118123  (declare (ignore sender))
    119124  (let* ((context (backtrace-controller-context self))
    120          (process (and context (tcr->process (bt.tcr context)))))
     125         (process (context-process context)))
    121126    (when process (process-interrupt process #'abort-break))))
    122127
     
    191196                                          (inspector::line-n inspector index)))
    192197                                    (if value
    193                                       (%lfun-name-string value)
     198                                      (ccl::%lfun-name-string value)
    194199                                      ":kernel")))))
    195200             label))
     
    234239
    235240(defun backtrace-controller-for-context (context)
    236   (or (bt.dialog context)
    237       (setf (bt.dialog context)
     241  (or (ccl::bt.dialog context)
     242      (setf (ccl::bt.dialog context)
    238243            (make-instance 'backtrace-window-controller
    239244                           :with-window-nib-name #@"backtrace"
     
    257262        (setf (cocoa-listener-process-backtrace-contexts proc)
    258263              (cdr (cocoa-listener-process-backtrace-contexts proc)))
    259         (let* ((btwindow (prog1 (bt.dialog context)
    260                            (setf (bt.dialog context) nil)))
     264        (let* ((btwindow (prog1 (ccl::bt.dialog context)
     265                           (setf (ccl::bt.dialog context) nil)))
    261266               (restartswindow
    262                 (prog1 (car (bt.restarts context))
    263                            (setf (bt.restarts context) nil))))
     267                (prog1 (car (ccl::bt.restarts context))
     268                           (setf (ccl::bt.restarts context) nil))))
    264269          (when btwindow
    265270            (#/performSelectorOnMainThread:withObject:waitUntilDone: btwindow (@selector #/close)  +null-ptr+ t))
  • trunk/ccl/cocoa-ide/cocoa-defaults.lisp

    r7579 r7698  
    1 ;;;-*-Mode: LISP; Package: CCL -*-
     1;;;-*-Mode: LISP; Package: GUI -*-
    22;;;
    33;;;   Copyright (C) 2004 Clozure Associates
     
    1515;;;   http://opensource.franz.com/preamble.html
    1616
    17 (in-package "CCL")
    18 
    19 (eval-when (:compile-toplevel :execute)
    20   (use-interface-dir :cocoa)
    21   #+nomore
    22   (use-interface-dir :carbon))
    23 
    24 (require "OBJC-SUPPORT")
     17(in-package "GUI")
    2518
    2619(defstruct cocoa-default
     
    4639(defun set-cocoa-default (name string type value doc &optional change-hook)
    4740  (check-type name symbol)
    48   (check-type string objc-constant-string)
     41  (check-type string ccl::objc-constant-string)
    4942  (check-type type keyword)
    5043  (check-type doc (or null string))
     
    6255;;; Names which contain #\* confuse Cocoa Bindings.
    6356(defun objc-default-key (name)
    64   (ns-constant-string (lisp-to-objc-message (list (make-symbol (remove #\* (string name)))))))
     57  (ccl::ns-constant-string (ccl::lisp-to-objc-message (list (make-symbol (remove #\* (string name)))))))
    6558 
    6659
     
    6962  ;; Make the variable "GLOBAL": its value can be changed, but it can't
    7063  ;; have a per-thread binding.
    71   (%symbol-bits name (logior (ash 1 $sym_vbit_global)
    72                              (the fixnum (%symbol-bits name))))
     64  (ccl::%symbol-bits name (logior (ash 1 ccl::$sym_vbit_global)
     65                                  (the fixnum (ccl::%symbol-bits name))))
    7366  (record-source-file name 'variable)
    7467  (setf (documentation name 'variable) doc)
     
    8174  `(progn
    8275     (eval-when (:compile-toplevel)
    83        (note-variable-info ',name :global ,env))
     76       (ccl::note-variable-info ',name :global ,env))
    8477    (declaim (special ,name))
    8578    (defloadvar ,name nil)
     
    9689    (let* ((name (cocoa-default-symbol d))
    9790           (type (cocoa-default-type d))
    98            (key (objc-constant-string-nsstringptr (cocoa-default-string d))))
     91           (key (ccl::objc-constant-string-nsstringptr (cocoa-default-string d))))
    9992      (let* ((hook (cocoa-default-change-hook d))
    10093             (old-value (symbol-value name)))
     
    136129                               (t
    137130                                (%make-nsstring (format nil "~a" (cocoa-default-value d)))))
    138                              (objc-constant-string-nsstringptr (cocoa-default-string d)))))))
     131                             (ccl::objc-constant-string-nsstringptr (cocoa-default-string d)))))))
  • trunk/ccl/cocoa-ide/cocoa-doc.lisp

    r7559 r7698  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    26
    37(def-cocoa-default *hyperspec-url-string* :string "http://www.lispworks.com/documentation/HyperSpec/" "HTTP URL for HyperSpec lookup")
  • trunk/ccl/cocoa-ide/cocoa-editor.lisp

    r7684 r7698  
    1 ;;;-*- Mode: LISP; Package: CCL -*-
    2 
    3 
    4 (in-package "CCL")
    5 
    6 (eval-when (:compile-toplevel :load-toplevel :execute)
    7   (require "COCOA-WINDOW")
    8   (require "HEMLOCK"))
    9 
    10 (eval-when (:compile-toplevel :execute)
    11   (use-interface-dir :cocoa))
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    126
    137;;; In the double-float case, this is probably way too small.
     
    1610;;; integral values.
    1711(eval-when (:compile-toplevel :load-toplevel :execute)
    18   (defconstant large-number-for-text (float 1.0f7 +cgfloat-zero+)))
     12  (defconstant large-number-for-text (cgfloat 1.0f7)))
    1913
    2014(def-cocoa-default *editor-font* :font #'(lambda ()
     
    3428
    3529(defmacro nsstring-encoding-to-nsinteger (n)
    36   (target-word-size-case
    37    (32 `(u32->s32 ,n))
     30  (ccl::target-word-size-case
     31   (32 `(ccl::u32->s32 ,n))
    3832   (64 n)))
    3933
    4034(defmacro nsinteger-to-nsstring-encoding (n)
    41   (target-word-size-case
    42    (32 `(s32->u32 ,n))
     35  (ccl::target-word-size-case
     36   (32 `(ccl::s32->u32 ,n))
    4337   (64 n)))
    4438
     
    433427     (selection-set-by-search :foreign-type :<BOOL>))
    434428  (:metaclass ns:+ns-object))
     429(declaim (special hemlock-text-storage))
    435430
    436431
     
    666661                                         (let* ((w (#/window tv))
    667662                                                (proc (slot-value w 'command-thread)))
    668                                            (process-interrupt proc #'dbg))))
    669       (dbg))
     663                                           (process-interrupt proc #'ccl::dbg))))
     664      (ccl::dbg))
    670665    (let* ((attrs (#/attributesAtIndex:effectiveRange: mirror index rangeptr)))
    671666      (when (eql 0 (#/count attrs))
     
    815810     (peer :foreign-type :id))
    816811  (:metaclass ns:+ns-object))
     812(declaim (special hemlock-textstorage-text-view))
    817813
    818814
     
    939935    (update-blink self))
    940936  (rlet ((range :ns-range :location pos :length length))
    941         (%call-next-objc-method self
    942                                 hemlock-textstorage-text-view
    943                                 (@selector #/setSelectedRange:affinity:stillSelecting:)
    944                                 '(:void :<NSR>ange :<NSS>election<A>ffinity :<BOOL>)
    945                                 range
    946                                 affinity
    947                                 nil)
    948         (assume-not-editing self)
    949         (#/scrollRangeToVisible: self range)
    950         (when (> length 0)
    951           (let* ((ts (#/textStorage self)))
    952             (with-slots (selection-set-by-search) ts
    953               (when (prog1 (eql #$YES selection-set-by-search)
    954                       (setq selection-set-by-search #$NO))
    955                 (highlight-search-selection self pos length)))))
    956 ))
     937    (ccl::%call-next-objc-method self
     938                                 hemlock-textstorage-text-view
     939                                 (@selector #/setSelectedRange:affinity:stillSelecting:)
     940                                 '(:void :<NSR>ange :<NSS>election<A>ffinity :<BOOL>)
     941                                 range
     942                                 affinity
     943                                 nil)
     944    (assume-not-editing self)
     945    (#/scrollRangeToVisible: self range)
     946    (when (> length 0)
     947      (let* ((ts (#/textStorage self)))
     948        (with-slots (selection-set-by-search) ts
     949          (when (prog1 (eql #$YES selection-set-by-search)
     950                  (setq selection-set-by-search #$NO))
     951            (highlight-search-selection self pos length)))))
     952    ))
    957953
    958954(defloadvar *can-use-show-find-indicator-for-range*
     
    10921088      (progn
    10931089        (#/setUsesFontPanel: self t)
    1094         (%call-next-objc-method
     1090        (ccl::%call-next-objc-method
    10951091         self
    10961092         hemlock-textstorage-text-view
     
    17731769     (echo-area-stream :initform nil :accessor hemlock-frame-echo-area-stream))
    17741770  (:metaclass ns:+ns-object))
     1771(declaim (special hemlock-frame))
    17751772
    17761773(defun double-%-in (string)
     
    18171814         (message (nsstring-for-lisp-condition condition))
    18181815         (sem-value (make-instance 'ns:ns-number
    1819                                    :with-unsigned-long (%ptr-to-int (semaphore.value semaphore)))))
     1816                                   :with-unsigned-long (%ptr-to-int (ccl::semaphore.value semaphore)))))
    18201817    #+debug
    18211818    (#_NSLog #@"created semaphore with value %lx" :address (semaphore.value semaphore))
     
    21732170      (when has-vertical-scroller
    21742171        (#/setVerticalLineScroll: scrollview char-height)
    2175         (#/setVerticalPageScroll: scrollview +cgfloat-zero+ #|char-height|#))
     2172        (#/setVerticalPageScroll: scrollview (cgfloat 0.0) #|char-height|#))
    21762173      (when has-horizontal-scroller
    21772174        (#/setHorizontalLineScroll: scrollview char-width)
    2178         (#/setHorizontalPageScroll: scrollview +cgfloat-zero+ #|char-width|#))
     2175        (#/setHorizontalPageScroll: scrollview (cgfloat 0.0) #|char-width|#))
    21792176      (let* ((sv-size (#/frameSizeForContentSize:hasHorizontalScroller:hasVerticalScroller:borderType: ns:ns-scroll-view tv-size has-horizontal-scroller has-vertical-scroller (#/borderType scrollview)))
    21802177             (pane-frame (#/frame pane))
     
    22112208              (#/defaultCStringEncoding ns:ns-string)
    22122209              ns)))))))
     2210
     2211(defclass hemlock-document-controller (ns:ns-document-controller)
     2212    ((last-encoding :foreign-type :<NSS>tring<E>ncoding))
     2213  (:metaclass ns:+ns-object))
     2214(declaim (special hemlock-document-controller))
     2215
     2216(objc:defmethod #/init ((self hemlock-document-controller))
     2217  (prog1
     2218      (call-next-method)
     2219    (setf (slot-value self 'last-encoding) 0)))
     2220
    22132221
    22142222;;; The HemlockEditorDocument class.
     
    26892697
    26902698
    2691 (defclass hemlock-document-controller (ns:ns-document-controller)
    2692     ((last-encoding :foreign-type :<NSS>tring<E>ncoding))
    2693   (:metaclass ns:+ns-object))
    2694 
    2695 (objc:defmethod #/init ((self hemlock-document-controller))
    2696   (prog1
    2697       (call-next-method)
    2698     (setf (slot-value self 'last-encoding) 0)))
    2699 
    27002699(defun iana-charset-name-of-nsstringencoding (ns)
    27012700  (#_CFStringConvertEncodingToIANACharSetName
     
    27132712;;; (localized) name of each encoding.
    27142713(defun supported-nsstring-encodings ()
    2715   (collect ((ids))
     2714  (ccl::collect ((ids))
    27162715    (let* ((ns-ids (#/availableStringEncodings ns:ns-string)))
    27172716      (unless (%null-ptr-p ns-ids)
     
    28852884
    28862885(defun hi::edit-definition (name)
    2887   (let* ((info (get-source-files-with-types&classes name)))
     2886  (let* ((info (ccl::get-source-files-with-types&classes name)))
    28882887    (when (null info)
    28892888      (let* ((seen (list name))
     
    28932892          (let ((sym (find-symbol pname pkg)))
    28942893            (when (and sym (not (member sym seen)))
    2895               (let ((new (get-source-files-with-types&classes sym)))
     2894              (let ((new (ccl::get-source-files-with-types&classes sym)))
    28962895                (when new
    28972896                  (setq info (append new info))
     
    30233022               (typep arg 'pathname))
    30243023           (unless (probe-file arg)
    3025              (touch arg))
     3024             (ccl::touch arg))
    30263025           (with-autorelease-pool
    30273026             (let* ((url (pathname-to-url arg))
     
    30473046                  +null-ptr+
    30483047                  t)))))
    3049           ((valid-function-name-p arg)
     3048          ((ccl::valid-function-name-p arg)
    30503049           (hi::edit-definition arg))
    3051           (t (report-bad-arg arg '(or null string pathname (satisifies valid-function-name-p)))))
     3050          (t (report-bad-arg arg '(or null string pathname (satisfies ccl::valid-function-name-p)))))
    30523051    t))
    30533052
    30543053(setq ccl::*resident-editor-hook* 'cocoa-edit)
    30553054
    3056 (provide "COCOA-EDITOR")
  • trunk/ccl/cocoa-ide/cocoa-grep.lisp

    r7595 r7698  
    1 ; -*- Mode: Lisp; Package: CCL; -*-
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
    24
    3 (in-package "CCL")
     5(in-package "GUI")
    46
    57(defvar *grep-program* "grep")
     
    112114                                           "--no-messages"
    113115                                           "-e" pattern
    114                                            (native-untranslated-namestring directory)))
     116                                           (ccl::native-untranslated-namestring directory)))
    115117                              :input nil
    116118                              :output stream)))
  • trunk/ccl/cocoa-ide/cocoa-inspector.lisp

    r6952 r7698  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2
     3(in-package "GUI")
    24
    35#|
     
    5557|#
    5658
    57 (require "COCOA")
    58 
    5959;;; This is useful when @ won't work, dynamically creating a NSString
    6060;;; pointer from a string.
    6161
    6262(defun nsstringptr (string)
    63   (objc-constant-string-nsstringptr
    64    (ns-constant-string string)))
     63  (ccl::objc-constant-string-nsstringptr
     64   (ccl::ns-constant-string string)))
    6565
    6666#+old
  • trunk/ccl/cocoa-ide/cocoa-listener.lisp

    r7580 r7698  
    1 ;;-*- Mode: LISP; Package: CCL -*-
    2 
    3 (in-package "CCL")
    4 
    5 (eval-when (:compile-toplevel :load-toplevel :execute)
    6   (require "COCOA-EDITOR")
    7   (require "PTY"))
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    86
    97(def-cocoa-default *listener-input-font* :font #'(lambda ()
     
    6159
    6260(defun new-cocoa-listener-process (procname input-fd output-fd peer-fd window buffer)
    63   (let* ((input-stream (make-selection-input-stream
     61  (let* ((input-stream (ccl::make-selection-input-stream
    6462                        input-fd
    6563                        :peer-fd peer-fd
     
    6866                                              #$_PC_MAX_INPUT)
    6967                        :encoding :utf-8))
    70          (output-stream (make-fd-stream output-fd :direction :output
    71                                         :sharing :lock
    72                                         :elements-per-buffer
    73                                         (#_fpathconf
    74                                          output-fd
    75                                          #$_PC_MAX_INPUT)
    76                                         :encoding :utf-8))
    77          (peer-stream (make-fd-stream peer-fd :direction :output
    78                                       :sharing :lock
    79                                       :elements-per-buffer
    80                                       (#_fpathconf
    81                                          peer-fd
    82                                          #$_PC_MAX_INPUT)
    83                                       :encoding :utf-8))
     68         (output-stream (ccl::make-fd-stream output-fd :direction :output
     69                                             :sharing :lock
     70                                             :elements-per-buffer
     71                                             (#_fpathconf
     72                                              output-fd
     73                                              #$_PC_MAX_INPUT)
     74                                             :encoding :utf-8))
     75         (peer-stream (ccl::make-fd-stream peer-fd :direction :output
     76                                           :sharing :lock
     77                                           :elements-per-buffer
     78                                           (#_fpathconf
     79                                            peer-fd
     80                                            #$_PC_MAX_INPUT)
     81                                           :encoding :utf-8))
    8482         (proc
    85           (make-mcl-listener-process
     83          (ccl::make-mcl-listener-process
    8684           procname
    8785           input-stream
     
    10098           :initial-function
    10199           #'(lambda ()
    102                (setq *listener-autorelease-pool* (create-autorelease-pool))
    103                (listener-function))
     100               (setq ccl::*listener-autorelease-pool* (create-autorelease-pool))
     101               (ccl::listener-function))
    104102           :class 'cocoa-listener-process)))
    105103    (setf (slot-value proc 'input-stream) input-stream)
     
    114112    ()
    115113  (:metaclass ns:+ns-object))
     114(declaim (special hemlock-listener-frame))
    116115
    117116
     
    125124  (:metaclass ns:+ns-object)
    126125  )
    127 
     126(declaim (special hemlock-listener-window-controller))
    128127
    129128;;; Listener documents are never (or always) ediited.  Don't cause their
     
    184183      (let* ((total (+ n data-length)))
    185184        (multiple-value-bind (nchars noctets-used)
    186             (funcall (character-encoding-length-of-memory-encoding-function encoding)
     185            (funcall (ccl::character-encoding-length-of-memory-encoding-function encoding)
    187186                     xlate
    188187                     total
    189188                     0)
    190189          (let* ((string (make-string nchars)))
    191             (funcall (character-encoding-memory-decode-function encoding)
     190            (funcall (ccl::character-encoding-memory-decode-function encoding)
    192191                     xlate
    193192                     noctets-used
     
    235234    ()
    236235  (:metaclass ns:+ns-object))
     236(declaim (special hemlock-listener-document))
    237237
    238238(defmethod update-buffer-package ((doc hemlock-listener-document) buffer)
     
    413413
    414414(defun restarts-controller-for-context (context)
    415   (or (car (bt.restarts context))
    416       (setf (car (bt.restarts context))
    417             (let* ((tcr (bt.tcr context))
     415  (or (car (ccl::bt.restarts context))
     416      (setf (car (ccl::bt.restarts context))
     417            (let* ((tcr (ccl::bt.tcr context))
    418418                   (tsp-range (inspector::make-tsp-stack-range tcr context))
    419419                   (vsp-range (inspector::make-vsp-stack-range tcr context))
    420420                   (csp-range (inspector::make-csp-stack-range tcr context))
    421                    (process (tcr->process (bt.tcr context))))
     421                   (process (context-process context)))
    422422              (make-instance 'sequence-window-controller
    423                              :sequence (cdr (bt.restarts context))
     423                             :sequence (cdr (ccl::bt.restarts context))
    424424                             :result-callback #'(lambda (r)
    425425                                                  (process-interrupt
     
    435435                                            (process-name process)
    436436                                            (process-serial-number process)
    437                                             (bt.break-level context)))))))
     437                                            (ccl::bt.break-level context)))))))
    438438                           
    439439(objc:defmethod (#/restarts: :void) ((self hemlock-listener-document) sender)
     
    482482              t
    483483              (and context
    484                    (find 'continue (cdr (bt.restarts context))
     484                   (find 'continue (cdr (ccl::bt.restarts context))
    485485                         :key #'restart-name)))))
    486486          ((or (eql action (@selector #/backtrace:))
     
    548548
    549549(defun hemlock::evaluate-input-selection (selection)
    550   (application-ui-operation *application* :eval-selection selection))
     550  (ccl::application-ui-operation *application* :eval-selection selection))
    551551 
    552552(defmethod ui-object-choose-listener-for-selection ((app ns:ns-application)
  • trunk/ccl/cocoa-ide/cocoa-prefs.lisp

    r7476 r7698  
    1 ;;;-*-Mode: LISP; Package: CCL -*-
     1;;;-*-Mode: LISP; Package: GUI -*-
    22;;;
    33;;;   Copyright (C) 2004 Clozure Associates
     
    1515;;;   http://opensource.franz.com/preamble.html
    1616
    17 (in-package "CCL")
    18 
    19 (eval-when (:compile-toplevel :execute)
    20   (use-interface-dir :cocoa))
    21 
     17(in-package "GUI")
    2218
    2319(defloadvar *lisp-preferences-panel* nil)
     
    4440  (#/displayName (make-instance ns:ns-font
    4541                                :with-name value
    46                                 :size (float 12.0 +cgfloat-zero+))))
     42                                :size (cgfloat 12.0))))
    4743
    4844
     
    5147    ()
    5248  (:metaclass ns:+ns-object))
     49(declaim (special lisp-preferences-window-controller))
    5350
    5451(objc:defmethod (#/fontPanelForDefaultFont: :void)
  • trunk/ccl/cocoa-ide/cocoa-typeout.lisp

    r7550 r7698  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
    24
    3 (eval-when (:compile-toplevel :execute)
    4   (use-interface-dir :cocoa))
     5(in-package "GUI")
    56
    67;;
     
    1011;; the window is implicitly bound to a stream, and text written to
    1112;; the stream is written into the text-view object. The stream is
    12 ;; available via the function (ccl::typeout-stream)
     13;; available via the function (gui::typeout-stream)
    1314;;
    1415
     
    1920   (text-view :foreign-type :id :reader typeout-view-text-view))
    2021  (:metaclass ns:+ns-object))
     22(declaim (special typeout-view))
    2123
    2224(defclass typeout-text-view (ns:ns-text-view)
    2325    ()
    2426  (:metaclass ns:+ns-object))
     27(declaim (special typeout-text-view))
    2528
    2629(objc:defmethod (#/clearAll: :void) ((self typeout-text-view))
     
    7780    ((typeout-view :foreign-type :id :accessor typeout-window-typeout-view))
    7881  (:metaclass ns:+ns-object))
     82(declaim (special typeout-window))
    7983
    8084(defloadvar *typeout-windows* ())
  • trunk/ccl/cocoa-ide/cocoa-utils.lisp

    r7642 r7698  
    1 ; -*- Mode: Lisp; Package: CCL; -*-
     1; -*- Mode: Lisp; Package: GUI; -*-
    22
    3 (in-package "CCL")
    4 
    5 (eval-when (:compile-toplevel :execute)
    6   (use-interface-dir :cocoa))
     3(in-package "GUI")
    74
    85(defclass sequence-window-controller (ns:ns-window-controller)
     
    10198                 (%make-nsstring (native-translated-namestring pathname))))
    10299
     100(defun cgfloat (number)
     101  (float number ccl::+cgfloat-zero+))
     102
    103103(defun color-values-to-nscolor (red green blue alpha)
    104104  (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color
    105                                               (float red +cgfloat-zero+)
    106                                               (float green +cgfloat-zero+)
    107                                               (float blue +cgfloat-zero+)
    108                                               (float alpha +cgfloat-zero+)))
     105                                              (cgfloat red)
     106                                              (cgfloat green)
     107                                              (cgfloat blue)
     108                                              (cgfloat alpha)))
    109109
    110110(defun windows ()
  • trunk/ccl/cocoa-ide/cocoa-window.lisp

    r7574 r7698  
    1 ;;;-*-Mode: LISP; Package: CCL -*-
     1;;;-*-Mode: LISP; Package: GUI -*-
    22;;;
    3 ;;;   Copyright (C) 2002-2003 Clozure Associates
     3;;;   Copyright (C) 2002-2007 Clozure Associates
    44;;;   This file is part of OpenMCL. 
    55;;;
     
    1616
    1717
    18 (in-package "CCL")                      ; for now.
     18(in-package "GUI")
    1919
    2020(eval-when (:compile-toplevel :load-toplevel :execute)
    21   (require "OBJC-SUPPORT")
    22   ;;
    23   ;;  this stuff should all be integrated with a preferences file in ~/Library/OpenMCL/
    24   ;; (Um, it -is- integrated with the preferences file.)
    25   ;;
    26   (require "COCOA-DEFAULTS")
    2721  (def-cocoa-default *default-font-name* :string "Courier" "Name of font to use in editor windows")
    2822  (def-cocoa-default *default-font-size* :float 12.0f0 "Size of font to use in editor windows, as a positive SINGLE-FLOAT")
    29   (def-cocoa-default *tab-width* :int 8 "Width of editor tab stops, in characters")
    30   (require "COCOA-PREFS")
    31   (require "COCOA-TYPEOUT"))
    32 
    33 (eval-when (:compile-toplevel :execute)
    34   (use-interface-dir #+apple-objc  :cocoa #+gnu-objc :gnustep))
    35 
     23  (def-cocoa-default *tab-width* :int 8 "Width of editor tab stops, in characters"))
    3624
    3725(defun init-cocoa-application ()
     
    115103(defparameter *event-process-reported-conditions* () "Things that we've already complained about on this event cycle.")
    116104
    117 (defmethod process-debug-condition ((process appkit-process) condition frame-pointer)
     105(defmethod ccl::process-debug-condition ((process appkit-process) condition frame-pointer)
    118106  "Better than nothing.  Not much better."
    119107  (when *debug-in-event-process*
    120     (let* ((c (if (typep condition 'ns-lisp-exception)
    121                 (ns-lisp-exception-condition condition)
     108    (let* ((c (if (typep condition 'ccl::ns-lisp-exception)
     109                (ccl::ns-lisp-exception-condition condition)
    122110                condition)))
    123111      (unless (member c *event-process-reported-conditions*)
     
    125113        (catch 'need-a-catch-frame-for-backtrace
    126114          (let* ((*debug-in-event-process* nil)
    127                  (context (new-backtrace-info nil
    128                                               frame-pointer
    129                                               (if *backtrace-contexts*
    130                                                 (or (child-frame
    131                                                      (bt.youngest (car *backtrace-contexts*))
    132                                                      nil)
    133                                                     (last-frame-ptr))
    134                                                 (last-frame-ptr))
    135                                               (%current-tcr)
    136                                               condition
    137                                               (%current-frame-ptr)
    138                                               #+ppc-target *fake-stack-frames*
    139                                               #+x86-target (%current-frame-ptr)
    140                                               (db-link)
    141                                               (1+ *break-level*)))
    142                  (*backtrace-contexts* (cons context *backtrace-contexts*))) 
     115                 (context (ccl::new-backtrace-info nil
     116                                                   frame-pointer
     117                                                   (if ccl::*backtrace-contexts*
     118                                                       (or (ccl::child-frame
     119                                                            (ccl::bt.youngest (car ccl::*backtrace-contexts*))
     120                                                            nil)
     121                                                           (ccl::last-frame-ptr))
     122                                                       (ccl::last-frame-ptr))
     123                                                   (ccl::%current-tcr)
     124                                                   condition
     125                                                   (ccl::%current-frame-ptr)
     126                                                   #+ppc-target ccl::*fake-stack-frames*
     127                                                   #+x86-target (ccl::%current-frame-ptr)
     128                                                   (ccl::db-link)
     129                                                   (1+ ccl::*break-level*)))
     130                 (ccl::*backtrace-contexts* (cons context ccl::*backtrace-contexts*))) 
    143131            (format t "~%~%*** Error in event process: ~a~%~%" condition)
    144132            (print-call-history :context context :detailed-p t :count 20 :origin frame-pointer)
     
    185173
    186174
    187 (defmethod process-exit-application ((process appkit-process) thunk)
    188   (when (eq process *initial-process*)
     175(defmethod ccl::process-exit-application ((process appkit-process) thunk)
     176  (when (eq process ccl::*initial-process*)
    189177    (%set-toplevel thunk)
    190178    (#/terminate: *NSApp* +null-ptr+)))
     
    212200                                 #'(lambda ()
    213201                                     (loop
    214                                        (%nanosleep *periodic-task-seconds*
    215                                                    *periodic-task-nanoseconds*)
    216                                        (housekeeping))))
     202                                       (ccl::%nanosleep ccl::*periodic-task-seconds*
     203                                                        ccl::*periodic-task-nanoseconds*)
     204                                       (ccl::housekeeping))))
    217205           
    218206           (with-autorelease-pool
     
    222210               (unless (%null-ptr-p icon)
    223211                 (#/setApplicationIconImage: *NSApp* icon)))
    224              (setf (application-ui-object *application*) *NSApp*)
     212             (setf (ccl::application-ui-object *application*) *NSApp*)
    225213             (when application-proxy-class-name
    226                (let* ((classptr (%objc-class-classptr
    227                                  (load-objc-class-descriptor application-proxy-class-name)))
     214               (let* ((classptr (ccl::%objc-class-classptr
     215                                 (ccl::load-objc-class-descriptor application-proxy-class-name)))
    228216                      (instance (#/init (#/alloc classptr))))
    229217
     
    257245                          (attributes ()))
    258246                               
    259   (setq size (float size +cgfloat-zero+))
     247  (setq size (cgfloat size))
    260248  (with-cstrs ((name name))
    261249    (with-autorelease-pool
     
    298286    (#/setTabStops: p (#/array ns:ns-array))
    299287    ;; And set the "default tab interval".
    300     (#/setDefaultTabInterval: p (float (* *tab-width* charwidth) +cgfloat-zero+))
     288    (#/setDefaultTabInterval: p (cgfloat (* *tab-width* charwidth)))
    301289    p))
    302290   
  • trunk/ccl/cocoa-ide/cocoa.lisp

    r7595 r7698  
    11(in-package "CCL")
    2 
    3 ;;; We need to be able to point the CoreFoundation and Cocoa libraries
    4 ;;; at some bundle very early in the process, so do that before anything
    5 ;;; else.
    6 ;;;
    7 ;;; If you're using this file to load something other than the IDE,
    8 ;;; you might want to change create-ide-bundle...
    92
    103(defvar *cocoa-application-path* "ccl:temp bundle.app;")
    114(defvar *cocoa-application-copy-headers-p* nil)
    12 
    13 (defun create-ide-bundle (bundle-path &key (source "ccl:cocoa-ide;ide-contents;")
    14                                            (source-ignore '(".svn" "cvs" ".cvsignore"))
    15                                            (copy-headers *cocoa-application-copy-headers-p*)
    16                                            (if-exists :overwrite))
    17   ;; TODO: Right now if the bundle exists, we leave alone any files that we don't replace.
    18   ;; I'd like :if-exists :supersede mean to remove such files, for clean builds, but
    19   ;; recursive-copy-directory doesn't support :if-exists :supersede yet...
    20   (flet ((subdir (dir sub)
    21            (ensure-directory-pathname (make-pathname :name sub :defaults dir)))
    22          (ignore-test (p)
    23            (flet ((backup-p (name)
    24                     (and (stringp name)
    25                          (let ((len (length name)))
    26                            (and (> len 0)
    27                                 (or (eql (aref name (1- len)) #\~)
    28                                     (eql (aref name 0) #\#)))))))
    29              (not (or (member (car (last (pathname-directory p))) source-ignore :test #'equalp)
    30                       (backup-p (pathname-name p))
    31                       (backup-p (pathname-type p))
    32                       (member (pathname-name p) source-ignore :test #'equalp))))))
    33     (let* ((source-dir (ensure-directory-pathname source))
    34            (target-dir (ensure-directory-pathname bundle-path))
    35            (contents-dir (subdir target-dir "Contents")))
    36       (recursive-copy-directory source-dir contents-dir :if-exists if-exists :test #'ignore-test)
    37       (when copy-headers
    38         (let* ((subdirs (cdb-subdirectory-path))
    39                (ccl-headers (make-pathname :host "ccl" :directory `(:absolute ,@subdirs)))
    40                (dest-headers (make-pathname :host (pathname-host contents-dir)
    41                                             :directory (append (pathname-directory contents-dir)
    42                                                                (cons "Resources" subdirs)))))
    43           (recursive-copy-directory ccl-headers dest-headers :if-exists if-exists :test #'ignore-test)))
    44       ;; Is this necessary?
    45       (let* ((image-name (standard-kernel-name))
    46              (ccl-image (make-pathname :name image-name :host "ccl"))
    47              (dest-image (make-pathname :name image-name
    48                                         :defaults (subdir contents-dir "MacOS"))))
    49         (ensure-directories-exist dest-image)
    50         (copy-file ccl-image dest-image :if-exists :supersede :preserve-attributes t))
    51       (touch target-dir))))
    52 
    53 #+darwin-target
    54 (progn
    55   (require "FAKE-CFBUNDLE-PATH")
    56   (create-ide-bundle *cocoa-application-path*)
    57   (fake-cfbundle-path *cocoa-application-path* "ccl:cocoa-ide;Info.plist-proto" "com.clozure"))
    58 
    59 
    60 (require "OBJC-SUPPORT")
    61 
    62 (if (< #&NSAppKitVersionNumber 824)
    63   (error "This application requires features introduced in OSX 10.4."))
    64 
    65 (defparameter *standalone-cocoa-ide* nil)
    66 
    67  
    68 (defvar *ide-files*
    69   '("cocoa-utils"
    70     "cocoa-defaults"
    71     "cocoa-prefs"
    72     "cocoa-typeout"
    73     "cocoa-window"
    74     "cocoa-doc"
    75     "cocoa-editor" ;; this loads hemlock
    76     "cocoa-listener"
    77     ;; tools
    78     "cocoa-grep"
    79     "cocoa-backtrace"
    80     "cocoa-inspector"
    81     "preferences"
    82     "processes-window"
    83     "apropos-window"
    84     "app-delegate"
    85     ))
    86 
    87 (defun load-ide (&optional force-compile)
    88   (with-compilation-unit ()
    89      (dolist (name *ide-files*)
    90        (let* ((source (merge-pathnames *.lisp-pathname* (make-pathname :name name :defaults "ccl:cocoa-ide;")))
    91               (fasl (merge-pathnames *.fasl-pathname* source)))
    92          (if (needs-compile-p fasl (list source) force-compile)
    93            (compile-file source :output-file fasl :verbose t :load t)
    94            (load fasl :verbose t))
    95          (provide (string-upcase name))))))
    96 
    97 (load-ide t)
    98 
    99 
    100 (def-cocoa-default *ccl-directory* :string "" nil #'(lambda (old new)
    101                                                       (when (equal new "") (setq new nil))
    102                                                       (unless (and new (equal old new))
    103                                                         (init-interfaces-root)
    104                                                         (replace-base-translation "ccl:"
    105                                                                                   (or new (find-ccl-directory))))))
    106 
    107 ;; If there are interfaces inside the bundle, use those rather than the ones
    108 ;; in CCL:, since they're more likely to be valid.  CCL: could be some random
    109 ;; sources we're just using just for meta-.
    110 (defun init-interfaces-root ()
    111   (let* ((subpath (cdb-subdirectory-path))
    112          (path (pathname-directory (ccl-directory))))
    113     (when (and *standalone-cocoa-ide*
    114                (equalp (last path 2) '("Contents" "MacOS")))
    115       (setq path (butlast path))
    116       (when (or (probe-file (make-pathname :directory (append path subpath)))
    117                 (probe-file (make-pathname :directory (append (setq path `(,@path "Resources")) subpath))))
    118         (setq *interfaces-root* (make-pathname :directory path))))))
    119 
    120 (defun find-ccl-directory ()
    121   (let* ((path (ccl-directory))
    122          (dir (pathname-directory path)))
    123     (if (equalp (last dir 2) '("Contents" "MacOS"))
    124         (make-pathname :directory (butlast dir 3))
    125         path)))
    126 
    127 (defmethod ui-object-do-operation ((o ns:ns-application)
    128                                    operation
    129                                    &rest args)
    130   (declare (ignore operation args))
    131   ;; Do nothing.  Would it be better to warn and/or log this ?
    132   )
    133 
    134 (defmethod ui-object-do-operation ((o ns:ns-application)
    135                                    (operation (eql :note-current-package))
    136                                    &rest args)
    137   (ui-object-note-package o (car args)))
    138 
    139 (defmethod ui-object-do-operation ((o ns:ns-application)
    140                                    (operation (eql :eval-selection))
    141                                    &rest args)
    142   (ui-object-eval-selection o (car args)))
    143 
    144 (defmethod ui-object-do-operation ((o ns:ns-application)
    145                                    (operation (eql :enter-backtrace-context))
    146                                    &rest args)
    147   (ui-object-enter-backtrace-context o (car args)))
    148 
    149 (defmethod ui-object-do-operation ((o ns:ns-application)
    150                                    (operation (eql :exit-backtrace-context))
    151                                    &rest args)
    152   (ui-object-exit-backtrace-context o (car args)))
    153 
    154 
    155 
    156 
    157 (start-cocoa-application)
    158 
     5(load "ccl:cocoa-ide;defsystem.lisp")
     6(load-ide)
  • trunk/ccl/cocoa-ide/compile-hemlock.lisp

    r7540 r7698  
    104104  (provide "HEMLOCK")
    105105  )
     106
     107
     108(provide "COMPILE-HEMLOCK")
  • trunk/ccl/cocoa-ide/hemlock/src/listener.lisp

    r7348 r7698  
    103103      )
    104104    (let* ((input-mark (variable-value 'buffer-input-mark :buffer buffer)))
    105       (when ccl::*read-only-listener*
     105      (when gui::*read-only-listener*
    106106        (setf (hi::buffer-protected-region buffer)
    107107              (region (buffer-start-mark buffer) input-mark)))
  • trunk/ccl/cocoa-ide/hemlock/src/macros.lisp

    r7595 r7698  
    560560  (let ((stream (gensym)))
    561561    `(let ()
    562        (let ((,stream (ccl::typeout-stream ,title)))
     562       (let ((,stream (gui::typeout-stream ,title)))
    563563         (clear-output ,stream)
    564564       (unwind-protect
  • trunk/ccl/cocoa-ide/hemlock/src/symbol-completion.lisp

    r7595 r7698  
    103103
    104104(defmethod dabbrev-sources-in ((state (eql :other-buffers)) context)
    105   (let* ((buffers (mapcar #'window-buffer (ccl::ordered-hemlock-windows))))
     105  (let* ((buffers (mapcar #'window-buffer (gui::ordered-hemlock-windows))))
    106106    ;; Remove duplicates, always keeping the first occurance (frontmost window)
    107107    (loop for blist on buffers do (setf (cdr blist) (delete (car blist) (cdr blist))))
  • trunk/ccl/cocoa-ide/preferences.lisp

    r7573 r7698  
    1 ;;;-*-Mode: LISP; Package: CCL -*-
     1;;;-*-Mode: LISP; Package: GUI -*-
    22;;;
    33;;;   Copyright (C) 2007 Clozure Associates
    4 ;;;   This file is part of OpenMCL. 
    54;;;
    6 ;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
    7 ;;;   License , known as the LLGPL and distributed with OpenMCL as the
    8 ;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
    9 ;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
    10 ;;;   conflict, the preamble takes precedence. 
    11 ;;;
    12 ;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
    13 ;;;
    14 ;;;   The LLGPL is also available online at
    15 ;;;   http://opensource.franz.com/preamble.html
    16 
    175;;; How to add a new preference pane:
    186;;;
     
    3523;;; 8. Implement actions, if needed.
    3624
    37 (in-package "CCL")
    38 
    39 (eval-when (:compile-toplevel :execute)
    40   (use-interface-dir :cocoa))
     25
     26(in-package "GUI")
    4127
    4228;;; A view that keeps track of its initial size.
  • trunk/ccl/cocoa-ide/processes-window.lisp

    r7555 r7698  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    26
    37(defclass processes-window-controller (ns:ns-window-controller)
Note: See TracChangeset for help on using the changeset viewer.