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.

Apps/Listener/file-types.lisp

@@ -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,15 +469,15 @@
                            *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 ()
   (let ((search-path (cons (merge-pathnames #P".mailcap" (user-homedir-pathname))
                            *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!~%"))))))))
 
 
 

Apps/Listener/icons.lisp

@@ -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)

Apps/Listener/listener.lisp

@@ -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.

Apps/Listener/util.lisp

@@ -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,15 +451,15 @@ function specified by :ABBREVIATOR. Abbreviate is controlled by the variables
 ;; 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
 ;; used as arguments to make program wrappers feel more "lispy".
 
 (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))

Apps/Scigraph/dwim/tv.lisp

@@ -457,7 +457,7 @@ advised of the possiblity of such damages.
 	     (clim:enable-frame frame)
 	     (clim:panes-need-redisplay frame)
 	     (clim:redisplay-frame-panes frame))
-	    (T (clim:start-frame frame wait-until-done)))))
+	    (t (clim:start-frame frame wait-until-done)))))
    (:clim-1.0
     (labels ((set-backing-store (window value)
 	       #+xlib

Backends/PostScript/afm.lisp

@@ -25,7 +25,7 @@
 ;;; - Kerning, ligatures.
 ;;; - Full AFM/AMFM/ACFM support.
 
-(in-package :CLIM-POSTSCRIPT)
+(in-package :clim-postscript)
 
 (defun space-char-p (char)
   (member char '(#\Space #\Tab)))

Backends/PostScript/class.lisp

@@ -32,7 +32,7 @@
 ;;;
 ;;;--GB
 
-(in-package :CLIM-POSTSCRIPT)
+(in-package :clim-postscript)
 
 ;;;; Medium
 

Backends/PostScript/encoding.lisp

@@ -23,7 +23,7 @@
 ;;; Boston, MA  02111-1307  USA.
 
 
-(in-package :CLIM-POSTSCRIPT)
+(in-package :clim-postscript)
 
 (defvar *iso-latin-1-symbolic-names*
     '#(NIL             NIL             NIL             NIL

Backends/PostScript/font.lisp

@@ -23,7 +23,7 @@
 ;;; - Kerning, ligatures.
 ;;; - device fonts
 
-(in-package :CLIM-POSTSCRIPT)
+(in-package :clim-postscript)
 
 (defclass font-info ()
   ((name :type string :initarg :name :reader font-info-name)

Backends/PostScript/graphics.lisp

@@ -37,7 +37,7 @@
 ;;; - structure this file
 ;;; - set miter limit?
 
-(in-package :CLIM-POSTSCRIPT)
+(in-package :clim-postscript)
 
 ;;; Postscript output utilities
 (defun write-number (stream number)

Backends/PostScript/package.lisp

@@ -18,24 +18,23 @@
 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
 ;;; Boston, MA  02111-1307  USA.
 
-(in-package :COMMON-LISP-USER)
+(in-package :cl-user)
 
-(defpackage "CLIM-POSTSCRIPT"
-  (:use "CLIM" "CLIM-EXTENSIONS" "CLIM-LISP")
-  (:export "LOAD-AFM-FILE")
-  (:import-from "CLIM-INTERNALS"
-                "GET-ENVIRONMENT-VARIABLE"
-                "MAP-REPEATED-SEQUENCE"
-                "ATAN*"
+(defpackage #:clim-postscript
+  (:use #:clim #:clim-extensions #:clim-lisp)
+  (:export #:load-afm-file)
+  (:import-from #:clim-internals
+                #:get-environment-variable
+                #:map-repeated-sequence
+                #:atan*
 
-                "ELLIPSE-NORMAL-RADII*"
+                #:ellipse-normal-radii*
 
-                "GET-TRANSFORMATION"
-                "UNTRANSFORM-ANGLE"
-                "WITH-TRANSFORMED-POSITION"
+                #:get-transformation
+                #:untransform-angle
+                #:with-transformed-position
 
-                "MAXF"
+                #:maxf
 
-                "PORT-TEXT-STYLE-MAPPINGS"
-  ))
+                #:port-text-style-mappings))
 

Backends/PostScript/sheet.lisp

@@ -35,7 +35,7 @@
 ;;;
 ;;;--GB
 
-(in-package :CLIM-POSTSCRIPT)
+(in-package :clim-postscript)
 
 (defmacro with-output-to-postscript-stream ((stream-var file-stream
                                              &rest options)