mcclim-devel December 2004

mcclim-devel@common-lisp.net

18 participants
23 discussions

[mcclim-devel] Fix for Scigraph package lock error with CMUCL
by Robert Strandh 28 Dec '04

28 Dec '04

Paolo Amoroso writes: > The current CVS sources of Scigraph generate a package lock error > during compilation or load with recent versions of CMUCL, I think the > 19a prerelease and release series. It is caused by a conflict with > the symbol `cl:variable'. The problem can be fixed by changing in > file Apps/Scigraph/scigraph/package.lisp the form: > > (eval-when (compile load eval) > (defpackage GRAPH > #-allegro (:nicknames gr) ; "GR" names something already. > #+allegro (:shadow variable) ; shouldn't be inherited but is > #+MCL (:shadow copy) > (:use dwim-lisp tool statistics))) > > to this, which removes the conditionalization of `variable' shadowing > for allegro: > > (eval-when (compile load eval) > (defpackage GRAPH > #-allegro (:nicknames gr) ; "GR" names something already. > (:shadow variable) ; shouldn't be inherited but is > #+MCL (:shadow copy) > (:use dwim-lisp tool statistics))) Patch applied. Thanks. -- Robert Strandh --------------------------------------------------------------------- Greenspun's Tenth Rule of Programming: any sufficiently complicated C or Fortran program contains an ad hoc informally-specified bug-ridden slow implementation of half of Common Lisp. ---------------------------------------------------------------------

1 0

[mcclim-devel] Fix for Scigraph package lock error with CMUCL
by Robert Strandh 28 Dec '04

28 Dec '04

1 0

[mcclim-devel] Multi-screen displays with differing depth
by Martin ``rydis'' Rydstr|m 28 Dec '04

28 Dec '04

... cause problems with McCLIM, giving wrong colours. Fix: --- Index: port.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp,v retrieving revision 1.100 diff -u -r1.100 port.lisp --- port.lisp 11 Dec 2004 21:15:22 -0000 1.100 +++ port.lisp 26 Dec 2004 09:09:34 -0000 @@ -1063,8 +1063,7 @@ (or (gethash color table) (setf (gethash color table) (multiple-value-bind (r g b) (color-rgb color) - (xlib:alloc-color (xlib:screen-default-colormap - (first (xlib:display-roots (clx-port-display port)))) + (xlib:alloc-color (xlib:screen-default-colormap (clx-port-screen port)) (xlib:make-color :red r :green g :blue b))))))) (defmethod port-mirror-width ((port clx-port) sheet) --- (The problem being that, in my case, :0.0 and :0.1 have different depths, and the colour gets mixed up on :0.1. An example of what it looks like without the fix: <URL: http://rydis.no-ip.org:11147/tmp/snaps/20041225-06:21:37-snap.png >) Regards, 'mr -- [Emacs] is written in Lisp, which is the only computer language that is beautiful. -- Neal Stephenson, _In the Beginning was the Command Line_

2 1

[mcclim-devel] Question about system.lisp and mcclim
by Robert P. Goldman 27 Dec '04

27 Dec '04

IIUC, the default McCLIM system.lisp file loads into Common-lisp-user, loads mk-defsystem, and then tries to USE the MAKE package. I have been using McCLIM on Allegro CL 6.2, and find that this causes me problems. The problem is that in Allegro, Common-lisp-user by default USEs the EXCL extended common-lisp package. Unfortunately, EXCL imports Allegro's OWN defsystem package, so that when you try to use MK, it causes a clash. I'm always nervous about shadowing something that Allegro wants imported, since it's bitten me before. Fortunately, AFAICT, it's trivial to modify SYSTEM.LISP, so that you DON'T need to import anything from MK --- you can just use the package references w/o much effort. Here's a proposed patch that seems to work just fine for me: --- system.lisp 20 Dec 2004 15:49:49 -0000 1.106 +++ system.lisp 27 Dec 2004 15:43:54 -0000 @@ -43,12 +43,15 @@ (defparameter *clim-directory* (director (pushnew :clim *features*) (pushnew :mcclim *features*) -#+mk-defsystem (use-package "MK") +;;; I really didn't have good luck with this on Allegro, because +;;; Allegro's CL-USER package uses it's EXCL stuff, which has its own +;;; DEFSYSTEM. [2004/12/21:rpg] +;;;#+mk-defsystem (use-package "MK") (defmacro clim-defsystem ((module &key depends-on) &rest components) `(progn #+mk-defsystem - (defsystem ,module + (mk:defsystem ,module :source-pathname *clim-directory* :source-extension "lisp" ,@(and depends-on `(:depends-on ,depends-on)) Best, Robert

3 2

[mcclim-devel] format-graph-from-roots
by rpgoldman＠real-time.com 24 Dec '04

24 Dec '04

I was just reading over the CLIM spec, and apropos of this function, it states that there should be a default to the ARC-DRAWER keyword argument. "If arc-drawer is unsupplied, the default behavior is to draw a thin line from the ``from'' node to the ``to'' node using `=--cldraw-line*." But what's checked into the CVS now doesn't have that, causing crashes if it's omitted. I think some simple default to DRAW-ARROW* should work, but I'm too abysmally ignorant of CLIM to propose a patch myself. Best, Robert

2 1

[mcclim-devel] support for clisp (1)
by Bruno Haible 21 Dec '04

21 Dec '04

Hi, Appended you find patches for supporting clisp. Part 1 of the patches are the obvious portability things. It should be uncontroversial and adds two files INSTALL.CLISP and Lisp-Dep/fix-clisp.lisp. diff -r -c3 mcclim.orig/Apps/Listener/dev-commands.lisp mcclim/Apps/Listener/dev-commands.lisp *** mcclim.orig/Apps/Listener/dev-commands.lisp 2004-10-18 08:30:37.000000000 +0200 --- mcclim/Apps/Listener/dev-commands.lisp 2004-12-18 02:47:15.000000000 +0100 *************** *** 617,625 **** (defun x-specializer-direct-generic-functions (specializer) ;; FIXME - move to CLIM-MOP #+PCL (pcl::specializer-direct-generic-functions specializer) #+SBCL (sb-pcl::specializer-direct-generic-functions specializer) #+openmcl-partial-mop (openmcl-mop:specializer-direct-generic-functions specializer) ! #-(or PCL SBCL openmcl-partial-mop) (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) --- 617,626 ---- (defun x-specializer-direct-generic-functions (specializer) ;; FIXME - move to CLIM-MOP #+PCL (pcl::specializer-direct-generic-functions specializer) #+SBCL (sb-pcl::specializer-direct-generic-functions specializer) + #+clisp (clos:specializer-direct-generic-functions specializer) #+openmcl-partial-mop (openmcl-mop:specializer-direct-generic-functions specializer) ! #-(or PCL SBCL clisp openmcl-partial-mop) (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) *************** *** 890,896 **** ;; hash table capacity #+cmu (values (lisp::internal-symbol-count package)) #+sbcl (values (sb-int:package-internal-symbol-count package)) ! #-(or cmu sbcl) (portable-internal-symbol-count package)) (defun portable-external-symbol-count (package) (let ((n 0)) --- 891,898 ---- ;; hash table capacity #+cmu (values (lisp::internal-symbol-count package)) #+sbcl (values (sb-int:package-internal-symbol-count package)) ! #+clisp (svref (sys::%record-ref *package* 1) 2) ! #-(or cmu sbcl clisp) (portable-internal-symbol-count package)) (defun portable-external-symbol-count (package) (let ((n 0)) *************** *** 903,909 **** "Return the number of external symbols in PACKAGE." #+cmu (values (lisp::external-symbol-count package)) #+sbcl (values (sb-int:package-external-symbol-count package)) ! #-(or cmu sbcl) (portable-external-symbol-count package)) (defun package-grapher (stream package inferior-fun) "Draw package hierarchy graphs for `Show Package Users' and `Show Used Packages'." --- 905,912 ---- "Return the number of external symbols in PACKAGE." #+cmu (values (lisp::external-symbol-count package)) #+sbcl (values (sb-int:package-external-symbol-count package)) ! #+clisp (svref (sys::%record-ref *package* 0) 2) ! #-(or cmu sbcl clisp) (portable-external-symbol-count package)) (defun package-grapher (stream package inferior-fun) "Draw package hierarchy graphs for `Show Package Users' and `Show Used Packages'." diff -r -c3 mcclim.orig/Apps/Listener/listener.lisp mcclim/Apps/Listener/listener.lisp *** mcclim.orig/Apps/Listener/listener.lisp 2004-11-15 08:07:26.000000000 +0100 --- mcclim/Apps/Listener/listener.lisp 2004-12-18 02:48:55.000000000 +0100 *************** *** 64,70 **** #+sbcl (sb-kernel:dynamic-usage) #+lispworks (getf (system:room-values) :total-allocated) #+openmcl (+ (ccl::%usedbytes) (ccl::%freebytes)) ! #-(or cmu sbcl lispworks openmcl) 0)) (with-text-family (T :serif) (formatting-table (T :x-spacing '(3 :character)) (formatting-row (T) --- 64,71 ---- #+sbcl (sb-kernel:dynamic-usage) #+lispworks (getf (system:room-values) :total-allocated) #+openmcl (+ (ccl::%usedbytes) (ccl::%freebytes)) ! #+clisp (values (sys::%room)) ! #-(or cmu sbcl lispworks openmcl clisp) 0)) (with-text-family (T :serif) (formatting-table (T :x-spacing '(3 :character)) (formatting-row (T) diff -r -c3 mcclim.orig/Apps/Listener/util.lisp mcclim/Apps/Listener/util.lisp *** mcclim.orig/Apps/Listener/util.lisp 2004-07-23 14:36:45.000000000 +0200 --- mcclim/Apps/Listener/util.lisp 2004-12-18 02:54:51.000000000 +0100 *************** *** 64,75 **** --- 64,77 ---- #+sbcl (sb-ext:posix-getenv var) #+lispworks (lw:environment-variable var) #+openmcl (ccl::getenv var) + #+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)) + #+clisp (ext:cd pathname) ; SBCL FIXME? (setf *default-pathname-defaults* pathname)) *************** *** 154,161 **** :shell-type "/bin/sh" :output-stream output :wait wait) ! #-(or CMU SBCL lispworks) (format T "~&Sorry, don't know how to run programs in your CL.~%")) ;;;; CLIM/UI utilities --- 156,164 ---- :shell-type "/bin/sh" :output-stream output :wait wait) + #+clisp (ext:run-program program :arguments args :wait wait) ! #-(or CMU SBCL lispworks clisp) (format T "~&Sorry, don't know how to run programs in your CL.~%")) ;;;; CLIM/UI utilities diff -r -c3 mcclim.orig/README mcclim/README *** mcclim.orig/README 2003-11-12 00:45:15.000000000 +0100 --- mcclim/README 2004-12-18 01:19:07.000000000 +0100 *************** *** 2,9 **** This is McCLIM, an implementation of the "Common Lisp Interface Manager CLIM II Specification." It currently works on X Windows using ! CLX. It works with CMUCL, SBCL, OpenMCL, Allegro CL and LispWorks. The ! INSTALL files in this directory give instructions for each Lisp implementation. Release notes for each release of McCLIM are in the ReleaseNotes directory. --- 2,9 ---- This is McCLIM, an implementation of the "Common Lisp Interface Manager CLIM II Specification." It currently works on X Windows using ! CLX. It works with CMUCL, SBCL, CLISP, OpenMCL, Allegro CL and LispWorks. ! The INSTALL files in this directory give instructions for each Lisp implementation. Release notes for each release of McCLIM are in the ReleaseNotes directory. diff -r -c3 mcclim.orig/describe.lisp mcclim/describe.lisp *** mcclim.orig/describe.lisp 2004-11-15 05:47:41.000000000 +0100 --- mcclim/describe.lisp 2004-12-18 01:22:07.000000000 +0100 *************** *** 70,76 **** (let ((arglist #+excl (excl:arglist (symbol-function thing)) #+cmu (kernel:%function-arglist (symbol-function thing)) #+sbcl (sb-kernel:%simple-fun-arglist (symbol-function thing)) ! #-(or excl cmu sbcl) "( ??? )")) (when arglist (clim:present arglist (clim:presentation-type-of arglist) --- 70,77 ---- (let ((arglist #+excl (excl:arglist (symbol-function thing)) #+cmu (kernel:%function-arglist (symbol-function thing)) #+sbcl (sb-kernel:%simple-fun-arglist (symbol-function thing)) ! #+clisp (ext:arglist (symbol-function thing)) ! #-(or excl cmu sbcl clisp) "( ??? )")) (when arglist (clim:present arglist (clim:presentation-type-of arglist) diff -r -c3 mcclim.orig/package.lisp mcclim/package.lisp *** mcclim.orig/package.lisp 2004-12-07 05:49:51.000000000 +0100 --- mcclim/package.lisp 2004-12-18 01:40:42.000000000 +0100 *************** *** 185,193 **** #:with-standard-io-syntax #:write #:write-byte #:write-char #:write-line #:write-sequence #:write-string #:write-to-string #:y-or-n-p #:yes-or-no-p #:zerop)) (packages - #+clisp '(:common-lisp :clos) #+gcl '(:lisp :pcl) ! #-(or clisp gcl) '(:common-lisp)) (gray-symbols '(#:fundamental-stream #:fundamental-input-stream --- 185,192 ---- #:with-standard-io-syntax #:write #:write-byte #:write-char #:write-line #:write-sequence #:write-string #:write-to-string #:y-or-n-p #:yes-or-no-p #:zerop)) (packages #+gcl '(:lisp :pcl) ! #-(or gcl) '(:common-lisp)) (gray-symbols '(#:fundamental-stream #:fundamental-input-stream *************** *** 218,224 **** #:stream-read-byte #:stream-write-byte )) (gray-packages ! `(#+clisp ,@'(:lisp) #+cmu ,@'(:ext) #+mcl ,@'(:ccl) #+allegro ,@'(:common-lisp :excl :stream) --- 217,223 ---- #:stream-read-byte #:stream-write-byte )) (gray-packages ! `(#+clisp ,@'(:gray) #+cmu ,@'(:ext) #+mcl ,@'(:ccl) #+allegro ,@'(:common-lisp :excl :stream) diff -r -c3 mcclim.orig/system.lisp mcclim/system.lisp *** mcclim.orig/system.lisp 2004-12-07 05:49:51.000000000 +0100 --- mcclim/system.lisp 2004-12-18 01:36:56.000000000 +0100 *************** *** 81,86 **** --- 81,87 ---- #+sbcl "Lisp-Dep/fix-sbcl" #+openmcl "Lisp-Dep/fix-openmcl" #+lispworks "Lisp-Dep/fix-lispworks" + #+clisp "Lisp-Dep/fix-clisp" "package") (clim-defsystem (:clim-core :depends-on (:clim-lisp)) diff -r -c3 mcclim.orig/utils.lisp mcclim/utils.lisp *** mcclim.orig/utils.lisp 2004-10-06 14:03:56.000000000 +0200 --- mcclim/utils.lisp 2004-12-18 01:46:28.000000000 +0100 *************** *** 22,28 **** (defun get-environment-variable (string) #+excl (sys:getenv string) #+cmu (cdr (assoc string ext:*environment-list* :test #'string=)) ! #+clisp (sys::getenv (string string)) #+sbcl (sb-ext::posix-getenv string) #+openmcl (ccl::getenv string) #+lispworks (lw:environment-variable string) --- 22,28 ---- (defun get-environment-variable (string) #+excl (sys:getenv string) #+cmu (cdr (assoc string ext:*environment-list* :test #'string=)) ! #+clisp (ext:getenv (string string)) #+sbcl (sb-ext::posix-getenv string) #+openmcl (ccl::getenv string) #+lispworks (lw:environment-variable string) *** /dev/null 2003-09-23 19:59:22.000000000 +0200 --- mcclim/INSTALL.CLISP 2004-12-18 11:37:30.000000000 +0100 *************** *** 0 **** --- 1,54 ---- + Install instructions for GNU CLISP + ---------------------------------- + + 1. Get clisp-20041218 or newer. Build it with option --with-module=clx/mit-clx. + + 2. Get a copy of the ASDF package. Compile it: + $ clisp -c $ASDF/asdf.lisp + + 3. Start + $ clisp -K full -i $ASDF/asdf.fas -i system.lisp + + 4. Load the system (which will also compile it): + + > (asdf:operate 'asdf:load-op :clim) ;; Build CLIM + > (asdf:operate 'asdf:load-op :clim-clx) ;; Build a backend + > (asdf:operate 'asdf:load-op :clim-examples) + + The first two steps can be done in one step with the :clim-clx-user target: + (asdf:operate 'asdf:load-op :clim-clx-user) + + 5. At a later date, after everything is compiled, load the compiled system: + + > (asdf:operate 'asdf:load-op :clim) ;; Load CLIM + > (asdf:operate 'asdf:load-op :clim-clx) ;; Load backend + + + Running the demos + ----------------- + + 1. Run the calculator demo + + (clim-demo::calculator) + + This demo is self-explanatory. + + When you get tired of it, hit Ctrl-C in the Lisp listener. + + 2. Run the menu demo + + (menutest::menutest) + + This demo is self-explanatory. + + When you get tired of it, hit Ctrl-C in the Lisp listener. + + 3. Run the slider demo + + (clim-demo::colorslider) + + You should see three sliders on the left and a color area on the right. + Use the three sliders to adjust RGB values to obtain a color. + + When you get tired of it - you know... + *** /dev/null 2003-09-23 19:59:22.000000000 +0200 --- mcclim/Lisp-Dep/fix-clisp.lisp 2004-12-18 02:04:36.000000000 +0100 *************** *** 0 **** --- 1,20 ---- + (defpackage #:clim-mop + (:use #:clos)) + + (eval-when (:compile-toplevel :load-toplevel :execute) + (loop for sym being the symbols of :clim-mop + do (export sym :clim-mop))) + + ;; CLIM expects INPUT-STREAM-P to be a generic function. + (unless (typep #'input-stream-p 'generic-function) + (setf (fdefinition 'gray::original-input-stream-p) #'input-stream-p) + (fmakunbound 'input-stream-p) + (defgeneric input-stream-p (stream) + (:method ((stream stream)) (gray::original-input-stream-p stream)))) + + ;; CLIM expects OUTPUT-STREAM-P to be a generic function. + (unless (typep #'output-stream-p 'generic-function) + (setf (fdefinition 'gray::original-output-stream-p) #'output-stream-p) + (fmakunbound 'output-stream-p) + (defgeneric output-stream-p (stream) + (:method ((stream stream)) (gray::original-output-stream-p stream))))

2 5

[mcclim-devel] Write access for Bruno Haible
by Brian Mastenbrook 19 Dec '04

19 Dec '04

Robert Strandh has suggested that Bruno Haible be given CVS write access so he can commit his clisp patches and otherwise maintain clisp support. Do you all think that's a good idea? If so I'll ask Mario or Dan to add him to the project. -- Brian Mastenbrook http://www.iscblog.info/ http://www.cs.indiana.edu/~bmastenb/

2 1

[mcclim-devel] misc warning fixes
by Bruno Haible 18 Dec '04

18 Dec '04

CLISP also gives some warning for unused variables and parameters. Here I fixed the first three warnings, but there are many more of this kind. diff -r -c3 mcclim.orig/Backends/PostScript/font.lisp mcclim/Backends/PostScript/font.lisp *** mcclim.orig/Backends/PostScript/font.lisp 2004-12-03 12:42:43.000000000 +0100 --- mcclim/Backends/PostScript/font.lisp 2004-12-18 02:14:41.000000000 +0100 *************** *** 66,72 **** (unless end (setq end (length string))) (let* ((font-info (or (gethash font-name *font-metrics*) (error "Unknown font ~S." font-name))) - (char-names (font-info-char-names font-info)) (char-metrics (font-info-char-infos font-info)) (scale (/ size 1000)) (width 0) (upper-width 0) --- 66,71 ---- diff -r -c3 mcclim.orig/Doc/manual.tex mcclim/Doc/manual.tex *** mcclim.orig/Doc/manual.tex 2004-12-13 13:18:06.000000000 +0100 --- mcclim/Doc/manual.tex 2004-12-18 01:29:16.000000000 +0100 *************** *** 326,332 **** contains McCLIM. If you use CMUCL or SBCL, you either need a \texttt{core} file that already has McCLIM in it, or else, you have to load the McCLIM compiled files that make up the McCLIM distribution. ! The fist solution is recommended so as to avoid having to load the McCLIM files each time you start your CLIM application. To execute the application, load the file containing your code --- 326,332 ---- contains McCLIM. If you use CMUCL or SBCL, you either need a \texttt{core} file that already has McCLIM in it, or else, you have to load the McCLIM compiled files that make up the McCLIM distribution. ! The first solution is recommended so as to avoid having to load the McCLIM files each time you start your CLIM application. To execute the application, load the file containing your code diff -r -c3 mcclim.orig/input.lisp mcclim/input.lisp *** mcclim.orig/input.lisp 2004-10-31 02:46:31.000000000 +0100 --- mcclim/input.lisp 2004-12-18 01:51:54.000000000 +0100 *************** *** 533,539 **** (:documentation "Returns the number of pixels respresenting a 'line', used to computed distance to scroll in response to mouse wheel events.")) ! (defmethod scroll-quantum (pane) 10) (defmethod dispatch-event :around ((sheet mouse-wheel-scroll-mixin) (event pointer-button-press-event)) --- 533,541 ---- (:documentation "Returns the number of pixels respresenting a 'line', used to computed distance to scroll in response to mouse wheel events.")) ! (defmethod scroll-quantum (pane) ! (declare (ignore pane)) ! 10) (defmethod dispatch-event :around ((sheet mouse-wheel-scroll-mixin) (event pointer-button-press-event)) diff -r -c3 mcclim.orig/presentation-defs.lisp mcclim/presentation-defs.lisp *** mcclim.orig/presentation-defs.lisp 2004-12-05 20:37:52.000000000 +0100 --- mcclim/presentation-defs.lisp 2004-12-18 02:19:26.000000000 +0100 *************** *** 468,474 **** (define-default-presentation-method presentation-type-history-for-stream (type stream) ! (declare (ignore stream)) nil) ;;; method for clim-stream-pane in panes.lisp --- 468,474 ---- (define-default-presentation-method presentation-type-history-for-stream (type stream) ! (declare (ignore type stream)) nil) ;;; method for clim-stream-pane in panes.lisp diff -r -c3 mcclim.orig/text-selection.lisp mcclim/text-selection.lisp *** mcclim.orig/text-selection.lisp 2004-12-07 05:49:51.000000000 +0100 --- mcclim/text-selection.lisp 2004-12-18 02:13:14.000000000 +0100 *************** *** 166,171 **** --- 166,172 ---- (with-sheet-medium (medium pane) (let ((R (region-difference region marked-region))) (with-drawing-options (medium :clipping-region R) + (declare (ignore medium)) (call-next-method pane R)))) (with-sheet-medium (medium pane) (let ((R (region-intersection region marked-region)))

1 0

[mcclim-devel] support for clisp (2)
by Bruno Haible 18 Dec '04

18 Dec '04

Part 2 of the patches are because clisp has UNICODE support but doesn't define an EXTERNAL-FORMAT package. (It has a CHARSET package.) And McCLIM doesn't provide a DEFPACKAGE declaration for the package EXTERNAL-FORMAT. This is a quick hack to get things running with ASCII characters. I'm not in the position of fixing this code because - Fontsets are outdated technology. Modern renderers use libXft. - The ksc5601-code-to-font-index function is incomplete. It lacks not only the arrays ksc5601-uni2indx-page00 etc. It lacks also a notice "Copyright (C) 1999-2002 Free Software Foundation, Inc. This function is taken from the GNU LIBICONV Library." I mean, I recognize code that I have written in 1999 even if it's translated into Lisp in 2004. - Assuming that the only languages of the world are English and Korean is, hmm, not yet realistic. English and Chinese as sole surviving languages is more probable in the long run. diff -r -c3 mcclim.orig/Backends/CLX/medium.lisp mcclim/Backends/CLX/medium.lisp *** mcclim.orig/Backends/CLX/medium.lisp 2004-04-23 21:29:49.000000000 +0200 --- mcclim/Backends/CLX/medium.lisp 2004-12-18 02:40:27.000000000 +0100 *************** *** 39,45 **** :initform nil) (picture :initform nil) ! #+unicode (fontset :initform nil :accessor medium-fontset) --- 39,45 ---- :initform nil) (picture :initform nil) ! #+(and allegro unicode) (fontset :initform nil :accessor medium-fontset) *************** *** 55,61 **** ;;; secondary methods for changing text styles and line styles ! #-unicode (defmethod (setf medium-text-style) :before (text-style (medium clx-medium)) (with-slots (gc) medium (when gc --- 55,61 ---- ;;; secondary methods for changing text styles and line styles ! #-(and allegro unicode) (defmethod (setf medium-text-style) :before (text-style (medium clx-medium)) (with-slots (gc) medium (when gc *************** *** 64,70 **** (setf (xlib:gcontext-font gc) (text-style-to-X-font (port medium) (medium-text-style medium)))))))) ! #+unicode (defmethod (setf medium-text-style) :before (text-style (medium clx-medium)) (with-slots (fontset) medium (let ((old-text-style (medium-text-style medium))) --- 64,70 ---- (setf (xlib:gcontext-font gc) (text-style-to-X-font (port medium) (medium-text-style medium)))))))) ! #+(and allegro unicode) (defmethod (setf medium-text-style) :before (text-style (medium clx-medium)) (with-slots (fontset) medium (let ((old-text-style (medium-text-style medium))) *************** *** 165,173 **** (xlib:gcontext-dashes gc) (if (eq dashes t) 3 dashes))))) (setf (xlib:gcontext-function gc) boole-1) ! #-unicode (setf (xlib:gcontext-font gc) (text-style-to-X-font port (medium-text-style medium))) ! #+unicode (setf (medium-fontset medium) (text-style-to-X-fontset port (medium-text-style medium))) (setf (xlib:gcontext-foreground gc) (X-pixel port ink) (xlib:gcontext-background gc) (X-pixel port (medium-background medium))) --- 165,173 ---- (xlib:gcontext-dashes gc) (if (eq dashes t) 3 dashes))))) (setf (xlib:gcontext-function gc) boole-1) ! #-(and allegro unicode) (setf (xlib:gcontext-font gc) (text-style-to-X-font port (medium-text-style medium))) ! #+(and allegro unicode) (setf (medium-fontset medium) (text-style-to-X-fontset port (medium-text-style medium))) (setf (xlib:gcontext-foreground gc) (X-pixel port ink) (xlib:gcontext-background gc) (X-pixel port (medium-background medium))) *************** *** 344,350 **** (let* ((line-style (medium-line-style ,medium)) (ink (medium-ink ,medium)) (gc (medium-gcontext ,medium ink)) ! #+unicode (*fontset* (or (medium-fontset ,medium) (setf (medium-fontset ,medium) (text-style-to-X-fontset (port ,medium) *default-text-style*))))) --- 344,350 ---- (let* ((line-style (medium-line-style ,medium)) (ink (medium-ink ,medium)) (gc (medium-gcontext ,medium ink)) ! #+(and allegro unicode) (*fontset* (or (medium-fontset ,medium) (setf (medium-fontset ,medium) (text-style-to-X-fontset (port ,medium) *default-text-style*))))) *************** *** 608,655 **** ;;; ;;; Methods for text styles ! #-unicode (defmethod text-style-ascent (text-style (medium clx-medium)) (let ((font (text-style-to-X-font (port medium) text-style))) (xlib:font-ascent font))) ! #+unicode (defmethod text-style-ascent (text-style (medium clx-medium)) (let ((fontset (text-style-to-X-fontset (port medium) text-style))) (fontset-ascent fontset))) ! #-unicode (defmethod text-style-descent (text-style (medium clx-medium)) (let ((font (text-style-to-X-font (port medium) text-style))) (xlib:font-descent font))) ! #+unicode (defmethod text-style-descent (text-style (medium clx-medium)) (let ((fontset (text-style-to-X-fontset (port medium) text-style))) (fontset-descent fontset))) ! #-unicode (defmethod text-style-height (text-style (medium clx-medium)) (let ((font (text-style-to-X-font (port medium) text-style))) (+ (xlib:font-ascent font) (xlib:font-descent font)))) ! #+unicode (defmethod text-style-height (text-style (medium clx-medium)) (let ((fontset (text-style-to-X-fontset (port medium) text-style))) (fontset-height fontset))) ! #-unicode (defmethod text-style-character-width (text-style (medium clx-medium) char) (xlib:char-width (text-style-to-X-font (port medium) text-style) (char-code char))) ! #+unicode (defmethod text-style-character-width (text-style (medium clx-medium) char) (fontset-point-width (char-code char) (text-style-to-X-fontset (port medium) text-style))) (defmethod text-style-width (text-style (medium clx-medium)) (text-style-character-width text-style medium #\m)) ! #-unicode (defun translate (src src-start src-end afont dst dst-start) ;; This is for replacing the clx-translate-default-function ;; who does'nt know about accentated characters because --- 608,655 ---- ;;; ;;; Methods for text styles ! #-(and allegro unicode) (defmethod text-style-ascent (text-style (medium clx-medium)) (let ((font (text-style-to-X-font (port medium) text-style))) (xlib:font-ascent font))) ! #+(and allegro unicode) (defmethod text-style-ascent (text-style (medium clx-medium)) (let ((fontset (text-style-to-X-fontset (port medium) text-style))) (fontset-ascent fontset))) ! #-(and allegro unicode) (defmethod text-style-descent (text-style (medium clx-medium)) (let ((font (text-style-to-X-font (port medium) text-style))) (xlib:font-descent font))) ! #+(and allegro unicode) (defmethod text-style-descent (text-style (medium clx-medium)) (let ((fontset (text-style-to-X-fontset (port medium) text-style))) (fontset-descent fontset))) ! #-(and allegro unicode) (defmethod text-style-height (text-style (medium clx-medium)) (let ((font (text-style-to-X-font (port medium) text-style))) (+ (xlib:font-ascent font) (xlib:font-descent font)))) ! #+(and allegro unicode) (defmethod text-style-height (text-style (medium clx-medium)) (let ((fontset (text-style-to-X-fontset (port medium) text-style))) (fontset-height fontset))) ! #-(and allegro unicode) (defmethod text-style-character-width (text-style (medium clx-medium) char) (xlib:char-width (text-style-to-X-font (port medium) text-style) (char-code char))) ! #+(and allegro unicode) (defmethod text-style-character-width (text-style (medium clx-medium) char) (fontset-point-width (char-code char) (text-style-to-X-fontset (port medium) text-style))) (defmethod text-style-width (text-style (medium clx-medium)) (text-style-character-width text-style medium #\m)) ! #-(and allegro unicode) (defun translate (src src-start src-end afont dst dst-start) ;; This is for replacing the clx-translate-default-function ;; who does'nt know about accentated characters because *************** *** 694,700 **** ; It's just a proof of concept, I'll try not to commit it :] ; If it does get committed, it shouldn't affect anyone much... ! #+unicode (defun translate (source source-start source-end initial-font destination destination-start) ; do the first character especially (let* ((code (char-code (char source source-start))) --- 694,700 ---- ; It's just a proof of concept, I'll try not to commit it :] ; If it does get committed, it shouldn't affect anyone much... ! #+(and allegro unicode) (defun translate (source source-start source-end initial-font destination destination-start) ; do the first character especially (let* ((code (char-code (char source source-start))) *************** *** 724,737 **** (return (values src nil)))))))))) (values source-start nil)))) ! #+unicode (in-package :external-format) ! #+unicode (defun ascii-code-to-font-index (code) (values code (<= #x00 code #x7f))) ! #+unicode (defun ksc5601-code-to-font-index (wc) (labels ((illegal-sequence () (error "ksc5601-wctomb")) --- 724,737 ---- (return (values src nil)))))))))) (values source-start nil)))) ! #+(and allegro unicode) (in-package :external-format) ! #+(and allegro unicode) (defun ascii-code-to-font-index (code) (values code (<= #x00 code #x7f))) ! #+(and allegro unicode) (defun ksc5601-code-to-font-index (wc) (labels ((illegal-sequence () (error "ksc5601-wctomb")) *************** *** 768,777 **** c) (illegal-sequence)))))) ! #+unicode (in-package :clim-clx) ! #-unicode (defmethod text-size ((medium clx-medium) string &key text-style (start 0) end) (when (characterp string) (setf string (make-string 1 :initial-element string))) --- 768,777 ---- c) (illegal-sequence)))))) ! #+(and allegro unicode) (in-package :clim-clx) ! #-(and allegro unicode) (defmethod text-size ((medium clx-medium) string &key text-style (start 0) end) (when (characterp string) (setf string (make-string 1 :initial-element string))) *************** *** 809,815 **** direction first-not-done)) (values width (+ ascent descent) width 0 ascent)) )))))) ) ! #+unicode (defmethod text-size ((medium clx-medium) string &key text-style (start 0) end) (when (characterp string) (setf string (make-string 1 :initial-element string))) --- 809,815 ---- direction first-not-done)) (values width (+ ascent descent) width 0 ascent)) )))))) ) ! #+(and allegro unicode) (defmethod text-size ((medium clx-medium) string &key text-style (start 0) end) (when (characterp string) (setf string (make-string 1 :initial-element string))) *************** *** 850,856 **** direction first-not-done)) (values width (+ ascent descent) width 0 ascent)) )))))) ) ! #-unicode (defmethod medium-draw-text* ((medium clx-medium) string x y start end align-x align-y --- 850,856 ---- direction first-not-done)) (values width (+ ascent descent) width 0 ascent)) )))))) ) ! #-(and allegro unicode) (defmethod medium-draw-text* ((medium clx-medium) string x y start end align-x align-y *************** *** 884,890 **** :start start :end end :translate #'translate))))))) ! #+unicode (defmethod medium-draw-text* ((medium clx-medium) string x y start end align-x align-y --- 884,890 ---- :start start :end end :translate #'translate))))))) ! #+(and allegro unicode) (defmethod medium-draw-text* ((medium clx-medium) string x y start end align-x align-y diff -r -c3 mcclim.orig/Backends/CLX/port.lisp mcclim/Backends/CLX/port.lisp *** mcclim.orig/Backends/CLX/port.lisp 2004-12-11 22:15:22.000000000 +0100 --- mcclim/Backends/CLX/port.lisp 2004-12-18 11:41:47.000000000 +0100 *************** *** 893,899 **** (defvar *fontset* nil) ! #-unicode (defmethod text-style-mapping ((port clx-port) text-style &optional character-set) (declare (ignore character-set)) --- 893,899 ---- (defvar *fontset* nil) ! #-(and allegro unicode) (defmethod text-style-mapping ((port clx-port) text-style &optional character-set) (declare (ignore character-set)) *************** *** 928,934 **** (open-font (clx-port-display port) font-name))) font-name)))))) ! #+unicode (defun build-english-font-name (text-style) (multiple-value-bind (family face size language) (text-style-components text-style) --- 928,934 ---- (open-font (clx-port-display port) font-name))) font-name)))))) ! #+(and allegro unicode) (defun build-english-font-name (text-style) (multiple-value-bind (family face size language) (text-style-components text-style) *************** *** 955,961 **** family-name face-name size-number))) font-name)))) ! #+unicode (defun build-korean-font-name (text-style) (multiple-value-bind (family face size language) (text-style-components text-style) --- 955,961 ---- family-name face-name size-number))) font-name)))) ! #+(and allegro unicode) (defun build-korean-font-name (text-style) (multiple-value-bind (family face size language) (text-style-components text-style) *************** *** 986,992 **** (format nil "-~A-*-*-~D-*-*-*-*-*-ksx1001.1997-*" font size-number)))) ; this needs much refactoring... FIXME ! #+unicode (defmethod text-style-mapping ((port clx-port) text-style &optional character-set) (declare (ignore character-set)) --- 986,992 ---- (format nil "-~A-*-*-~D-*-*-*-*-*-ksx1001.1997-*" font size-number)))) ; this needs much refactoring... FIXME ! #+(and allegro unicode) (defmethod text-style-mapping ((port clx-port) text-style &optional character-set) (declare (ignore character-set)) *************** *** 1026,1059 **** (cons font-name (open-font (clx-port-display port) font-name))) font-name) ! #-unicode (defun text-style-to-X-font (port text-style) (let ((text-style (parse-text-style text-style))) (text-style-mapping port text-style) (cdr (gethash text-style (port-text-style-mappings port))))) ! #+unicode (defun text-style-to-X-fontset (port text-style) (let ((text-style (parse-text-style text-style))) (text-style-mapping port text-style) (cdr (gethash text-style (port-text-style-mappings port))))) ! #-unicode (defmethod port-character-width ((port clx-port) text-style char) (let* ((font (text-style-to-X-font port text-style)) (width (xlib:char-width font (char-code char)))) width)) ! #+unicode (defmethod port-character-width ((port clx-port) text-style char) (fontset-point-width (char-code char) (text-style-to-X-fontset port text-style))) ! #-unicode (defmethod port-string-width ((port clx-port) text-style string &key (start 0) end) (xlib:text-width (text-style-to-X-font port text-style) string :start start :end end)) ! #+unicode ; this requires a translator and so on. (defmethod port-string-width ((port clx-port) text-style string &key (start 0) end) (let ((*fontset* (text-style-to-X-fontset port text-style))) (xlib:text-width nil string :start start :end end :translator #'translate))) --- 1026,1059 ---- (cons font-name (open-font (clx-port-display port) font-name))) font-name) ! #-(and allegro unicode) (defun text-style-to-X-font (port text-style) (let ((text-style (parse-text-style text-style))) (text-style-mapping port text-style) (cdr (gethash text-style (port-text-style-mappings port))))) ! #+(and allegro unicode) (defun text-style-to-X-fontset (port text-style) (let ((text-style (parse-text-style text-style))) (text-style-mapping port text-style) (cdr (gethash text-style (port-text-style-mappings port))))) ! #-(and allegro unicode) (defmethod port-character-width ((port clx-port) text-style char) (let* ((font (text-style-to-X-font port text-style)) (width (xlib:char-width font (char-code char)))) width)) ! #+(and allegro unicode) (defmethod port-character-width ((port clx-port) text-style char) (fontset-point-width (char-code char) (text-style-to-X-fontset port text-style))) ! #-(and allegro unicode) (defmethod port-string-width ((port clx-port) text-style string &key (start 0) end) (xlib:text-width (text-style-to-X-font port text-style) string :start start :end end)) ! #+(and allegro unicode) ; this requires a translator and so on. (defmethod port-string-width ((port clx-port) text-style string &key (start 0) end) (let ((*fontset* (text-style-to-X-fontset port text-style))) (xlib:text-width nil string :start start :end end :translator #'translate)))

1 0

[mcclim-devel] Troubles compiling McCLIM with Allegro CL 7.0
by Friedrich Dominicus 15 Dec '04

15 Dec '04

Dear Mcclim Developers I encountered the following problem while trying to compile mcclim with Allegro CL 7.0 on a Debian box Warning: Variable DEFAULT-TYPE is never used. ; While compiling COM-QUERY-EXIT%ACCEPTOR%0: Error: We don't yet handle ignore of #'EAT-DELIMITER-OR-ACTIVATOR. [condition type: SIMPLE-ERROR] Restart actions (select using :continue): 0: retry the compilation of /home/frido/tests/mcclim/dialog.lisp 1: continue compiling /home/frido/tests/mcclim/dialog.lisp but generate no output file 2: Retry performing #<ASDF:COMPILE-OP NIL @ #x7144473a> on #<ASDF:CL-SOURCE-FILE "dialog" @ #x712af57a>. 3: Continue, treating #<ASDF:COMPILE-OP NIL @ #x7144473a> on #<ASDF:CL-SOURCE-FILE "dialog" @ #x712af57a> as having been successful. 4: Return to Debug Level 1 (an "abort" restart). 5: Try calling TOP-LEVEL::CD again. 6: Return a value instead of calling TOP-LEVEL::CD. 7: Try calling a function other than TOP-LEVEL::CD. 8: Setf the symbol-function of TOP-LEVEL::CD and call it again. 9: Return to Top Level (an "abort" restart). 10: Abort entirely from this (lisp) process. [changing package from "COMMON-LISP-USER" to "CLIM-INTERNALS"] [2] CLIMI(11): Does anyone have tried to compile mcclim with Allegro successfully? Regards Friedrich

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-devel December 2004