[mcclim-cvs] CVS mcclim/Apps/Listener
tmoore
tmoore at common-lisp.net
Wed Mar 15 22:56:55 UTC 2006
Update of /project/mcclim/cvsroot/mcclim/Apps/Listener
In directory clnet:/tmp/cvs-serv7770/Apps/Listener
Modified Files:
dev-commands.lisp file-types.lisp listener.lisp util.lisp
Log Message:
Patches from dtc for Scieneer Common Lisp, and a few other fixes too.
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2005/12/06 16:21:58 1.32
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/03/15 22:56:54 1.33
@@ -672,7 +672,8 @@
#+clisp (clos:specializer-direct-generic-functions specializer)
#+openmcl-partial-mop
(openmcl-mop:specializer-direct-generic-functions specializer)
- #-(or PCL SBCL clisp openmcl-partial-mop)
+ #+scl (clos:specializer-direct-generic-functions specializer)
+ #-(or PCL SBCL scl clisp openmcl-partial-mop)
(error "Sorry, not supported in your CL implementation. See the function X-SPECIALIZER-DIRECT-GENERIC-FUNCTION if you are interested in fixing this."))
(defun class-funcs (class)
@@ -941,10 +942,10 @@
"Return the number of internal symbols in PACKAGE."
;; We take only the first value, the symbol count, and discard the second, the
;; hash table capacity
- #+cmu (values (lisp::internal-symbol-count package))
+ #+(or cmu scl) (values (lisp::internal-symbol-count package))
#+sbcl (values (sb-int:package-internal-symbol-count package))
#+clisp (svref (sys::%record-ref *package* 1) 2)
- #-(or cmu sbcl clisp) (portable-internal-symbol-count package))
+ #-(or cmu scl sbcl clisp) (portable-internal-symbol-count package))
(defun portable-external-symbol-count (package)
(let ((n 0))
@@ -955,10 +956,10 @@
(defun count-external-symbols (package)
"Return the number of external symbols in PACKAGE."
- #+cmu (values (lisp::external-symbol-count package))
+ #+(or cmu scl) (values (lisp::external-symbol-count package))
#+sbcl (values (sb-int:package-external-symbol-count package))
#+clisp (svref (sys::%record-ref *package* 0) 2)
- #-(or cmu sbcl clisp) (portable-external-symbol-count package))
+ #-(or cmu scl sbcl clisp) (portable-external-symbol-count package))
(defun package-grapher (stream package inferior-fun)
"Draw package hierarchy graphs for `Show Package Users' and `Show Used Packages'."
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/file-types.lisp 2005/08/31 05:50:37 1.8
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/file-types.lisp 2006/03/15 22:56:54 1.9
@@ -181,7 +181,8 @@
(:icon (standard-icon "design.xpm")))
(define-mime-type (application x-lisp-fasl)
- (:extensions "x86f" "fasl" "ibin" "dfsl" "ufsl") ; MORE!
+ (:extensions "x86f" "amd64f" "sparcf" "sparc64f" "hpf" "hp64f" "lbytef"
+ "fasl" "ibin" "dfsl" "ufsl") ; MORE!
(:icon (standard-icon "object.xpm")))
(define-mime-type (text x-shellscript)
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2005/12/06 16:21:11 1.22
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2006/03/15 22:56:54 1.23
@@ -72,16 +72,18 @@
(declare (ignore frame))
(let* ((*standard-output* pane)
(username (or #+cmu (cdr (assoc :user ext:*environment-list*))
+ #+scl (cdr (assoc "USER" ext:*environment-list*
+ :test 'string=))
#+allegro (sys:getenv "USER")
- #-(or allegro cmu) (getenv "USER")
+ #-(or allegro cmu scl) (getenv "USER")
"luser")) ; sorry..
(sitename (machine-instance))
- (memusage #+cmu (lisp::dynamic-usage)
+ (memusage #+(or cmu scl) (lisp::dynamic-space-usage)
#+sbcl (sb-kernel:dynamic-usage)
#+lispworks (getf (system:room-values) :total-allocated)
#+openmcl (+ (ccl::%usedbytes) (ccl::%freebytes))
#+clisp (values (sys::%room))
- #-(or cmu sbcl lispworks openmcl clisp) 0))
+ #-(or cmu scl sbcl lispworks openmcl clisp) 0))
(with-text-family (T :serif)
(formatting-table (T :x-spacing '(3 :character))
(formatting-row (T)
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp 2005/10/13 14:32:13 1.19
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp 2006/03/15 22:56:54 1.20
@@ -63,6 +63,7 @@
(defun getenv (var)
(or
#+cmu (cdr (assoc var ext:*environment-list*))
+ #+scl (cdr (assoc var ext:*environment-list* :test #'string=))
#+sbcl (sb-ext:posix-getenv var)
#+lispworks (lw:environment-variable var)
#+openmcl (ccl::getenv var)
@@ -73,6 +74,7 @@
(defun change-directory (pathname)
"Ensure that the current directory seen by RUN-PROGRAM has changed, and update *default-pathname-defaults*"
#+CMU (unix:unix-chdir (namestring pathname))
+ #+scl (unix:unix-chdir (ext:unix-namestring pathname))
#+clisp (ext:cd pathname)
; SBCL FIXME?
(setf *default-pathname-defaults* pathname))
@@ -85,7 +87,7 @@
;;; LIST-DIRECTORY is a wrapper for the CL DIRECTORY function, which really doesn't
;;; do what I'd like (resolves symbolic links, tends to be horribly buggy, etc.)
-#+CMU
+#+(or CMU scl)
(defun list-directory (pathname)
(directory pathname :truenamep nil))
@@ -143,7 +145,7 @@
(directory pathname :directories-are-files nil))
;; Fallback to ANSI CL
-#-(OR CMU SBCL OPENMCL ALLEGRO)
+#-(OR CMU scl SBCL OPENMCL ALLEGRO)
(defun list-directory (pathname)
(directory pathname))
@@ -167,8 +169,8 @@
;;; (see above)
(defun run-program (program args &key (wait T) (output *standard-output*) (input *standard-input*))
- #+CMU (ext:run-program program args :input input
- :output output :wait wait)
+ #+(or CMU scl) (ext:run-program program args :input input
+ :output output :wait wait)
#+SBCL (sb-ext:run-program program args :input input :search T
:output output :wait wait)
@@ -179,7 +181,7 @@
:wait wait)
#+clisp (ext:run-program program :arguments args :wait wait)
- #-(or CMU SBCL lispworks clisp)
+ #-(or CMU scl SBCL lispworks clisp)
(format T "~&Sorry, don't know how to run programs in your CL.~%"))
;;;; CLIM/UI utilities
@@ -256,25 +258,23 @@
(defun gen-wild-pathname (pathname)
"Build a pathname with appropriate :wild components for the directory listing."
- (make-pathname :host (pathname-host pathname)
- :device (pathname-device pathname)
- :directory (pathname-directory pathname)
- :name (or (pathname-name pathname) :wild)
+ (make-pathname :name (or (pathname-name pathname) :wild)
:type (or (pathname-type pathname) :wild)
:version (or #+allegro :unspecific
:wild
;#-SBCL (pathname-version pathname)
;#+SBCL :newest
- )))
+ )
+ #+scl :query #+scl nil
+ :defaults pathname))
(defun strip-filespec (pathname)
"Removes name, type, and version components from a pathname."
- (make-pathname :host (pathname-host pathname)
- :device (pathname-device pathname)
- :directory (pathname-directory pathname)
- :name nil
+ (make-pathname :name nil
:type nil
- :version nil))
+ :version nil
+ #+scl :query #+scl nil
+ :defaults pathname))
;; Oops, should I be doing something with relative pathnames here?
(defun parent-directory (pathname)
@@ -282,12 +282,8 @@
(let ((dir (pathname-directory (truename (strip-filespec pathname)))))
(when (and (eq (first dir) :absolute)
(not (zerop (length (rest dir)))))
- (make-pathname :host (pathname-host pathname)
- :device (pathname-device pathname)
- :directory `(:absolute ,@(nreverse (rest (reverse (rest dir)))))
- :name (pathname-name pathname)
- :type (pathname-type pathname)
- :version (pathname-version pathname)))))
+ (make-pathname :directory `(:absolute ,@(nreverse (rest (reverse (rest dir)))))
+ :defaults pathname))))
;;;; Abbreviating item formatter
More information about the Mcclim-cvs
mailing list