Update of /project/mcclim/cvsroot/mcclim/Apps/Listener
In directory clnet:/tmp/cvs-serv13084/Apps/Listener
Modified Files:
dev-commands.lisp file-types.lisp icons.lisp listener.lisp
util.lisp
Log Message:
Take out dependencies on case in symbol names. This makes McCLIM sort
of work in ACL's so-called modern mode; there have been some CLX fixes
recently that may get it all the way there.
Clean up events.lisp.
Add a callback-event, which will be used in ports that get high-level
gadget notifications in the event process and need to deliver them to
applications.
Changed the implementation of scroll bars. When the drag callback is
called, just move the sheet; assume that the gadget itself has updated
the value and the graphic representation. add a scroll-bar-values
interface that gets and sets all scroll bar values and only updates
the bar once. This will break the Beagle back end momentarily.
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/03/15 22:56:54 1.33
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/03/29 10:43:37 1.34
@@ -158,41 +158,41 @@
(define-presentation-translator class-name-to-class
(class-name class lisp-dev-commands
:documentation ((object stream) (format stream "Class object ~A" object))
- :gesture T)
+ :gesture t)
(object)
(find-class object))
(define-presentation-translator symbol-to-class
(symbol class lisp-dev-commands
:documentation ((object stream) (format stream "Class object ~A" object))
- :gesture T
+ :gesture t
:tester ((object) (not (not (find-class object nil))))
- :tester-definitive T)
+ :tester-definitive t)
(object)
(find-class object))
(define-presentation-translator symbol-to-class-name
(symbol class-name lisp-dev-commands
:documentation ((object stream) (format stream "Class ~A" object))
- :gesture T
+ :gesture t
:tester ((object) (not (not (find-class object nil))))
- :tester-definitive T)
+ :tester-definitive t)
(object)
object)
(define-presentation-translator class-to-class-name
(class class-name lisp-dev-commands
:documentation ((object stream) (format stream "Class of ~A" object))
- :gesture T)
+ :gesture t)
(object)
(clim-mop:class-name object))
(define-presentation-translator symbol-to-function-name
(symbol function-name lisp-dev-commands
:documentation ((object stream) (format stream "Function ~A" object))
- :gesture T
+ :gesture t
:tester ((object) (fboundp object))
- :tester-definitive T)
+ :tester-definitive t)
(object) object)
;;; Application commands
@@ -214,7 +214,7 @@
:provide-output-destination-keyword t)
((program 'string :prompt "command")
(args '(sequence string) :default nil :prompt "args"))
- (run-program program args :wait T :input nil))
+ (run-program program args :wait t :input nil))
;; I could replace this command with a keyword to COM-RUN..
(define-command (com-background-run :name "Background Run"
@@ -327,10 +327,10 @@
(let ((symbols (remove-if-not (lambda (sym) (apropos-applicable-p domain sym))
(apropos-list string real-package))))
(dolist (sym symbols)
- (apropos-present-symbol sym *standard-output* T)
+ (apropos-present-symbol sym *standard-output* t)
(terpri))
(setf *apropos-list* symbols)
- (note "Results have been saved to ~W~%" '*APROPOS-LIST*))))
+ (note "Results have been saved to ~W~%" '*apropos-list*))))
(define-command (com-trace :name "Trace"
:command-table lisp-commands
@@ -340,8 +340,8 @@
(if (fboundp fsym)
(progn
(eval `(trace ,fsym))
- (format T "~&Tracing ~W.~%" fsym))
- (format T "~&Function ~W is not defined.~%" fsym)))
+ (format t "~&Tracing ~W.~%" fsym))
+ (format t "~&Function ~W is not defined.~%" fsym)))
(define-command (com-untrace :name "Untrace"
:command-table lisp-commands
@@ -351,8 +351,8 @@
(if (fboundp fsym)
(progn
(eval `(untrace ,fsym))
- (format T "~&~W will no longer be traced.~%" fsym))
- (format T "~&Function ~W is not defined.~%" fsym)))
+ (format t "~&~W will no longer be traced.~%" fsym))
+ (format t "~&Function ~W is not defined.~%" fsym)))
(define-command (com-load-file :name "Load File"
@@ -453,7 +453,7 @@
(princ (clim-mop:class-name class) stream)))) ;)
inferior-fun
:stream stream
- :merge-duplicates T
+ :merge-duplicates t
:graph-type :tree
:orientation orientation
:arc-drawer
@@ -528,30 +528,30 @@
(direct-slots (direct-slot-definitions class name))
(readers (reduce #'append (filtermap direct-slots #'clim-mop:slot-definition-readers)))
(writers (reduce #'append (filtermap direct-slots #'clim-mop:slot-definition-writers)))
- (documentation (first (filtermap direct-slots (lambda (x) (documentation x T)))))
+ (documentation (first (filtermap direct-slots (lambda (x) (documentation x t)))))
(*standard-output* stream))
(macrolet ((with-ink ((var) &body body)
- `(with-drawing-options (T :ink ,(intern (concatenate 'string "*SLOT-" (symbol-name var) "-INK*")))
+ `(with-drawing-options (t :ink ,(intern (concatenate 'string "*SLOT-" (symbol-name var) "-INK*")))
,@body))
(fcell ((var align-x &rest cell-opts) &body body)
- `(formatting-cell (T :align-x ,align-x ,@cell-opts)
+ `(formatting-cell (t :align-x ,align-x ,@cell-opts)
(with-ink (,var) ,@body) )))
(fcell (name :left)
- (with-output-as-presentation (T slot 'slot-definition)
+ (with-output-as-presentation (t slot 'slot-definition)
(princ name))
- (unless (eq type T)
+ (unless (eq type t)
(fresh-line)
(with-ink (type) (princ type))))
(fcell (initargs :right)
(dolist (x initargs)
- (format T "~W~%" x)))
+ (format t "~W~%" x)))
(fcell (initform :left)
(if initfunc
- (format T "~W" initform)
+ (format t "~W" initform)
(note "No initform")))
#+NIL ; argh, shouldn't this work?
@@ -567,19 +567,19 @@
(dolist (writer writers) (format T "~A~%" writer))
(note "No writers"))))))
- (formatting-cell (T :align-x :left)
+ (formatting-cell (t :align-x :left)
(if (not (or readers writers))
(note "No accessors")
(progn
(with-ink (readers)
- (if readers (dolist (reader readers) (format T "~A~%" reader))
+ (if readers (dolist (reader readers) (format t "~A~%" reader))
(note "No readers~%")))
(with-ink (writers)
- (if writers (dolist (writer writers) (format T "~A~%" writer))
+ (if writers (dolist (writer writers) (format t "~A~%" writer))
(note "No writers"))))))
(fcell (documentation :left)
- (when documentation (with-text-family (T :serif) (princ documentation))))
+ (when documentation (with-text-family (t :serif) (princ documentation))))
)))
@@ -601,18 +601,18 @@
(position (earliest-slot-definer b class) cpl))))))
(defun print-slot-table-heading ()
- (formatting-row (T)
+ (formatting-row (t)
(dolist (name '("Slot name" "Initargs" "Initform" "Accessors"))
- (formatting-cell (T :align-x :center)
- (underlining (T)
- (with-text-family (T :sans-serif)
+ (formatting-cell (t :align-x :center)
+ (underlining (t)
+ (with-text-family (t :sans-serif)
(princ name)))))))
(defun present-slot-list (slots class)
- (formatting-table (T)
+ (formatting-table (t)
(print-slot-table-heading)
(dolist (slot slots)
- (formatting-row (T)
+ (formatting-row (t)
(present-slot slot class)))))
(defun friendly-slot-allocation-type (allocation)
@@ -626,11 +626,11 @@
(other-slots (set-difference slots instance-slots))
(allocation-types (remove-duplicates (mapcar #'clim-mop:slot-definition-allocation other-slots))))
(when other-slots
- (underlining (T) (format T "~&Instance Slots~%")))
+ (underlining (t) (format t "~&Instance Slots~%")))
(present-slot-list instance-slots class)
(dolist (alloc allocation-types)
- (underlining (T)
- (format T "~&Allocation: ~A~%" (friendly-slot-allocation-type alloc)))
+ (underlining (t)
+ (format t "~&Allocation: ~A~%" (friendly-slot-allocation-type alloc)))
(present-slot-list (remove-if (lambda (x)
(not (eq alloc (clim-mop:slot-definition-allocation x))))
other-slots)
@@ -643,17 +643,17 @@
((class-name 'clim:symbol :prompt "class name"))
(let ((class (find-class class-name nil)))
(if (null class)
- (format T "~&~A is not a defined class.~%" class-name)
+ (format t "~&~A is not a defined class.~%" class-name)
(let ((slots (clim-mop:class-slots class)))
(if (null slots)
(note "~%This class has no slots.~%~%")
(progn
; oddly, looks much better in courier, because of all the capital letters.
-; (with-text-family (T :sans-serif)
+; (with-text-family (t :sans-serif)
(invoke-as-heading
(lambda ()
- (format T "~&Slots for ")
- (with-output-as-presentation (T (clim-mop:class-name class) 'class-name)
+ (format t "~&Slots for ")
+ (with-output-as-presentation (t (clim-mop:class-name class) 'class-name)
(princ (clim-mop:class-name class)))))
(present-the-slots class) ))))))
@@ -697,7 +697,7 @@
(symbol-package b)))
(string< (package-name (symbol-package a))
(package-name (symbol-package b))))
- (T (string< (symbol-name a)
+ (t (string< (symbol-name a)
(symbol-name b))))
(string< (princ-to-string a)
(princ-to-string b))))))
@@ -714,10 +714,10 @@
(let ((funcs (sort (class-funcs class) (lambda (a b)
(slot-name-sortp (clim-mop:generic-function-name a)
(clim-mop:generic-function-name b))))))
- (with-text-size (T :small)
+ (with-text-size (t :small)
(format-items funcs :printer (lambda (item stream)
(present item 'generic-function :stream stream))
- :move-cursor T))))))
+ :move-cursor t))))))
(defun method-applicable-to-args-p (method args arg-types)
(loop
@@ -1026,7 +1026,7 @@
:type (pathname-type pathname)
:version (pathname-version pathname))))))
-(defun pretty-pretty-pathname (pathname stream &key (long-name T))
+(defun pretty-pretty-pathname (pathname stream &key (long-name t))
(with-output-as-presentation (stream pathname 'clim:pathname)
(let ((icon (icon-of pathname)))
(when icon (draw-icon stream icon :extra-spacing 3)))
@@ -1077,10 +1077,10 @@
&key
(sort-by '(member name size modify none) :default 'name)
(show-hidden 'boolean :default nil :prompt "show hidden")
- (hide-garbage 'boolean :default T :prompt "hide garbage")
+ (hide-garbage 'boolean :default t :prompt "hide garbage")
(show-all 'boolean :default nil :prompt "show all")
(style '(member items list) :default 'items :prompt "listing style")
- (group-directories 'boolean :default T :prompt "group directories?")
+ (group-directories 'boolean :default t :prompt "group directories?")
(full-names 'boolean :default nil :prompt "show full name?")
(list-all-direct-subdirectories 'boolean :default nil :prompt "list all direct subdirectories?"))
@@ -1092,18 +1092,18 @@
(list-directory-with-all-direct-subdirectories wild-pathname)
(list-directory wild-pathname))))
- (with-text-family (T :sans-serif)
+ (with-text-family (t :sans-serif)
(invoke-as-heading
(lambda ()
- (format T "Directory contents of ")
+ (format t "Directory contents of ")
(present (directory-namestring pathname) 'pathname)
(when (pathname-type pathname)
- (format T " (only files of type ~a)" (pathname-type pathname)))))
+ (format t " (only files of type ~a)" (pathname-type pathname)))))
(when (parent-directory pathname)
- (with-output-as-presentation (T (strip-filespec (parent-directory pathname)) 'clim:pathname)
- (draw-icon T (standard-icon "up-folder.xpm") :extra-spacing 3)
- (format T "Parent Directory~%")))
+ (with-output-as-presentation (t (strip-filespec (parent-directory pathname)) 'clim:pathname)
+ (draw-icon t (standard-icon "up-folder.xpm") :extra-spacing 3)
+ (format t "Parent Directory~%")))
(dolist (group (split-sort-pathnames dir group-directories sort-by))
(unless show-all
@@ -1120,7 +1120,7 @@
(declare (ignore stream))
(pretty-pretty-pathname x *standard-output* :long-name full-names)))
(goatee::reposition-stream-cursor *standard-output*)
- (vertical-gap T))
+ (vertical-gap t))
(list (dolist (ent group)
(let ((ent (merge-pathnames ent pathname))) ;; This is for CMUCL, see above. (fixme!)
;; And breaks some things for SBCL.. (mgr)
@@ -1131,7 +1131,7 @@
(clim:pathname com-show-directory filesystem-commands :gesture :select
:pointer-documentation ((object stream)
(format stream "Show directory ~A" object))
- :tester-definitive T
+ :tester-definitive t
:tester ((object)
(directoryp object)))
(object)
@@ -1147,7 +1147,7 @@
(note "~A does not exist." pathname))
((not (directoryp pathname))
(note "~A is not a directory." pathname))
- (T (change-directory (merge-pathnames pathname))) )))
+ (t (change-directory (merge-pathnames pathname))) )))
(define-command (com-up-directory :name "Up Directory"
:menu t
@@ -1156,8 +1156,8 @@
(let ((parent (parent-directory *default-pathname-defaults*)))
(when parent
(change-directory parent)
- (italic (T)
- (format T "~&The current directory is now ")
+ (italic (t)
+ (format t "~&The current directory is now ")
(present (truename parent))
(terpri)))))
@@ -1283,18 +1283,18 @@
(directoryp pathname));; FIXME: Need smart conversion to directories, here and elsewhere.
(progn (push *default-pathname-defaults* *directory-stack*)
(com-change-directory pathname))
- (italic (T)
+ (italic (t)
(fresh-line) (present (truename pathname))
- (format T " does not exist or is not a directory.~%")) ))
+ (format t " does not exist or is not a directory.~%")) ))
(compute-dirstack-command-eligibility *application-frame*))
(defun comment-on-dir-stack ()
(if *directory-stack*
(progn
- (format T "~&The top of the directory stack is now ")
+ (format t "~&The top of the directory stack is now ")
(present (truename (first *directory-stack*)))
(terpri))
- (format T "~&The directory stack is now empty.~%")))
+ (format t "~&The directory stack is now empty.~%")))
(define-command (com-pop-directory :name "Pop Directory"
:menu t
@@ -1304,16 +1304,16 @@
(note "The directory stack is empty!")
(progn
(com-change-directory (pop *directory-stack*))
- (italic (T) (comment-on-dir-stack))))
+ (italic (t) (comment-on-dir-stack))))
(compute-dirstack-command-eligibility *application-frame*))
(define-command (com-drop-directory :name "Drop Directory"
:menu t
:command-table directory-stack-commands)
()
- (italic (T)
+ (italic (t)
(if (null *directory-stack*)
- (format T "~&The directory stack is empty!~%")
+ (format t "~&The directory stack is empty!~%")
(progn
(setf *directory-stack* (rest *directory-stack*))
(comment-on-dir-stack))))
@@ -1323,9 +1323,9 @@
:menu t
:command-table directory-stack-commands)
()
- (italic (T)
+ (italic (t)
(if (null *directory-stack*)
- (format T "~&The directory stack is empty!~%")
+ (format t "~&The directory stack is empty!~%")
(progn
(psetf (first *directory-stack*) *default-pathname-defaults*
*default-pathname-defaults* (first *directory-stack*))
@@ -1412,21 +1412,21 @@
"Hack of the day.. let McCLIM determine presentation type to use, except for lists, because the list presentation method is inappropriate for lisp return values."
(typecase object
(sequence (present object 'expression))
- (T (present object))))
+ (t (present object))))
(defun display-evalues (values)
- (with-drawing-options (T :ink +olivedrab+)
[29 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/file-types.lisp 2006/03/15 22:56:54 1.9
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/file-types.lisp 2006/03/29 10:43:37 1.10
@@ -136,7 +136,7 @@
(cond ((wild-pathname-p pathname) (standard-icon "wild.xpm"))
((not (probe-file pathname)) (standard-icon "invalid.xpm"))
((directoryp pathname) *folder-icon*) ;; FIXME: use inode mime types
- (T (let ((mime-class (find-class (pathname-mime-type pathname) nil)))
+ (t (let ((mime-class (find-class (pathname-mime-type pathname) nil)))
(if mime-class
(or (gethash (class-name mime-class) *icon-mapping*)
(icon-of (clim-mop:class-prototype (find-class (pathname-mime-type pathname) nil))))
@@ -201,15 +201,15 @@
(defun read-slashified-line (stream &optional (accumulation nil))
(let ((line (read-line stream nil)))
(cond ((null line) (values nil nil))
- ((zerop (length line)) (values accumulation T))
+ ((zerop (length line)) (values accumulation t))
((and (null accumulation) ;; # Comment
(char= (elt line 0) #\#))
- (values nil T))
- (T (if (char= #\\ (elt line (1- (length line))))
+ (values nil t))
+ (t (if (char= #\\ (elt line (1- (length line))))
(read-slashified-line stream
(concatenate 'string accumulation
(subseq line 0 (1- (length line)))))
- (values (concatenate 'string accumulation line) T))))))
+ (values (concatenate 'string accumulation line) t))))))
(defun read-the-lines (pathname)
(let ((elements nil))
@@ -273,7 +273,7 @@
(when split-pos
(let* ((foo (subseq string start split-pos))
(pos (skip-whitespace string (1+ split-pos))))
-; (format T "~%***** foo=~A~%" foo)
+; (format t "~%***** foo=~A~%" foo)
(when pos
(let* ((end (or (if (eql (elt string pos) #\")
(1+ (position-if (lambda (c)
@@ -299,7 +299,7 @@
(when (eq keysym :type)
(setf (gethash :subtype table) (nth-value 2 (read-mime-type bar)))
(setf (gethash :media-type table) (read-mime-type bar)))
-; (format T "~&~W => ~W~%" foo bar)
+; (format t "~&~W => ~W~%" foo bar)
(setf (gethash keysym table) value)
(parse-netscrapings table string end) ))))))
table)
@@ -335,7 +335,7 @@
(exts (gethash :exts elt)))
(eval `(define-mime-type (,media-type ,subtype)
(:extensions ,@exts))))
- #+nil(format T "Ignoring ~W, unknown media type.~%" (gethash :type elt)))))
+ #+nil(format t "Ignoring ~W, unknown media type.~%" (gethash :type elt)))))
(defun parse-mime-types-file (pathname)
(mapcar (lambda (x) (process-mime-type (parse-mt-elt x)))
@@ -401,7 +401,7 @@
(when (< index (1- (length string)))
(push (elt string (incf index)) chars)))
((eql c #\;) (return-from poop chars))
- (T (push c chars)))
+ (t (push c chars)))
(incf index)))
(values
(string-trim *whitespace* (concatenate 'string (nreverse chars)))
@@ -411,7 +411,7 @@
(let* ((sep-pos (position #\= string))
(field-name (subseq string 0 (or sep-pos (length string)))))
(values (intern (string-upcase field-name) (find-package :keyword))
- (ignore-errors (or (when sep-pos (subseq string (1+ sep-pos))) T)))))
+ (ignore-errors (or (when sep-pos (subseq string (1+ sep-pos))) t)))))
(defun parse-mailcap-entry (line)
"Parses a line of the mailcap file, returning either nil or the properties
@@ -469,7 +469,7 @@
*mime.types-search-path*)))
(dolist (path (reverse search-path))
(when (probe-file path)
- (format T "Loading mime types from ~A~%" path)
+ (format t "Loading mime types from ~A~%" path)
(parse-mime-types-file path)))))
(defun load-mailcaps ()
@@ -477,7 +477,7 @@
*mailcap-search-path*)))
(dolist (path (reverse search-path))
(when (probe-file path)
- (format T "Loading mailcap from ~A~%" path)
+ (format t "Loading mailcap from ~A~%" path)
(parse-mailcap-file path)))))
@@ -544,7 +544,7 @@
(cond ((eql d #\s) (princ (quote-shell-characters (namestring (truename pathname))) out))
((eql d #\t) (princ (gethash :type spec) out))
((eql d #\u) (princ (pathname-to-uri-string pathname) out))
- (T (debugf "Ignoring unknown % syntax." d))))
+ (t (debugf "Ignoring unknown % syntax." d))))
(write-char c out))))))
(defun find-viewspec (pathname)
@@ -571,13 +571,13 @@
(test (gethash :test def))
(needsterminal (gethash :needsterminal def)))
(if needsterminal
- (format T "Sorry, the viewer app needs a terminal (fixme!)~%")
+ (format t "Sorry, the viewer app needs a terminal (fixme!)~%")
(progn
(when test
(debugf "Sorry, ignoring TEST option right now.. " test))
(if view-command
(run-program "/bin/sh" `("-c" ,(gen-view-command-line def pathname) "&"))
- (format T "~&No view-command!~%"))))))))
+ (format t "~&No view-command!~%"))))))))
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/icons.lisp 2006/01/01 10:14:50 1.4
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/icons.lisp 2006/03/29 10:43:37 1.5
@@ -52,11 +52,11 @@
;; Icon functions
-(defmethod icon-of ((object T))
+(defmethod icon-of ((object t))
*object-icon*)
(defun draw-icon (stream pattern &key (extra-spacing 0) )
- (let ((stream (if (eq stream T) *standard-output* stream)))
+ (let ((stream (if (eq stream t) *standard-output* stream)))
(multiple-value-bind (x y)
(stream-cursor-position stream)
(draw-pattern* stream pattern x y)
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2006/03/22 09:14:30 1.24
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2006/03/29 10:43:37 1.25
@@ -84,22 +84,22 @@
#+openmcl (+ (ccl::%usedbytes) (ccl::%freebytes))
#+clisp (values (sys::%room))
#-(or cmu scl sbcl lispworks openmcl clisp) 0))
- (with-text-family (T :serif)
- (formatting-table (T :x-spacing '(3 :character))
- (formatting-row (T)
+ (with-text-family (t :serif)
+ (formatting-table (t :x-spacing '(3 :character))
+ (formatting-row (t)
(macrolet ((cell ((align-x) &body body)
- `(formatting-cell (T :align-x ,align-x) ,@body)))
- (cell (:left) (format T "~A@~A" username sitename))
+ `(formatting-cell (t :align-x ,align-x) ,@body)))
+ (cell (:left) (format t "~A@~A" username sitename))
(cell (:center)
- (format T "Package ")
- (print-package-name T))
+ (format t "Package ")
+ (print-package-name t))
(cell (:center)
(when (probe-file *default-pathname-defaults*)
- (with-output-as-presentation (T (truename *default-pathname-defaults*) 'pathname)
- (format T "~A" (frob-pathname *default-pathname-defaults*))))
+ (with-output-as-presentation (t (truename *default-pathname-defaults*) 'pathname)
+ (format t "~A" (frob-pathname *default-pathname-defaults*))))
(when *directory-stack*
- (with-output-as-presentation (T *directory-stack* 'directory-stack)
- (format T " (~D deep)" (length *directory-stack*)))))
+ (with-output-as-presentation (t *directory-stack* 'directory-stack)
+ (format t " (~D deep)" (length *directory-stack*)))))
;; Although the CLIM spec says the item formatter should try to fill
;; the available width, I can't get either the item or table formatters
;; to really do so such that the memory usage appears right justified.
@@ -157,7 +157,7 @@
((system-command-reader :accessor system-command-reader
:initarg :system-command-reader
:initform t))
- (:panes (interactor :interactor :scroll-bars T
+ (:panes (interactor :interactor :scroll-bars t
:display-function #'listener-initial-display-function
:display-time t)
(doc :pointer-documentation)
@@ -218,7 +218,7 @@
(restart-case (call-next-method)
(return-to-listener ()
:report "Return to listener."
- (throw 'return-to-listener T)))))))
+ (throw 'return-to-listener t)))))))
;; Oops. As we've ditched our custom toplevel, we now have to duplicate all
;; this setup work to implement one little trick.
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp 2006/03/15 22:56:54 1.20
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp 2006/03/29 10:43:37 1.21
@@ -42,7 +42,7 @@
(mapcar #'(lambda (x)
(cond
((stringp x) `((princ ,x *trace-output*)))
- (T `((princ ',x *trace-output*)
+ (t `((princ ',x *trace-output*)
(princ "=" *trace-output*)
(write ,x :stream *trace-output*)
(princ #\space *trace-output*)))))
@@ -96,8 +96,8 @@
(defun sbcl-frob-to-pathname (pathname string)
"This just keeps getting more disgusting."
(let* ((parent (strip-filespec pathname))
- (pn (merge-pathnames (make-pathname :name (subseq string 0 (position #\. string :start 1 :from-end T))
- :type (let ((x (position #\. string :start 1 :from-end T)))
+ (pn (merge-pathnames (make-pathname :name (subseq string 0 (position #\. string :start 1 :from-end t))
+ :type (let ((x (position #\. string :start 1 :from-end t)))
(if x (subseq string (1+ x)) nil)))
parent))
(dir (ignore-errors (sb-posix:opendir (namestring pn)))))
@@ -168,7 +168,7 @@
;;; This ought to change the current directory to *default-pathname-defaults*..
;;; (see above)
-(defun run-program (program args &key (wait T) (output *standard-output*) (input *standard-input*))
+(defun run-program (program args &key (wait t) (output *standard-output*) (input *standard-input*))
#+(or CMU scl) (ext:run-program program args :input input
:output output :wait wait)
@@ -182,7 +182,7 @@
#+clisp (ext:run-program program :arguments args :wait wait)
#-(or CMU scl SBCL lispworks clisp)
- (format T "~&Sorry, don't know how to run programs in your CL.~%"))
+ (format t "~&Sorry, don't know how to run programs in your CL.~%"))
;;;; CLIM/UI utilities
@@ -216,12 +216,12 @@
(truncate (/ (text-style-ascent (medium-text-style stream) stream) fraction))))
(defun invoke-as-heading (cont &optional ink)
- (with-drawing-options (T :ink (or ink +royal-blue+) :text-style (make-text-style :sans-serif :bold nil))
+ (with-drawing-options (t :ink (or ink +royal-blue+) :text-style (make-text-style :sans-serif :bold nil))
(fresh-line)
- (bordering (T :underline)
+ (bordering (t :underline)
(funcall cont))
(fresh-line)
- (vertical-gap T)))
+ (vertical-gap t)))
(defun indent-to (stream x &optional (spacing 0) )
"Advances cursor horizontally to coordinate X. If the cursor is already past
@@ -451,7 +451,7 @@
;; Disgusting hacks to make input default to nil, as CMUCL's run-program seems
;; to hang randomly unless I do that. But sometimes I'll need to really change these..
;; ** Goddamn CMUCL's run-program likes to hang randomly even with this dumb hack. Beware..
-(defparameter *run-output* T)
+(defparameter *run-output* t)
(defparameter *run-input* nil)
;; We attempt to translate keywords and a few types of lisp objects
@@ -459,7 +459,7 @@
(defgeneric transform-program-arg (arg))
-(defmethod transform-program-arg ((arg T))
+(defmethod transform-program-arg ((arg t))
(values (prin1-to-string arg)))
(defmethod transform-program-arg ((arg string))
