Commit 1d085aaf authored by layer's avatar layer

join from acl62 branch onto trunk

parent ae705bba
This diff is collapsed.
# $Header: /repo/cvs.copy/clim2/Makefile,v 1.90 2000/07/17 19:59:05 layer Exp $
# $Header: /repo/cvs.copy/clim2/Makefile,v 1.91 2002/07/09 20:57:14 layer Exp $
# If ../makefile.top doesn't exist, then you must specify HOST=xxx on the
# `make' command line.
......@@ -28,9 +28,17 @@ ifeq ($(OS_NAME),freebsd)
HOST = freebsd
endif
ifeq ($(OS_NAME),darwin)
HOST = macosx
endif
ifeq ($(OS_NAME),hp-ux)
ifeq ($(SIXTYFOURBIT),yes)
HOST = hp64
else
HOST = hpprism
endif
endif
ifeq ($(OS_NAME),irix)
HOST = sgi4d-svr4
......
# $Header: /repo/cvs.copy/clim2/Makefile.alpha,v 1.9 2000/03/04 05:13:48 duane Exp $
# $Header: /repo/cvs.copy/clim2/Makefile.alpha,v 1.10 2002/07/09 20:57:14 layer Exp $
#
# Makefile.alpha for CLIM 2.0
......@@ -27,9 +27,9 @@ PICFLAGS =
SHAREFLAGS =
ifeq ($(SIXTYFOURBIT),yes)
MAKE_SHARED = ../src/bin/make_shared.dec64
MAKE_SHARED = sh ../src/bin/make_shared.dec64
else
MAKE_SHARED = ../src/bin/make_shared.dec
MAKE_SHARED = sh ../src/bin/make_shared.dec
endif
include Makefile.generic
# $Header: /repo/cvs.copy/clim2/Makefile.cobjs,v 1.19 1998/03/18 20:27:52 layer Exp $
# $Header: /repo/cvs.copy/clim2/Makefile.cobjs,v 1.20 2002/07/09 20:57:14 layer Exp $
#
# Makefile.cobj for CLIM 2.0
#
......@@ -6,27 +6,27 @@
# stub files - identify the required definitions from Xm,Ol,Xt,X11
stub-motif.c: $(XMC_UNDEFS) $(XM_UNDEFS) misc/make-stub-file misc/make-stub-file1
misc/make-stub-file "void ___lisp_load_motif_stub ()" \
sh misc/make-stub-file "void ___lisp_load_motif_stub ()" \
$(XM_UNDEFS) > stub-motif.c
misc/make-stub-file1 "void ___lisp_load_motif_stub_vars ()" \
sh misc/make-stub-file1 "void ___lisp_load_motif_stub_vars ()" \
$(XMC_UNDEFS) >> stub-motif.c
stub-olit.c: $(OLC_UNDEFS) $(OL_UNDEFS) misc/make-stub-file misc/make-stub-file1
misc/make-stub-file "void ___lisp_load_olit_stub ()" \
sh misc/make-stub-file "void ___lisp_load_olit_stub ()" \
$(OL_UNDEFS) > stub-olit.c
misc/make-stub-file1 "void ___lisp_load_olit_stub_vars ()" \
sh misc/make-stub-file1 "void ___lisp_load_olit_stub_vars ()" \
$(OLC_UNDEFS) >> stub-olit.c
stub-xt.c: $(XT_UNDEFS) misc/make-stub-file
misc/make-stub-file "void ___lisp_load_xt_stub ()" \
sh misc/make-stub-file "void ___lisp_load_xt_stub ()" \
$(XT_UNDEFS) > stub-xt.c
stub-x.c: $(UNDEFS) misc/make-stub-file
misc/make-stub-file "void ___lisp_load_x_stub ()" \
sh misc/make-stub-file "void ___lisp_load_x_stub ()" \
$(UNDEFS) > stub-x.c
stub-wnn.c: $(WNN_UNDEFS) misc/make-stub-file
misc/make-stub-file "void ___lisp_load_wnn_stub ()" \
sh misc/make-stub-file "void ___lisp_load_wnn_stub ()" \
$(WNN_UNDEFS) > stub-wnn.c
# support files - CLIM's C source files
......
# $Id: Makefile.freebsd,v 1.3 1999/05/04 01:20:59 layer Exp $
# $Id: Makefile.freebsd,v 1.4 2002/07/09 20:57:14 layer Exp $
include Makefile.defs
......@@ -6,7 +6,7 @@ Makefile=Makefile.freebsd
XINCLUDES=-I/usr/X11R6/include -I /usr/local/include
TKLIB=-lXm -lXpm -lXext
TKLIB=-lXm -lXpm -lXext -lXp
XTLIB=-lXt -lSM -lICE
XLIB=-lX11
......
# $Id: Makefile.generic,v 1.52 2000/07/06 20:43:09 layer Exp $
# $Id: Makefile.generic,v 1.53 2002/07/09 20:57:14 layer Exp $
# Makefile.generic for CLIM 2.0
all: compile cat # $(CLIM)
......@@ -176,7 +176,7 @@ cleanfasls: FORCE
find . -name '*.fasl' -print | xargs rm -f
clean:
rm -f *.out
rm -f *.out *.tmp
find . -name '*.fasl' -print | xargs rm -f
rm -f *.o *.$(SHARED_EXT) *.a slim \
stub-motif.c stub-olit.c stub-xt.c stub-x.c stub-wnn.c
......
# $Header: /repo/cvs.copy/clim2/Makefile.hp64,v 1.2 2002/07/09 20:57:14 layer Exp $
#
# Makefile.hpprism for CLIM 2.0
#
include Makefile.defs
Makefile=Makefile.hp64
SET_LIBRARY_PATH = \
LD_LIBRARY_PATH=/usr/lib/pa20_64:/lib:/usr/lib:$(LD_LIBRARY_PATH); export LD_LIBRARY_PATH
STD_DEFINES = -DSYSV
AR = ar clq
#TKLIB=-lXm
TKLIB=/usr/lib/pa20_64/libXm.4 /usr/lib/pa20_64/libXp.2 /usr/lib/pa20_64/libXext.3
XTLIB=/usr/lib/pa20_64/libXt.3 /usr/lib/pa20_64/libSM.2 /usr/lib/pa20_64/libICE.2
XLIB=/usr/lib/pa20_64/libX11.3
XINCLUDES=
CC= /usr/bin/cc
CFLAGS= -O -Ae +DA2.0W -DAcl64Bit
MOTIFXTRAS=-lc
PICFLAGS = +Z
SHAREFLAGS =
MAKE_SHARED = ld -b +s
PRODUCT-OBJS= $(PRODUCT-GENERIC-OBJS) $(STATIC-XM-OBJS) $(SHARED-XM-OBJS)
include Makefile.generic
# $Header: /repo/cvs.copy/clim2/Makefile.hpprism,v 1.18 2000/07/17 19:59:05 layer Exp $
# $Header: /repo/cvs.copy/clim2/Makefile.hpprism,v 1.19 2002/07/09 20:57:14 layer Exp $
#
# Makefile.hpprism for CLIM 2.0
#
......@@ -27,6 +27,7 @@ XLIB=-lX11
XINCLUDES=
CC= /usr/bin/cc
CFLAGS= -O -Ae +DA1.1
MOTIFXTRAS=-lc
PICFLAGS = +Z
......
# $Id: Makefile.linux,v 1.2 1998/08/06 23:15:36 layer Exp $
# $Id: Makefile.linux,v 1.3 2002/07/09 20:57:14 layer Exp $
include Makefile.defs
......@@ -6,7 +6,7 @@ Makefile=Makefile.linux
XINCLUDES=-I/usr/X11R6/include
TKLIB=-lXm -lXpm -lXext
TKLIB=-lXm -lXpm -lXext -lXp
XTLIB=-lXt
XLIB=-lX11
......
# $Id: Makefile.linuxppc,v 1.2 1999/02/25 08:23:21 layer Exp $
# $Id: Makefile.linuxppc,v 1.3 2002/07/09 20:57:14 layer Exp $
include Makefile.defs
......@@ -6,7 +6,7 @@ Makefile=Makefile.linuxppc
XINCLUDES=-I/usr/X11R6/include
TKLIB=-lXm -lXpm -lXext
TKLIB=-lXm -lXpm -lXext -lXp
XTLIB=-lXt -lSM -lICE
XLIB=-lX11
......
# $Header: /repo/cvs.copy/clim2/Makefile.macosx,v 1.2 2002/07/09 20:57:14 layer Exp $
#
# Makefile.macosx for CLIM 2.0
#
include Makefile.defs
SHARED_EXT = dylib
SHARED-XM-OBJS= climxm.dylib
SHARED-OL-OBJS= climol.dylib
Makefile=Makefile.macosx
SET_LIBRARY_PATH = \
DYLD_LIBRARY_PATH=/usr/local/lib:/usr/X11R6/lib:/lib:/usr/lib:$(DYLD_LIBRARY_PATH); export DYLD_LIBRARY_PATH
#CL=../src/xm-dcl
TKLIB=-lXm
XTLIB=-L/usr/X11R6/lib -lXt
XLIB=-L/usr/X11R6/lib -lX11 /usr/local/lib/liblanginfo.a
XINCLUDES=-I/usr/X11R6/include
CFLAGS=
PICFLAGS =
SHAREFLAGS =
MAKE_SHARED = sh ../src/bin/make_shared.mac
AR = ar cq
PRODUCT-OBJS= $(PRODUCT-GENERIC-OBJS) $(STATIC-XM-OBJS) $(SHARED-XM-OBJS)
IMPORTS = stub-x.o stub-xt.o stub-motif.o
include Makefile.generic
# $Header: /repo/cvs.copy/clim2/Makefile.rs6000,v 1.12 1999/05/04 01:20:59 layer Exp $
# $Header: /repo/cvs.copy/clim2/Makefile.rs6000,v 1.13 2002/07/09 20:57:14 layer Exp $
#
# Makefile.rs6000 for CLIM 2.0
#
......@@ -7,17 +7,41 @@ include Makefile.defs
Makefile=Makefile.rs6000
CFLAGS = -O -D_BSD # -D_NO_PROTO -D_NONSTD_TYPES -D_MBI=void
## For info on Motif1.2 vs Motif 2.1, see /usr/lpp/X11/README
##
CFLAGS = -O -D_BSD -I/usr/include/Motif1.2 /usr/lpp/X11/lib/R6/Motif1.2/Xm12.imp /usr/lpp/X11/lib/R6/Motif1.2/Mrm12.imp
### the R5 directory contains Motif 1.2 on loveshaq
### -- what a botch. Can't use the latest X11 just because we want
### to use an older Motif! How I love AIX.... not!
SET_LIBRARY_PATH= \
LIBPATH=/usr/lpp/X11/lib/R5:/lib:/usr/lib; export LIBPATH; env
TKLIB=-L/usr/lpp/X11/lib/R5 -lXm
## removed: -D_NO_PROTO -D_NONSTD_TYPES -D_MBI=void
#CFLAGS = -O -D_BSD
# -I/usr/include/Motif1.2
# /usr/lpp/X11/lib/R6/Motif1.2/Xm12.imp
# /usr/lpp/X11/lib/R6/Motif1.2/Mrm12.imp
### the R5 directory contains Motif 1.2 on loveshaq
### -- what a botch. Can't use the latest X11 just because we want
### to use an older Motif! How I love AIX.... not!
#SET_LIBRARY_PATH= \
# LIBPATH=/usr/lpp/X11/lib/R5:/lib:/usr/lib; export LIBPATH; env
#TKLIB=-L/usr/lpp/X11/lib/R5 -lXm
TKLIB=-lXm
XTLIB=-lXt
XLIB=-lX11
XINCLUDES= -I/usr/include
XINCLUDES= -I/usr/include/Motif1.2 /usr/lpp/X11/lib/R6/Motif1.2/Xm12.imp
PRODUCT-OBJS= $(PRODUCT-GENERIC-OBJS) $(STATIC-XM-OBJS) $(SHARED-XM-OBJS)
MAKE_SHARED = ../src/bin/make_shared.ibm -make_exp ../src/bin/make_exp
STD_DEFINES = -DSYSV -DAIXV3
MAKE_SHARED = sh ../src/bin/make_shared.ibm -make_exp ../src/bin/make_exp
STD_DEFINES =
AR = ar clq
# This should be defined in make-dist. For CLIM devel (ie making
......
# $Id: Makefile.sun4-svr4,v 1.19 2000/06/26 17:42:07 layer Exp $
# $Id: Makefile.sun4-svr4,v 1.20 2002/07/09 20:57:14 layer Exp $
#
# Makefile.sun4-svr4 for CLIM 2.0
#
......@@ -14,18 +14,26 @@ Makefile=Makefile.sun4-svr4
XINCLUDES=-I/usr/openwin/include -I/usr/dt/include
# on sol7 and later -lXm is motif 2, and we need 1.x.
#TKLIB=-lXm
TKLIB=/usr/dt/lib/libXm.so.3
## Let's try it again, anyway, since sparc64 has no 1.x:
TKLIB=-lXm
#TKLIB=/usr/dt/lib/libXm.so.3
XTLIB=-lXt
XLIB=-lX11
ifeq ($(SIXTYFOURBIT),yes)
CFLAGS = -xarch=v9 -DAcl64Bit
SET_LIBRARY_PATH= \
LD_LIBRARY_PATH=/usr/lib/sparcv9; export LD_LIBRARY_PATH
else
SET_LIBRARY_PATH= \
LD_LIBRARY_PATH=/usr/dt/lib:/usr/openwin/lib:/usr/lib; export LD_LIBRARY_PATH
endif
# for other Motif versions use
# /net/sole/opt/ICS/Motif1.2.4/usr/lib:/usr/lib
# /net/vapor/3rd/motif-1.2.2-sol2/ICS/Motif/usr/lib:/usr/lib
PRODUCT-OBJS= $(PRODUCT-GENERIC-OBJS) $(STATIC-XM-OBJS) $(SHARED-XM-OBJS)
# from here on this file should be the same as Makefile.sun4-svr4-ol
......
# $Header: /repo/cvs.copy/clim2/Makefile.wnn,v 1.7 2000/06/13 14:26:04 layer Exp $
# $Header: /repo/cvs.copy/clim2/Makefile.wnn,v 1.8 2002/07/09 20:57:14 layer Exp $
#
# Makefile.wnn for CLIM 2.0
#
......@@ -79,9 +79,11 @@ ifeq ($(REDHAT),6)
REDHATLIBS = -lcrypt
endif
ifeq ($(OS_NAME),linux)
ifeq ($(MACHINE),ppc)
REDHATLIBS = -lcrypt
endif
endif
ifeq ($(OS_NAME),freebsd)
REDHATLIBS = -lcrypt
......
......@@ -13,4 +13,4 @@ developers or documentation.
************* add new entries below this line *********************************
1. rfe/bug# description....
7. [bug/rfe#] ...
......@@ -107,3 +107,48 @@ rfe4169: items 1-5
On Windows the names exist but the functions are not called.
6. bug9206, bug9207, bug9208.
On HP systems, creation of various motif widgets -- such as
dialog boxes resulting from calls to accepting-values -- can cause
errors because fontsets can not be created, with an immediately
preceding warning that the charset HP-ROMAN8 is missing when trying to
create the fontset. This should happen only when running CLIM in
an international Lisp, on an HP machine with the X display on a non-HP
machine.
The reason for this is that HP's default locales seem to specify that the
HP-ROMAN8 codeset must be available in X. For non-HP X servers it
typically is not available, and thus this error occurs.
There are two solutions (apart from displaying on an HP X server):
A. Run Lisp in a locale which does not require the HP-ROMAN8 codeset.
HP provide such several locales which have names like <x>.iso88591. So,
for instance, rather than using the C locale, you should be able to use
the C.iso88591 locale.
You can find out which locale you are in by issuing the `locale' shell
command.
You can list all available locales by issuing the `locale -a' command.
You can set the current locale for Lisp either by setting the LANG
environment variable before running Lisp:
Bourne shell:
LANG=C.iso88591; export LANG; mlisp
C shell:
setenv LANG C.iso88591; mlisp
or by running Lisp with the -locale switch:
mlisp -locale C.iso88591
B. Make the hp-roman8-encoded fonts available to the X server.
This could be done by running a funt server on the HP machine, or by
physically copying the fonts from the HP machine to the machine with
the X server. The details of how to do this are not covered here.
This diff is collapsed.
;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*-
;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca.
;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved.
;; copyright (c) 1986-2002 Franz Inc, Berkeley, CA - All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc. They are
......@@ -16,7 +16,7 @@
;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;;
;; $Id: acl-dc.lisp,v 1.11 2000/05/01 21:43:20 layer Exp $
;; $Id: acl-dc.lisp,v 1.12 2002/07/09 20:57:14 layer Exp $
#|****************************************************************************
* *
......@@ -30,21 +30,6 @@
(in-package :acl-clim)
(defvar *current-window*)
(defvar *dc-initialized* nil)
;;; Stock objects
(defvar *null-pen*)
(defvar *black-pen*)
(defvar *ltgray-pen*)
(defvar *null-brush*)
(defvar *black-brush*)
(defvar *ltgray-brush*)
(defvar *blank-image*)
(defvar *ltgray-image*)
(defvar *background-brush* nil)
;; This is not just any 75% gray. There are
;; methods to treat this object specially and
;; use COLOR_BTNFACE as the realization of this ink.
......
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*-
;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca.
;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved.
;; copyright (c) 1986-2002 Franz Inc, Berkeley, CA - All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc. They are
......@@ -16,7 +16,7 @@
;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;;
;; $Id: acl-frames.lisp,v 1.12 2000/05/01 21:43:20 layer Exp $
;; $Id: acl-frames.lisp,v 1.13 2002/07/09 20:57:14 layer Exp $
#|****************************************************************************
* *
......@@ -900,7 +900,8 @@ to be run from another."
tick alist submenus)))
(clim-internals::menu-item-items item)))
(progn
(push (list tick (menu-item-value item))
(push (list tick (menu-item-value item)
item) ;; spr25894 -- Third item is the menu-item itself
alist)
(excl:with-native-string (p-i (print-item item))
......@@ -1031,7 +1032,7 @@ to be run from another."
*scratch-c-string*))
(defun scratch-c-string-to-lisp-string ()
(ff:char*-to-string *scratch-c-string*))
(values (excl:native-to-string *scratch-c-string*)))
(defun pathnames-from-directory-and-filenames (filename-list)
;; Takes a list consisting of a directory namestring followed
......@@ -1631,7 +1632,7 @@ in a second Lisp process. This frame cannot be reused."
(excl:with-native-string (cstr filename)
(setf (ct:cref win:docinfo docinfo lpszDocName) cstr))
(setf (ct:cref win:docinfo docinfo lpszDocName)
(ff:string-to-char* filename))
(excl:string-to-native filename))
(setf (ct:cref win:docinfo docinfo lpszOutput) 0)
(setf (ct:cref win:docinfo docinfo lpszDatatype) 0)
(setf (ct:cref win:docinfo docinfo fwType) 0)
......@@ -1685,7 +1686,7 @@ in a second Lisp process. This frame cannot be reused."
(excl:with-native-string (cstr filename)
(setf (ct:cref win:docinfo docinfo lpszDocName) cstr))
(setf (ct:cref win:docinfo docinfo lpszDocName)
(ff:string-to-char* filename))
(excl:string-to-native filename))
(setf (ct:cref win:docinfo docinfo lpszOutput) 0)
(setf (ct:cref win:docinfo docinfo lpszDatatype) 0)
(setf (ct:cref win:docinfo docinfo fwType) 0)
......
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*-
;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca.
;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved.
;; copyright (c) 1986-2002 Franz Inc, Berkeley, CA - All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc. They are
......@@ -16,7 +16,7 @@
;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;;
;; $Id: acl-medium.lisp,v 1.13 2000/05/01 21:43:20 layer Exp $
;; $Id: acl-medium.lisp,v 1.14 2002/07/09 20:57:14 layer Exp $
#|****************************************************************************
* *
......
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*-
;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca.
;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved.
;; copyright (c) 1986-2002 Franz Inc, Berkeley, CA - All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc. They are
......@@ -16,7 +16,7 @@
;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;;
;; $Id: acl-mirror.lisp,v 1.11 2000/05/01 21:43:20 layer Exp $
;; $Id: acl-mirror.lisp,v 1.12 2002/07/09 20:57:14 layer Exp $
#|****************************************************************************
* *
......
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*-
;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca.
;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved.
;; copyright (c) 1986-2002 Franz Inc, Berkeley, CA - All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc. They are
......@@ -16,7 +16,7 @@
;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;;
;; $Id: acl-pixmaps.lisp,v 1.8 2000/05/01 21:43:20 layer Exp $
;; $Id: acl-pixmaps.lisp,v 1.9 2002/07/09 20:57:14 layer Exp $
#|****************************************************************************
* *
......
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: ACL-CLIM; Base: 10; Lowercase: Yes -*-
;; copyright (c) 1985,1986 Franz Inc, Alameda, Ca.
;; copyright (c) 1986-1998 Franz Inc, Berkeley, CA - All rights reserved.
;; copyright (c) 1986-2002 Franz Inc, Berkeley, CA - All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc. They are
......@@ -16,7 +16,7 @@
;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;;
;; $Id: acl-port.lisp,v 1.12 2000/05/01 21:43:20 layer Exp $
;; $Id: acl-port.lisp,v 1.13 2002/07/09 20:57:14 layer Exp $
#|****************************************************************************
* *
......@@ -322,6 +322,13 @@
(setq *port-mirror-sheet-alist* nil)
(setf *acl-port* nil))))
(defmethod destroy-port :after ((port acl-port))
;; spr25546
;; See documentation for the :before method above.
;; Do this as an :after method to avoid collisions during
;; other clean-up operations.
(reset-aclpc-clim))
(defstruct (acl-font)
index
height
......@@ -512,6 +519,61 @@
(let ((name (silica::device-font-name style)))
(make-device-font (win:GetStockObject name)))))))
(defmethod (setf text-style-mapping) (mapping (port acl-port) (style list)
&optional charset etc)
(setf (text-style-mapping port (apply #'make-text-style style)
charset etc) mapping))
(defmethod (setf text-style-mapping) (mapping (port acl-port)
(style text-style)
&optional charset etc)
(declare (ignore charset etc))
(when (listp mapping)
(assert (eq (first mapping) :style) ()
"Text style mappings must be atomic font names ~
or (:style . (family face size))")
(setf mapping (parse-text-style (cdr mapping))))
;; I wonder if this is right
(setf (gethash style (slot-value port 'text-style->acl-font-mapping))
(typecase mapping
(string
(make-windows-font-named mapping
:size (text-style-size style)
:face (text-style-face style)
:port port))
(t mapping))))
(defun make-windows-font-named (name &key (size ':normal)
(face ':roman)
(port (find-port)))
;; This is a simplified user wrapper around MAKE-WINDOWS-FONT
(let ((point-size (or (etypecase size
(real size)
(symbol (second (assoc (or size ':normal)
*acl-logical-size-alist*))))
(progn
(warn "~S does not specify a size, using :normal"
size)
(second (assoc ':normal
*acl-logical-size-alist*))))))
(multiple-value-bind (weight italic)
(etypecase face
(cons
(values (if (member ':bold face) win:FW_BOLD win:FW_NORMAL)
(member ':italic face)))
(symbol
(case face
(:roman (values win:FW_NORMAL nil))
(:bold (values win:FW_BOLD nil))
(:italic (values win:FW_NORMAL t))
;; ?? this default, but see text-style-mapping-1
(otherwise (values win:FW_BOLD nil)))))
(make-windows-font
(- (round (* point-size (slot-value port 'logpixelsy)) 72))
:weight weight
:italic italic
:face name))))
(defun make-font-width-table (dc last-character first-character default-width)
(let* ((tepsize (ct:ccallocate win:size))
(string (make-string 1) )
......@@ -850,6 +912,19 @@
(logior state (make-modifier-state :double))
state)))
;;; SPR25900 --pnc
;;; Windows handles the meta/alt key differently from the
;;; other modifier keys. In particular, on mouse-keys, only
;;; information about the control and shift keys is included.
;;; So, we get the information about the meta/alt key from
;;; the variable *modstate*, set in onkeydown (in aclpc/acl-class.lisp)
(defun windows-mask->modifier-state+ (mask &optional double)
(let ((state (windows-mask->modifier-state mask double)))
(when (and *modstate*