mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv27936 Modified Files: dev-commands.lisp Log Message: Somehow failed to change the default for style arg to a keyword. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/02/03 12:22:38 1.50 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/02/03 20:51:47 1.51 @@ -1123,7 +1123,7 @@ (show-hidden 'boolean :default nil :prompt "show hidden") (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") + (style '(member :items :list) :default :items :prompt "listing style") (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?"))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv7023/Drei Modified Files: drei-redisplay.lisp Log Message: The brave new world of output records with baselines was not properly interned everywhere. Fixed. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/03 18:49:56 1.60 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/03 19:17:26 1.61 @@ -57,9 +57,7 @@ object, or display the `princ'ed representation.)") (:method :around ((stream extended-output-stream) (view drei-view)) (letf (((stream-default-view stream) view)) - (call-next-method))) - (:method ((stream extended-output-stream) (view drei-syntax-view)) - (call-next-method))) + (call-next-method)))) (defgeneric display-drei-view-cursor (stream view cursor) (:documentation "The purpose of this function is to display a @@ -748,15 +746,14 @@ ;; like the changing position is ignored. So add some ;; minuscule amount to it, and all will be well. 0.1 ;; device units shouldn't even be visible. - (let ((width (bounding-rectangle-width output-record)) - (height (bounding-rectangle-height output-record))) + (let ((width (bounding-rectangle-width output-record))) (setf (output-record-position output-record) (values (+ cursor-x 0.1) (- cursor-y baseline))) (when draw (replay output-record stream)) (setf (aref widths 1) width) (record-stroke stroke parts widths - cursor-x (- cursor-y height) + cursor-x (- cursor-y baseline) (+ width cursor-x) cursor-y draw baseline)))))))

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv5452 Modified Files: listener.lisp Log Message: Veto'd! --- /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2008/02/03 10:20:04 1.41 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2008/02/03 19:07:51 1.42 @@ -143,8 +143,9 @@ "Specialized for the listener, read a lisp form to eval, or a command." (multiple-value-bind (object type) (let ((*command-dispatchers* '(#\,))) - (accept 'command-or-form :stream stream :prompt nil :default "hello" :default-type 'empty-input)) - (cond + (accept 'command-or-form :stream stream :prompt nil + :default "hello" :default-type 'empty-input)) + (cond ((presentation-subtypep type 'empty-input) ;; Do nothing. `(com-eval (values))) @@ -153,19 +154,9 @@ (defun print-listener-prompt (stream frame) (declare (ignore frame)) - (with-text-face (stream :italic) - (let* ((text-style-width (text-style-width (medium-default-text-style stream) stream)) - (arrow-width (* 2 text-style-width)) - (prompt-height - (bounding-rectangle-height - (with-output-as-presentation (stream *package* 'package :single-box t) - (print-package-name stream))))) - (multiple-value-bind (x y) (stream-cursor-position stream) - (draw-arrow* stream x (+ y (/ prompt-height 2)) - (+ x arrow-width) (+ y (/ prompt-height 2)) - :head-length (/ text-style-width 2) - :head-width (floor (/ prompt-height 2)))) - (stream-increment-cursor-position stream (+ arrow-width text-style-width) 0)))) + (with-output-as-presentation (stream *package* 'package :single-box t) + (print-package-name stream)) + (princ "> " stream)) (defmethod frame-standard-output ((frame listener)) (get-frame-pane frame 'interactor))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv1041 Modified Files: package.lisp Log Message: Export OUTPUT-RECORD-BASELINE from CLIM-EXTENSIONS. Use OUTPUT-RECORD-BASELINE to make Drei more inteligent. --- /project/mcclim/cvsroot/mcclim/package.lisp 2008/02/03 09:24:15 1.66 +++ /project/mcclim/cvsroot/mcclim/package.lisp 2008/02/03 18:49:57 1.67 @@ -1941,6 +1941,7 @@ #:with-output-to-pointer-documentation #:frame-display-pointer-documentation-string #:list-pane-items + #:output-record-baseline #:draw-output-border-over #:draw-output-border-under

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv1041/Drei Modified Files: drei-redisplay.lisp Log Message: Export OUTPUT-RECORD-BASELINE from CLIM-EXTENSIONS. Use OUTPUT-RECORD-BASELINE to make Drei more inteligent. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/03 07:16:49 1.59 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/03 18:49:56 1.60 @@ -730,6 +730,7 @@ region, which will be presented with its appropriate presentation type (found via `presentation-type-of') to generate output." (let (output-record + baseline (widths (make-array 2 :initial-contents (list 0 0))) (parts (list 0 1))) #'(lambda (stream view stroke cursor-x cursor-y @@ -741,7 +742,8 @@ (when (or (null output-record) (stroke-modified stroke)) (setf output-record (with-output-to-output-record (stream) - (present object (presentation-type-of object) :stream stream)))) + (present object (presentation-type-of object) :stream stream)) + baseline (clim-extensions:output-record-baseline output-record))) ;; You will not believe this! If `cursor-x' is 0, it seems ;; like the changing position is ignored. So add some ;; minuscule amount to it, and all will be well. 0.1 @@ -749,14 +751,14 @@ (let ((width (bounding-rectangle-width output-record)) (height (bounding-rectangle-height output-record))) (setf (output-record-position output-record) - (values (+ cursor-x 0.1) (- cursor-y height))) + (values (+ cursor-x 0.1) (- cursor-y baseline))) (when draw (replay output-record stream)) (setf (aref widths 1) width) (record-stroke stroke parts widths cursor-x (- cursor-y height) (+ width cursor-x) cursor-y - draw height))))))) + draw baseline))))))) (defmethod pump-state-for-offset ((view drei-buffer-view) (offset integer)) "For a `drei-buffer-view' a pump-state is merely an offset into

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv20175 Modified Files: util.lisp file-types.lisp Log Message: In keeping with McCLIM tradition, "clean up" code and see what breaks. Random pathname-related chanegs, and deleted chunks of old code from the bad old days when SBCL's cl:directory was useless and sb-posix didn't even have stat. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp 2008/01/31 11:06:40 1.23 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp 2008/02/03 12:47:04 1.24 @@ -29,23 +29,6 @@ `(let ((,tmp (multiple-value-list ,(first forms)))) (if (first ,tmp) (values-list ,tmp) (mv-or ,@(rest forms))))))) - -;; DEBUGF is useful, I can sleep better knowing it's in the image. -(defmacro debugf (&rest stuff) - `(progn (fresh-line *trace-output*) - ,@(reduce #'append - (mapcar #'(lambda (x) - (cond - ((stringp x) `((princ ,x *trace-output*))) - (t `((princ ',x *trace-output*) - (princ "=" *trace-output*) - (write ,x :stream *trace-output*) - (princ #\space *trace-output*))))) - - stuff)) - (terpri *trace-output*))) - - ; There has to be a better way.. (defun directoryp (pathname) "Returns pathname when supplied with a directory, otherwise nil" @@ -65,19 +48,18 @@ #+clisp (ext:getenv var) nil)) -;; Need to strip filename/type/version from directory?.. FIXME? (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? + #+sbcl (sb-posix:chdir (namestring pathname)) (setf *default-pathname-defaults* pathname)) (defun resolve-stream-designator (desi default) (if (eq desi t) default - (or desi default))) + (or desi default))) ;;; 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.) @@ -86,48 +68,10 @@ (defun list-directory (pathname) (directory pathname :truenamep nil)) - -#+SBCL -(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))) - (if x (subseq string (1+ x)) nil))) - parent)) - (dir (ignore-errors (sb-posix:opendir (namestring pn))))) - - - (cond ((or (string= string ".") - (string= string "..")) - (unless (or (null dir) (sb-alien:null-alien dir)) - (sb-posix:closedir dir)) - nil) - ((or (null dir) - (sb-alien:null-alien dir)) - pn) - (T - (sb-posix:closedir dir) - (merge-pathnames (parse-namestring (concatenate 'string string "/")) - parent))))) - #+SBCL (defun list-directory (pathname) - (directory pathname) - #+nil ;; ugh. is too ughy. (mgr) - (let* ((pathname (strip-filespec pathname)) ;; ugh. - (dir (sb-posix:opendir pathname)) - (list nil)) - (loop - (let ((dirent (sb-posix:readdir dir))) - (unwind-protect - (if (sb-alien:null-alien dirent) - (return-from list-directory - (nreverse list)) - (let ((pn (sbcl-frob-to-pathname pathname (sb-posix::dirent-name dirent)))) - (when pn (push pn list)))) - #+nil ; dirents should not be freed, they belong to the DIR. - (sb-posix::free-dirent dirent)))))) + ;; Wow. When did SBCL's cl:directory become sane? This is great news! + (directory pathname)) #+openmcl (defun list-directory (pathname) @@ -246,21 +190,11 @@ (add-output-record record (stream-output-history stream-pane)) (repaint-sheet stream-pane record))) -;;; Pathname evil -;;; Fixme: Invent some more useful operators for manipulating pathnames, add a -;;; pinch of syntactic sugar, and cut the LOC here down to a fraction. +;;; Pathnames are awful. (defun gen-wild-pathname (pathname) "Build a pathname with appropriate :wild components for the directory listing." - (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)) + (merge-pathnames pathname (make-pathname :name :wild :type :wild :version :wild))) (defun strip-filespec (pathname) "Removes name, type, and version components from a pathname." @@ -283,6 +217,8 @@ ;;;; Abbreviating item formatter +;;; FIXME: This would work a lot better if the + (defparameter *abbreviating-minimum-items* 6 "Minimum number of items needed to invoke abbreviation. This must be at least one.") (defparameter *abbreviating-outlier-threshold* 2.0 @@ -315,11 +251,6 @@ (if (= count 1) result nil) (or text-style (medium-text-style (slot-value record 'climi::medium))))))) -;; This logic could be useful in McCLIM's stream-output.lisp, for computing -;; line breaks. At the time, I didn't feel like writing it, but now I do. -;; Even so, the binary search I used there is probably good enough, but this -;; would improve the quality of the guess, particularly for the extreme case -;; of throwing many lines of text at CLIM within one string. (defun abbrev-guess-pos (medium string text-style desired-width start end) "Makes a guess where to split STRING between START and END in order to fit within WIDTH. Returns the ending character index." (let* ((length (- end start)) @@ -348,8 +279,6 @@ (subseq string 0 (abbrev-guess-pos medium string text-style working-width 0 (length string))) "..."))) -(defvar *tmp* nil) - (defun abbreviate-record (stream record width abbreviator) "Attempts to abbreviate the text contained in an output RECORD on STREAM to fit within WIDTH, using the function ABBREVIATOR to produce a shortened string." (declare (optimize (debug 3))) @@ -489,7 +418,10 @@ (run-program name (transform-program-arguments args) :wait *program-wait* :output (resolve-stream-designator *run-output* *standard-output*) - :input nil #+NIL (resolve-stream-designator *run-input* *standard-input*)))) + :input nil #+NIL (resolve-stream-designator *run-input* *standard-input*)) + ;; It might be useful to return the exit status of the process, but our run-program + ;; wrapper doesn't + (values))) (defun read-stringlet (stream) (with-output-to-string (out) --- /project/mcclim/cvsroot/mcclim/Apps/Listener/file-types.lisp 2007/02/05 03:41:37 1.11 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/file-types.lisp 2008/02/03 12:47:04 1.12 @@ -105,7 +105,6 @@ (key (if type (concatenate 'string name "." type) ; Why did I do it this way? name)) (item (gethash key *magic-name-mappings*))) -; (when item (hef:debugf item pathname)) item)) (defun pathname-mime-type (pathname) @@ -147,7 +146,6 @@ ; (call-next-method))) (let ((cpl (clim-mop:class-precedence-list (class-of obj)))) (dolist (class cpl) -; (debugf " " class) (let ((icon (gethash (class-name class) *icon-mapping*))) (when icon (return-from icon-of icon))))) (call-next-method)) @@ -547,7 +545,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 (format *trace-output* "Ignoring unknown syntax ~W" d)))) (write-char c out)))))) (defun find-viewspec (pathname) @@ -577,7 +575,7 @@ (format t "Sorry, the viewer app needs a terminal (fixme!)~%") (progn (when test - (debugf "Sorry, ignoring TEST option right now.. " test)) + (format *trace-output* "Sorry, ignoring TEST option ~W for ~A viewer " test type)) (if view-command (run-program "/bin/sh" `("-c" ,(gen-view-command-line def pathname) "&")) (format t "~&No view-command!~%"))))))))

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv9564 Modified Files: dev-commands.lisp Log Message: Eliminate questionable call to a function in goatee. Change list styles to keywords. For once, Athas' naive aversion toward double colons was not misguided. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/02/03 12:08:51 1.49 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/02/03 12:22:38 1.50 @@ -1123,7 +1123,7 @@ (show-hidden 'boolean :default nil :prompt "show hidden") (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") + (style '(member :items :list) :default 'items :prompt "listing style") (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?")) @@ -1139,7 +1139,7 @@ (with-text-family (t :sans-serif) (invoke-as-heading (lambda () - (format t "Directory contents of ") + (format t "Contents of ") (present (directory-namestring pathname) 'pathname) (when (pathname-type pathname) (format t " (only files of type ~a)" (pathname-type pathname))))) @@ -1153,18 +1153,14 @@ (unless show-all (setf group (filter-garbage-pathnames group show-hidden hide-garbage))) (ecase style - (items (abbreviating-format-items group :row-wise nil :x-spacing " " :y-spacing 1 - :printer (lambda (x stream) - (declare (ignore stream)) - (pretty-pretty-pathname x *standard-output* - :long-name full-names))) - #+NIL - (format-items group :row-wise nil :x-spacing " " :y-spacing 1 - :printer (lambda (x stream) - (declare (ignore stream)) - (pretty-pretty-pathname x *standard-output* :long-name full-names))) - (goatee::reposition-stream-cursor *standard-output*)) ; Hmm. - (list (dolist (ent group) + (:items + (abbreviating-format-items group :row-wise nil :x-spacing " " :y-spacing 1 + :printer (lambda (x stream) + (pretty-pretty-pathname x stream + :long-name full-names))) + (multiple-value-bind (x y) (stream-cursor-position *standard-output*) + (setf (stream-cursor-position *standard-output*) (values 0 y)))) + (:list (dolist (ent group) (let ((ent (merge-pathnames ent pathname))) ;; This is for CMUCL, see above. (fixme!) ;; And breaks some things for SBCL.. (mgr) (pretty-pretty-pathname ent *standard-output* :long-name full-names)))))))))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv7003 Modified Files: input-editing.lisp Log Message: Implement classic CLIM behavior for :erase keyword in with-input-editor-typeout. Doesn't mesh well with border output records, for some reason. --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/02/03 11:35:22 1.70 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/02/03 12:11:13 1.71 @@ -67,6 +67,18 @@ (:documentation "A mixin implementing some useful standard behavior for input-editing streams.")) +(defmethod typeout-record :around ((stream standard-input-editing-mixin)) + ;; Can't do this in an initform, since we need to proper position... + (or (call-next-method) + (let ((record + (make-instance 'standard-sequence-output-record + :x-position 0 + :y-position (bounding-rectangle-min-y + (input-editing-stream-output-record stream))))) + (stream-add-output-record (encapsulating-stream-stream stream) + record) + (setf (typeout-record stream) record)))) + ;;; These helper functions take the arguments of ACCEPT so that they ;;; can be used directly by ACCEPT. @@ -224,39 +236,42 @@ (defmethod invoke-with-input-editor-typeout ((editing-stream standard-input-editing-mixin) (continuation function) &key erase) - (declare (ignore erase)) - (let* ((encapsulated-stream (encapsulating-stream-stream editing-stream)) - (new-typeout-record (with-output-to-output-record (encapsulated-stream) - (funcall continuation encapsulated-stream))) - (editor-record (input-editing-stream-output-record editing-stream))) - (with-accessors ((stream-typeout-record typeout-record)) editing-stream + (with-accessors ((stream-typeout-record typeout-record)) editing-stream + ;; Can't do this in an initform, as we need to set the proper + ;; output record position. + (let* ((encapsulated-stream (encapsulating-stream-stream editing-stream)) + (old-min-y (bounding-rectangle-min-y stream-typeout-record)) + (old-height (bounding-rectangle-height stream-typeout-record)) + (new-typeout-record (with-output-to-output-record (encapsulated-stream + 'standard-sequence-output-record + record) + (unless erase + ;; Steal the children of the old typeout record. + (map nil #'(lambda (child) + (setf (output-record-parent child) nil + (output-record-position child) (values 0 0)) + (add-output-record child record)) + (output-record-children stream-typeout-record)) + ;; Make sure new output is done + ;; after the stolen children. + (stream-increment-cursor-position + encapsulated-stream 0 old-height)) + (funcall continuation encapsulated-stream)))) (with-sheet-medium (medium encapsulated-stream) - (setf (output-record-position new-typeout-record) - (values 0 (bounding-rectangle-min-y (or stream-typeout-record editor-record)))) + (setf (output-record-position new-typeout-record) (values 0 old-min-y)) ;; Calculate the height difference between the old typeout and the new. - (let ((delta-y (- (bounding-rectangle-height new-typeout-record) - (if stream-typeout-record - (bounding-rectangle-height stream-typeout-record) - 0)))) + (let ((delta-y (- (bounding-rectangle-height new-typeout-record) old-height))) (multiple-value-bind (typeout-x typeout-y) (output-record-position new-typeout-record) (declare (ignore typeout-x)) - ;; Clear the old typeout. - (when stream-typeout-record - (clear-output-record stream-typeout-record)) + ;; Clear the old typeout... + (clear-output-record stream-typeout-record) + ;; Move stuff for the new typeout record... (sheet-move-output-vertically encapsulated-stream typeout-y delta-y) - ;; Reuse the old stream-typeout-record, if any. - (cond (stream-typeout-record - (add-output-record new-typeout-record stream-typeout-record)) - (t - (stream-add-output-record encapsulated-stream new-typeout-record) - (setf stream-typeout-record new-typeout-record))) + ;; Reuse the old stream-typeout-record... + (add-output-record new-typeout-record stream-typeout-record) ;; Now, let there be light! - (with-bounding-rectangle* (x1 y1 x2 y2) stream-typeout-record - (declare (ignore x2)) - (repaint-sheet encapsulated-stream - (make-bounding-rectangle - x1 y1 (bounding-rectangle-width encapsulated-stream) y2))))))))) + (repaint-sheet encapsulated-stream stream-typeout-record))))))) (defun clear-typeout (&optional (stream t)) "Blank out the input-editor typeout displayed on `stream',

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv6324 Modified Files: dev-commands.lisp Log Message: Fix copy-list/mapcan bug that causes Show Class Slots to sometimes loop infinitely. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/01/31 11:06:40 1.48 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2008/02/03 12:08:51 1.49 @@ -532,7 +532,7 @@ (defun direct-slot-definitions (class slot-name) (let ((cpl (reverse (clim-mop:class-precedence-list class))) (direct-slots nil)) - (dolist (foo cpl) + (dolist (foo cpl) ; rewrite this (let ((dslots (clim-mop:class-direct-slots foo))) (dolist (slot dslots) (when (eq slot-name (clim-mop:slot-definition-name slot)) @@ -554,10 +554,10 @@ (initargs (clim-mop:slot-definition-initargs slot)) (initfunc (clim-mop:slot-definition-initfunction slot)) (initform (clim-mop:slot-definition-initform slot)) - (direct-slots (direct-slot-definitions class name)) - (readers (mapcan #'clim-mop:slot-definition-readers direct-slots)) - (writers (mapcan #'clim-mop:slot-definition-writers direct-slots)) - (documentation (first (mapcan (lambda (x) (list (documentation x t))) direct-slots))) + (direct-slots (direct-slot-definitions class name)) + (readers (mapcan (lambda (x) (copy-list (clim-mop:slot-definition-readers x))) direct-slots)) + (writers (mapcan (lambda (x) (copy-list (clim-mop:slot-definition-writers x))) direct-slots)) + (documentation (first (remove nil (mapcar (lambda (x) (documentation x t)) direct-slots)))) (*standard-output* stream)) (macrolet ((with-ink ((var) &body body) @@ -719,11 +719,10 @@ (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) - (let ((classes (remove-ignorable-classes (copy-list (clim-mop:class-precedence-list class)))) - (gfs nil)) - (dolist (x classes) - (setf gfs (append gfs (x-specializer-direct-generic-functions x)))) - (remove-duplicates gfs))) + (remove-duplicates + (mapcan (lambda (class) + (copy-list (x-specializer-direct-generic-functions class))) + (remove-ignorable-classes (clim-mop:class-precedence-list class))))) (defun slot-name-sortp (a b) (flet ((slot-name-symbol (x) @@ -1164,8 +1163,7 @@ :printer (lambda (x stream) (declare (ignore stream)) (pretty-pretty-pathname x *standard-output* :long-name full-names))) - (goatee::reposition-stream-cursor *standard-output*) - (vertical-gap t)) + (goatee::reposition-stream-cursor *standard-output*)) ; Hmm. (list (dolist (ent group) (let ((ent (merge-pathnames ent pathname))) ;; This is for CMUCL, see above. (fixme!) ;; And breaks some things for SBCL.. (mgr)

1 0

[mcclim-cvs] CVS mcclim
by ahefner 03 Feb '08

03 Feb '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv30581 Modified Files: input-editing.lisp Log Message: Oops, deleted an extra line along with the old comment. --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/02/03 10:38:58 1.69 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/02/03 11:35:22 1.70 @@ -592,6 +592,7 @@ (progn (unread-gesture gesture :stream stream) (return-from complete-input-rescan + (values object t input))) ;; This used to be an error, but no one thought ;; that was a really great idea. (signal 'simple-completion-error

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs