Permalink
Browse files

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.
  • Loading branch information...
Timothy Moore
Timothy Moore committed Mar 29, 2006
1 parent 473035a commit 165956b92d13f7b5edf72ad185f55cf63ebc2f82

Large diffs are not rendered by default.

Oops, something went wrong.
@@ -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!~%"))))))))
View
@@ -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)
@@ -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.
View
@@ -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))
@@ -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
@@ -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)))
@@ -32,7 +32,7 @@
;;;
;;;--GB
-(in-package :CLIM-POSTSCRIPT)
+(in-package :clim-postscript)
;;;; Medium
@@ -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
@@ -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)
@@ -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)
@@ -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))
@@ -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)
Oops, something went wrong.

0 comments on commit 165956b

Please sign in to comment.