mcclim-cvs June 2009

mcclim-cvs@common-lisp.net

2 participants
13 discussions

[mcclim-cvs] CVS mcclim
by ahefner 16 Jun '09

16 Jun '09

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv7646 Modified Files: recording.lisp Log Message: Fix bounding rectangle computation for open polygons. --- /project/mcclim/cvsroot/mcclim/recording.lisp 2008/08/19 15:56:50 1.142 +++ /project/mcclim/cvsroot/mcclim/recording.lisp 2009/06/16 05:15:35 1.143 @@ -1508,8 +1508,7 @@ (if (eql i final-index) (values final-xn final-yn) (values (svref coord-seq (+ i 2)) - (svref coord-seq (+ i - 3))))) + (svref coord-seq (+ i 3))))) (multiple-value-bind (ex1 ey1) (normalize-coords (- x xp) (- y yp)) (multiple-value-bind (ex2 ey2) @@ -1559,8 +1558,8 @@ (maxf max-y (+ y ny)))))))) (unless closed (multiple-value-bind (x y) - (values (svref coord-seq final-index) - (svref coord-seq (1+ final-index))) + (values (svref coord-seq (- len 2)) + (svref coord-seq (- len 1))) (minf min-x (- x border)) (minf min-y (- y border)) (maxf max-x (+ x border))

1 0

[mcclim-cvs] CVS mcclim/Experimental/freetype
by ahefner 14 Jun '09

14 Jun '09

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory cl-net:/tmp/cvs-serv3498 Modified Files: xrender-fonts.lisp Log Message: Transform :fixed to :fix during font lookup. Apparently necessary to run on a machine without fontconfig. --- /project/mcclim/cvsroot/mcclim/Experimental/freetype/xrender-fonts.lisp 2008/01/31 08:58:20 1.1 +++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/xrender-fonts.lisp 2009/06/14 18:37:39 1.2 @@ -439,6 +439,7 @@ (setf face (or face :roman)) (setf family (or family :fix)) (setf size (or size :normal)) + (when (eq family :fixed) (setf family :fix)) (cond (size (setf size (getf *sizes* size size)) (let ((val (gethash (list display family face size) *display-face-hash*)))

1 0

[mcclim-cvs] CVS mcclim
by ahefner 14 Jun '09

14 Jun '09

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv3360 Modified Files: text-editor-gadget.lisp Log Message: Fix :fixed text style choice. --- /project/mcclim/cvsroot/mcclim/text-editor-gadget.lisp 2008/11/09 19:52:44 1.12 +++ /project/mcclim/cvsroot/mcclim/text-editor-gadget.lisp 2009/06/14 18:33:45 1.13 @@ -40,7 +40,7 @@ ;;; are defined here. (defparameter *default-text-field-text-style* - (make-text-style :fixed :roman :normal)) + (make-text-style :fix :roman :normal)) (defclass editor-substrate-mixin (value-gadget) ((activation-gestures :reader activation-gestures

1 0

[mcclim-cvs] CVS mcclim
by rstrandh 08 Jun '09

08 Jun '09

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv26572 Added Files: mcclim-tiff-bitmaps.asd Log Message: Tiff bitmap formats from Cyrus Harmon. --- /project/mcclim/cvsroot/mcclim/mcclim-tiff-bitmaps.asd 2009/06/08 14:39:57 NONE +++ /project/mcclim/cvsroot/mcclim/mcclim-tiff-bitmaps.asd 2009/06/08 14:39:57 1.1 ;;; -*- Mode: Lisp -*- ;;; (c) copyright 2009 by ;;; Cyrus Harmon (ch-lisp(a)bobobeach.com) ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (asdf:defsystem :mcclim-tiff-bitmaps :description "Support for TIFF images in McCLIM bitmap reading functions." :depends-on (:mcclim :retrospectiff) :components ((:file "tiff" :pathname #P"Extensions/Bitmap-formats/tiff")))

1 0

[mcclim-cvs] CVS mcclim/Extensions/Bitmap-formats
by rstrandh 08 Jun '09

08 Jun '09

Update of /project/mcclim/cvsroot/mcclim/Extensions/Bitmap-formats In directory cl-net:/tmp/cvs-serv26572/Extensions/Bitmap-formats Added Files: tiff.lisp Log Message: Tiff bitmap formats from Cyrus Harmon. --- /project/mcclim/cvsroot/mcclim/Extensions/Bitmap-formats/tiff.lisp 2009/06/08 14:39:57 NONE +++ /project/mcclim/cvsroot/mcclim/Extensions/Bitmap-formats/tiff.lisp 2009/06/08 14:39:57 1.1 ;;; -*- Mode: Lisp; Package: MCCLIM-IMAGES -*- ;;; (c) copyright 2009 by ;;; Cyrus Harmon (ch-lisp(a)bobobeach.com) ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (in-package :clim-internals) (define-bitmap-file-reader :tiff (pathname) (let ((tiff-image (tiff:read-tiff-file pathname))) (with-accessors ((height tiff:tiff-image-length) (width tiff:tiff-image-width) (ncomp tiff:tiff-image-samples-per-pixel) (data tiff:tiff-image-data)) tiff-image (let* ((array (make-array (list height width) :element-type '(unsigned-byte 32)))) (case ncomp (3 (dotimes (x width) (dotimes (y height) (let ((red (aref data (+ (* x 3) (* y width 3)))) (green (aref data (+ (* x 3) (* y width 3) 1))) (blue (aref data (+ (* x 3) (* y width 3) 2)))) (setf (aref array y x) (dpb red (byte 8 0) (dpb green (byte 8 8) (dpb blue (byte 8 16) (dpb (- 255 0) (byte 8 24) 0))))))))) (1 (dotimes (x width) (dotimes (y height) (let ((gray (aref data (+ x (* y width))))) (setf (aref array y x) (dpb gray (byte 8 0) (dpb gray (byte 8 8) (dpb gray (byte 8 16) (dpb (- 255 0) (byte 8 24) 0)))))))))) array)))) (define-bitmap-file-reader :tif (pathname) (read-bitmap-file pathname :format :tiff))

1 0

[mcclim-cvs] CVS mcclim
by rstrandh 07 Jun '09

07 Jun '09

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv26737 Modified Files: mcclim-gif-bitmaps.asd mcclim-jpeg-bitmaps.asd Log Message: Patch from Cyrus Harmon that removes two unnecessary packages, and which fixes a typo in mcclim-jpeg-bitmaps. --- /project/mcclim/cvsroot/mcclim/mcclim-gif-bitmaps.asd 2008/04/14 16:46:37 1.1 +++ /project/mcclim/cvsroot/mcclim/mcclim-gif-bitmaps.asd 2009/06/07 10:32:18 1.2 @@ -18,12 +18,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -(cl:defpackage :mcclim-gif-bitmaps.system - (:use :asdf :cl)) - -(cl:in-package :mcclim-gif-bitmaps.system) - -(defsystem :mcclim-gif-bitmaps - :description "Support for GIF images in McCLIM bitmap reading functions." - :depends-on (:mcclim :skippy) - :components ((:file "gif" :pathname #P"Extensions/Bitmap-formats/gif"))) +(asdf:defsystem :mcclim-gif-bitmaps + :description "Support for GIF images in McCLIM bitmap reading functions." + :depends-on (:mcclim :skippy) + :components ((:file "gif" :pathname #P"Extensions/Bitmap-formats/gif"))) --- /project/mcclim/cvsroot/mcclim/mcclim-jpeg-bitmaps.asd 2008/04/14 16:46:37 1.1 +++ /project/mcclim/cvsroot/mcclim/mcclim-jpeg-bitmaps.asd 2009/06/07 10:32:18 1.2 @@ -18,12 +18,8 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -(cl:defpackage :mcclim-gif-bitmaps.system - (:use :asdf :cl)) +(asdf:defsystem :mcclim-jpeg-bitmaps + :description "Support for JPEG images in McCLIM bitmap reading functions." + :depends-on (:mcclim :cl-jpeg) + :components ((:file "jpeg" :pathname #P"Extensions/Bitmap-formats/jpeg"))) -(cl:in-package :mcclim-gif-bitmaps.system) - -(defsystem :mcclim-jpeg-bitmaps - :description "Support for JPEG images in McCLIM bitmap reading functions." - :depends-on (:mcclim :cl-jpeg) - :components ((:file "gif" :pathname #P"Extensions/Bitmap-formats/jpeg")))

1 0

[mcclim-cvs] CVS mcclim
by ahefner 07 Jun '09

07 Jun '09

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv32296 Modified Files: clim-listener.asd Log Message: ASDF commands for the listener. --- /project/mcclim/cvsroot/mcclim/clim-listener.asd 2008/10/22 23:26:58 1.5 +++ /project/mcclim/cvsroot/mcclim/clim-listener.asd 2009/06/07 08:48:00 1.6 @@ -16,8 +16,11 @@ (:file "util" :depends-on ("package")) (:file "icons" :depends-on ("package" "util")) (:file "file-types" :depends-on ("package" "icons" "util")) - (:file "dev-commands" :depends-on ("package" "appearance" "icons" "file-types" "util")) + (:file "asdf" :depends-on ("package")) + (:file "dev-commands" + :depends-on ("package" "appearance" "icons" "file-types" "util" "asdf")) (:file "wholine" :depends-on ("package" "dev-commands" "util")) - (:file "listener" :depends-on ("package" "wholine" "file-types" "icons" "dev-commands" "util")) + (:file "listener" + :depends-on ("package" "wholine" "file-types" "icons" "dev-commands" "util")) #+CMU (:file "cmu-hacks" :depends-on ("package"))))))

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 07 Jun '09

07 Jun '09

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory cl-net:/tmp/cvs-serv32228 Modified Files: dev-commands.lisp listener.lisp package.lisp Added Files: asdf.lisp Log Message: ASDF commands for the listener. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2009/04/14 07:36:42 1.66 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2009/06/07 08:47:39 1.67 @@ -24,7 +24,9 @@ (define-command-table application-commands) (define-command-table lisp-dev-commands :inherit-from nil) ;; Translators live here -(define-command-table lisp-commands :inherit-from (lisp-dev-commands)) +(define-command-table lisp-commands + :inherit-from (lisp-dev-commands) + :menu (("ASDF" :menu asdf-commands))) (define-command-table show-commands :inherit-from (lisp-dev-commands)) @@ -34,7 +36,6 @@ (define-command-table directory-stack-commands) - ;;; Presentation types (define-presentation-type specializer () :inherit-from 'expression) @@ -1241,11 +1242,6 @@ "Load" (format nil "Load ~A" pathname))) -(defmethod mime-type-to-command ((mime-type text/x-lisp-system) pathname) - (values `(com-load-file ,pathname) - "Load System" - (format nil "Load System ~A" pathname))) - ;; I've taken to doing translator documentation exactly opposite of how the CLIM ;; spec seems to intend. The spec says that the pointer-documentation should be ;; short and quickly computed, and the documentation should be longer and more --- /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2008/12/07 20:24:44 1.44 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2009/06/07 08:47:40 1.45 @@ -96,11 +96,15 @@ :display-time :command-loop :end-of-line-action :allow))) (:top-level (default-frame-top-level :prompt 'print-listener-prompt)) (:command-table (listener - :inherit-from (application-commands lisp-commands filesystem-commands show-commands) - :menu (("Application" :menu application-commands) - ("Lisp" :menu lisp-commands) - ("Filesystem" :menu filesystem-commands) - ("Show" :menu show-commands)))) + :inherit-from (application-commands + lisp-commands + asdf-commands + filesystem-commands + show-commands) + :menu (("Listener" :menu application-commands) + ("Lisp" :menu lisp-commands) + ("Filesystem" :menu filesystem-commands) + ("Show" :menu show-commands)))) (:disabled-commands com-pop-directory com-drop-directory com-swap-directory) (:menu-bar t) (:layouts (default --- /project/mcclim/cvsroot/mcclim/Apps/Listener/package.lisp 2008/04/26 21:19:59 1.4 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/package.lisp 2009/06/07 08:47:40 1.5 @@ -8,7 +8,7 @@ (in-package :clim-listener) (eval-when (:load-toplevel) -; (format t "~&~%!@#%^!@#!@ ... ~A~%~%" *load-truename*) - (defparameter *icon-path* (merge-pathnames - #P"icons/" - (load-time-value (or #.*compile-file-pathname* *load-pathname*))))) + (defparameter *icon-path* + (merge-pathnames + #P"icons/" + (load-time-value (or #.*compile-file-pathname* *load-pathname*))))) --- /project/mcclim/cvsroot/mcclim/Apps/Listener/asdf.lisp 2009/06/07 08:47:43 NONE +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/asdf.lisp 2009/06/07 08:47:43 1.1 ;;; This is a lisp listener. ;;; (C) Copyright 2009 by Andy Hefner (ahefner(a)gmail.com) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (in-package :clim-listener) ;;;; CLIM defintions for interacting with ASDF (define-command-table asdf-commands :inherit-from nil) (define-presentation-type asdf-system ()) (define-presentation-type asdf-system-definition () :inherit-from 'pathname) (defclass asdf-attribute-view (textual-view) ((ignorable-attributes :reader ignorable-attributes :initform nil :initarg :ignore) (note-unloaded :reader note-unloaded :initform nil :initarg :note-unloaded) (default-label :reader default-attr-label :initform "" :initarg :default))) (defmethod ignorable-attributes (view) nil) (defmethod note-unloaded (view) nil) (defmethod default-attr-label (view) "") (defun asdf-loaded-systems () "Retrieve a list of loaded systems from ASDF" (let (systems) (maphash (lambda (name foo.system) (declare (ignore name)) (push (cdr foo.system) systems)) asdf::*defined-systems*) systems)) (defun asdf-get-central-registry () asdf::*central-registry*) (defun asdf-registry-system-files () "Retrieve the list of unique pathnames contained within the ASDF registry folders" (remove-duplicates (remove-if-not #'pathname-name (apply #'concatenate 'list (mapcar (lambda (form) (list-directory (merge-pathnames (eval form) #p"*.asd"))) (asdf-get-central-registry)))) :test #'equal)) (defun asdf-system-name (system) (slot-value system 'asdf::name)) (defun asdf-operation-pretty-name (op) (case op (asdf:compile-op "compiled") (asdf:load-op "loaded") (:unloaded "unloaded") (otherwise (prin1-to-string op)))) (defun asdf-system-history (system) (let (history) (maphash (lambda (operation time) (declare (ignore time)) (push operation history)) (slot-value system 'asdf::operation-times)) (nreverse history))) (define-presentation-method presentation-typep (object (type asdf-system)) (typep object 'asdf:system)) (define-presentation-method present (object (type asdf-system) stream (view textual-view) &key acceptably) (if acceptably (princ (asdf-system-name object) stream ) (let* ((history (asdf-system-history object)) (loaded-p (find 'asdf:load-op history)) (eff-history (set-difference history (ignorable-attributes view)))) (when (and (note-unloaded view) (not loaded-p)) (push :unloaded eff-history)) (format stream "~A~A" (asdf-system-name object) (if (null eff-history) (default-attr-label view) (format nil " (~{~a~^, ~})" (mapcar 'asdf-operation-pretty-name eff-history))))))) (define-presentation-method accept ((type asdf-system) stream (view textual-view) &key) (multiple-value-bind (object success) (completing-from-suggestions (stream) (dolist (system (asdf-loaded-systems)) (suggest (asdf-system-name system) system))) (if success object (simple-parse-error "Unknown system")))) (define-command (com-list-systems :name "List Systems" :command-table asdf-commands :menu t) () (format-items (asdf-loaded-systems) :printer (lambda (item stream) (present item 'asdf-system :stream stream :view (make-instance 'asdf-attribute-view :note-unloaded t :ignore '(asdf:compile-op asdf:load-op)))) :presentation-type 'asdf-system)) (define-command (com-show-available-systems :name "Show System Files" :command-table asdf-commands :menu t) () (format-items (asdf-registry-system-files) :presentation-type 'asdf-system-definition)) (define-command (com-operate-on-system :name "Operate On System" :command-table asdf-commands :menu t) ((system '(type-or-string asdf-system) :prompt "system") (operation '(member asdf::compile-op asdf::load-op) :default 'asdf::load-op :prompt "operation")) (asdf:oos operation system)) (define-command (com-load-system :name "Load System" :command-table asdf-commands :menu t) ((system '(type-or-string asdf-system) :prompt "system")) (asdf:oos 'asdf:compile-op system) (asdf:oos 'asdf:load-op system)) (defmethod mime-type-to-command ((mime-type text/x-lisp-system) pathname) (values `(com-load-system ,pathname) "Load System" (format nil "Load System ~A" pathname)))

1 0

[mcclim-cvs] CVS mcclim/Extensions/Bitmap-formats
by rstrandh 07 Jun '09

07 Jun '09

Update of /project/mcclim/cvsroot/mcclim/Extensions/Bitmap-formats In directory cl-net:/tmp/cvs-serv2246 Modified Files: jpeg.lisp Log Message: Patch from Cyrus Harmon to make it possible to read grayscale jpeg files. --- /project/mcclim/cvsroot/mcclim/Extensions/Bitmap-formats/jpeg.lisp 2008/04/14 16:46:30 1.1 +++ /project/mcclim/cvsroot/mcclim/Extensions/Bitmap-formats/jpeg.lisp 2009/06/07 06:56:49 1.2 @@ -23,22 +23,32 @@ (in-package :clim-internals) (define-bitmap-file-reader :jpeg (pathname) - (with-open-file (stream pathname :direction :input) - (multiple-value-bind (rgb height width) - (jpeg::decode-image stream) - (let* ((array (make-array (list height width) - :element-type '(unsigned-byte 32)))) - (dotimes (x width) - (dotimes (y height) - (let ((blue (aref rgb (+ (* x 3) (* y width 3)))) - (green (aref rgb (+ (* x 3) (* y width 3) 1))) - (red (aref rgb (+ (* x 3) (* y width 3) 2)))) - (setf (aref array y x) - (dpb red (byte 8 0) - (dpb green (byte 8 8) - (dpb blue (byte 8 16) - (dpb (- 255 0) (byte 8 24) 0)))))))) - array)))) + (multiple-value-bind (rgb height width ncomp) + (jpeg:decode-image pathname) + (let* ((array (make-array (list height width) + :element-type '(unsigned-byte 32)))) + (case ncomp + (3 + (dotimes (x width) + (dotimes (y height) + (let ((blue (aref rgb (+ (* x 3) (* y width 3)))) + (green (aref rgb (+ (* x 3) (* y width 3) 1))) + (red (aref rgb (+ (* x 3) (* y width 3) 2)))) + (setf (aref array y x) + (dpb red (byte 8 0) + (dpb green (byte 8 8) + (dpb blue (byte 8 16) + (dpb (- 255 0) (byte 8 24) 0))))))))) + (1 + (dotimes (x width) + (dotimes (y height) + (let ((gray (aref rgb (+ x (* y width))))) + (setf (aref array y x) + (dpb gray (byte 8 0) + (dpb gray (byte 8 8) + (dpb gray (byte 8 16) + (dpb (- 255 0) (byte 8 24) 0)))))))))) + array))) (define-bitmap-file-reader :jpg (pathname) (read-bitmap-file pathname :format :jpeg))

1 0

[mcclim-cvs] CVS mcclim
by ahefner 03 Jun '09

03 Jun '09

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv24386 Modified Files: medium.lisp Log Message: Change *default-text-style* to a sans-serif face. --- /project/mcclim/cvsroot/mcclim/medium.lisp 2008/01/21 01:26:42 1.64 +++ /project/mcclim/cvsroot/mcclim/medium.lisp 2009/06/03 20:38:15 1.65 @@ -158,7 +158,7 @@ (equal (text-style-face style1) (text-style-face style2)) (eql (text-style-size style1) (text-style-size style2)))) -(defconstant *default-text-style* (make-text-style :fix :roman :normal)) +(defconstant *default-text-style* (make-text-style :sans-serif :roman :normal)) (defconstant *undefined-text-style* *default-text-style*) (defconstant *smaller-sizes* '(:huge :very-large :large :normal

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs June 2009