source: trunk/source/cocoa-ide/swank.lisp @ 12116

Last change on this file since 12116 was 12116, checked in by mikel, 10 years ago

Added code that updates the swank port preference field from the defaults database at launch, and also shows in a label the current swank wire protocol version

File size: 4.3 KB
Line 
1(in-package :GUI)
2
3(defparameter *default-gui-swank-port* 4564)
4(defparameter *active-gui-swank-port* nil)
5(defparameter *ccl-swank-active-p* nil)
6
7(load #P"ccl:cocoa-ide;slime;swank-loader.lisp")
8(swank-loader::load-swank)
9
10(defun preference-start-swank? ()
11  (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
12                     (serious-condition (c) 
13                       (progn (format t "~%ERROR: Unable to get preferences from the Shared User Defaults Controller")
14                              (force-output)
15                              nil))))
16         (start-swank-pref (and defaults (#/valueForKey: defaults #@"startSwankServer"))))
17    (cond
18      ;; the user default is not initialized
19      ((or (null start-swank-pref)
20           (%null-ptr-p start-swank-pref)) nil)
21      ;; examine the user default
22      ((typep start-swank-pref 'ns:ns-number) 
23       (case (#/intValue start-swank-pref)
24         ;; don't start swank
25         (0 nil)
26         ;; start swank
27         (1 t)
28         ;; the user default value is incomprehensible
29         (otherwise (progn
30                      (format t "~%ERROR: Unrecognized value in user preference 'startSwankServer': ~S"
31                              start-swank-pref)
32                      (force-output)
33                      nil))))
34      ;; the user default value is incomprehensible
35      (t (progn
36           (format t "~%ERROR: Unrecognized value type in user preference 'startSwankServer': ~S"
37                   start-swank-pref)
38           (force-output)
39           nil)))))
40
41(defun preference-swank-port ()
42  (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
43                     (serious-condition (c) 
44                       (progn (format t "~%ERROR: Unable to get preferences from the Shared User Defaults Controller")
45                              (force-output)
46                              nil))))
47         (swank-port-pref (and defaults (#/valueForKey: defaults #@"swankPort"))))
48    (cond
49      ;; the user default is not initialized
50      ((or (null swank-port-pref)
51           (%null-ptr-p swank-port-pref)) nil)
52      ;; examine the user default
53      ((typep swank-port-pref 'ns:ns-string) 
54       (handler-case (let* ((port-str (lisp-string-from-nsstring swank-port-pref))
55                            (port (parse-integer port-str :junk-allowed nil)))
56                       (or port *default-gui-swank-port*))
57         ;; parsing the port number failed
58         (ccl::parse-integer-not-integer-string (c)
59           (setf *ccl-swank-active-p* nil)
60           (format t "~%Error starting swank server; the swank-port user preference is not a valid port number: ~S~%"
61                   port-str)
62           (force-output)
63           nil)))
64      ;; the user default value is incomprehensible
65      (t (progn
66           (format t "~%ERROR: Unrecognized value type in user preference 'swankPort': ~S"
67                   swank-port-pref)
68           (force-output)
69           nil)))))
70
71(defun try-starting-swank (&key (force nil))
72  (unless *ccl-swank-active-p*
73    ;; try to determine the user preferences concerning the swank port number
74    ;; and whether the swank server should be started. If the user says start
75    ;; it, and we can determine a valid port for it, start it up
76    (let* ((start-swank? (or (preference-start-swank?) force))
77           (swank-port (or (preference-swank-port) *default-gui-swank-port*)))
78      (if (and start-swank? swank-port)
79          ;; try to start the swank server
80          (handler-case (progn
81                          (swank:create-server :port swank-port :dont-close t)
82                          (setf *ccl-swank-active-p* t)
83                          (setf *active-gui-swank-port* swank-port)
84                          swank-port)
85            ;; swank server creation failed
86            (serious-condition (c)
87              (setf *ccl-swank-active-p* nil)
88              (setf *active-gui-swank-port* nil)
89              (format t "~%Error starting swank server: ~A~%" c)
90              (force-output)
91              nil))
92          ;; don't try to start the swank server
93          (progn
94            (setf *ccl-swank-active-p* nil)
95            (setf *active-gui-swank-port* nil)
96            nil)))))
97
98(provide :swank)
Note: See TracBrowser for help on using the repository browser.