# HG changeset patch # User cvs # Date 1186992407 -7200 # Node ID 78f53ef88e17c43c0d2eb30e77ffabe894bd3388 # Parent d8688acf4c5b757846c9b3add1d32dd4be0885aa Import from CVS: tag r20-4b5 diff -r d8688acf4c5b -r 78f53ef88e17 CHANGES-beta --- a/CHANGES-beta Mon Aug 13 10:05:53 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 10:06:47 2007 +0200 @@ -1,4 +1,11 @@ -*- indented-text -*- +to 20.4 beta5 "Anglo-Nubian" +-- CCL synched with Emacs 20.2 courtesy of Olivier Galibert +-- various updates from Hrvoje Niksic and Kyle Jones +-- MS Windows updates from Marc Paquette and Jonathon Harris +-- FAQ update courtesy of Andreas Kaempf +-- miscellaneous bug fixes + to 20.4 beta4 "American Cashmere" -- Major changes in portable dumping/Lisp_Object code courtesy of Kyle Jones -- Miscellaneous patches from Kyle Jones, Hrvoje Niksic diff -r d8688acf4c5b -r 78f53ef88e17 ChangeLog --- a/ChangeLog Mon Aug 13 10:05:53 2007 +0200 +++ b/ChangeLog Mon Aug 13 10:06:47 2007 +0200 @@ -1,3 +1,27 @@ +1997-11-13 Marc Paquette + + * nt/Todo: added a task for support of lisp packages through + the registry. + +1997-11-13 Jonathan Harris + + * Renamed files *w32* to *msw* + + * Changed 'w32' and 'win32' to 'mswindows', and HAVE_W32GUI to + HAVE_MS_WINDOWS. Changed files: + cus-edit.el, device.el, faces.el, frame.el, msw-faces.el, + msw.init.el, igrep.el, dumped-lisp.el, font.el, hippie-exp.el, + sysdep.el, console-msw.c, console-msw.h, console.c, + device-msw.c, emacs.c, event-msw.c, event-msw.h, event-stream.c, + events.c, events.h, faces.c, frame-msw.c, frame.c, general.c, + msw-proc.c, objects-msw.c, objects-msw.h, redisplay-msw.c, + redisplay.c, symsinit.h, + + * Didn't change 'win32' in nt.c, nt.h, ntproc.c + + * Deleted w32 build directory since nt build directory now handles + X and native mswindows builds. + 1997-11-10 SL Baur * info/dir: remove packaged entries. diff -r d8688acf4c5b -r 78f53ef88e17 configure --- a/configure Mon Aug 13 10:05:53 2007 +0200 +++ b/configure Mon Aug 13 10:06:47 2007 +0200 @@ -7580,64 +7580,21 @@ rm -f conftest* fi -echo $ac_n "checking whether the timezone variable is already declared""... $ac_c" 1>&6 -echo "configure:7585: checking whether the timezone variable is already declared" >&5 -cat > conftest.$ac_ext < -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif - -int main() { - - timezone = 0; - -; return 0; } -EOF -if { (eval echo configure:7607: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_TIMEZONE_DECL -EOF -cat >> confdefs.h <<\EOF -#define HAVE_TIMEZONE_DECL 1 -EOF -} - -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - echo "$ac_t""no" 1>&6 -fi -rm -f conftest* - - echo $ac_n "checking for inline""... $ac_c" 1>&6 -echo "configure:7629: checking for inline" >&5 +echo "configure:7586: checking for inline" >&5 ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:7598: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_inline=$ac_kw; break else @@ -7687,17 +7644,17 @@ # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6 -echo "configure:7691: checking for working alloca.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < int main() { char *p = alloca(2 * sizeof(int)); ; return 0; } EOF -if { (eval echo configure:7701: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7658: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_header_alloca_h=yes else @@ -7721,10 +7678,10 @@ fi echo $ac_n "checking for alloca""... $ac_c" 1>&6 -echo "configure:7725: checking for alloca" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7708: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_func_alloca_works=yes else @@ -7786,10 +7743,10 @@ echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6 -echo "configure:7790: checking whether alloca needs Cray hooks" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&6 -echo "configure:7817: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7800: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7869,10 +7826,10 @@ fi echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6 -echo "configure:7873: checking stack direction for C alloca" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7852: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_c_stack_direction=1 else @@ -7919,15 +7876,15 @@ ac_safe=`echo "vfork.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for vfork.h""... $ac_c" 1>&6 -echo "configure:7923: checking for vfork.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7931: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:7888: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -7955,10 +7912,10 @@ fi echo $ac_n "checking for working vfork""... $ac_c" 1>&6 -echo "configure:7959: checking for working vfork" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < @@ -8053,7 +8010,7 @@ } } EOF -if { (eval echo configure:8057: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8014: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_vfork_works=yes else @@ -8078,10 +8035,10 @@ echo $ac_n "checking for working strcoll""... $ac_c" 1>&6 -echo "configure:8082: checking for working strcoll" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main () @@ -8091,7 +8048,7 @@ strcoll ("123", "456") >= 0); } EOF -if { (eval echo configure:8095: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8052: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_strcoll_works=yes else @@ -8118,10 +8075,10 @@ for ac_func in getpgrp do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8122: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8105: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -8172,10 +8129,10 @@ done echo $ac_n "checking whether getpgrp takes no argument""... $ac_c" 1>&6 -echo "configure:8176: checking whether getpgrp takes no argument" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8191: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_getpgrp_void=yes else @@ -8256,10 +8213,10 @@ echo $ac_n "checking for working mmap""... $ac_c" 1>&6 -echo "configure:8260: checking for working mmap" >&5 +echo "configure:8217: checking for working mmap" >&5 case "$opsys" in ultrix* ) have_mmap=no ;; *) cat > conftest.$ac_ext < #include @@ -8292,7 +8249,7 @@ return 1; } EOF -if { (eval echo configure:8296: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8253: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then have_mmap=yes else @@ -8326,15 +8283,15 @@ ac_safe=`echo "termios.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for termios.h""... $ac_c" 1>&6 -echo "configure:8330: checking for termios.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8338: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8295: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8377,15 +8334,15 @@ echo "$ac_t""no" 1>&6 ac_safe=`echo "termio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for termio.h""... $ac_c" 1>&6 -echo "configure:8381: checking for termio.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8389: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8346: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8417,10 +8374,10 @@ echo $ac_n "checking for socket""... $ac_c" 1>&6 -echo "configure:8421: checking for socket" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8404: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_socket=yes" else @@ -8458,15 +8415,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "netinet/in.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for netinet/in.h""... $ac_c" 1>&6 -echo "configure:8462: checking for netinet/in.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8470: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8427: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8483,15 +8440,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "arpa/inet.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for arpa/inet.h""... $ac_c" 1>&6 -echo "configure:8487: checking for arpa/inet.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8495: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8452: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8516,9 +8473,9 @@ } echo $ac_n "checking "for sun_len member in struct sockaddr_un"""... $ac_c" 1>&6 -echo "configure:8520: checking "for sun_len member in struct sockaddr_un"" >&5 +echo "configure:8477: checking "for sun_len member in struct sockaddr_un"" >&5 cat > conftest.$ac_ext < @@ -8529,7 +8486,7 @@ static struct sockaddr_un x; x.sun_len = 1; ; return 0; } EOF -if { (eval echo configure:8533: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8490: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_SOCKADDR_SUN_LEN @@ -8560,10 +8517,10 @@ echo $ac_n "checking for msgget""... $ac_c" 1>&6 -echo "configure:8564: checking for msgget" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8547: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_msgget=yes" else @@ -8601,15 +8558,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "sys/ipc.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/ipc.h""... $ac_c" 1>&6 -echo "configure:8605: checking for sys/ipc.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8613: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8570: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8626,15 +8583,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "sys/msg.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/msg.h""... $ac_c" 1>&6 -echo "configure:8630: checking for sys/msg.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8638: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8595: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8672,15 +8629,15 @@ ac_safe=`echo "dirent.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dirent.h""... $ac_c" 1>&6 -echo "configure:8676: checking for dirent.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8684: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8641: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8707,15 +8664,15 @@ echo "$ac_t""no" 1>&6 ac_safe=`echo "sys/dir.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/dir.h""... $ac_c" 1>&6 -echo "configure:8711: checking for sys/dir.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8719: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8676: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8748,15 +8705,15 @@ ac_safe=`echo "nlist.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for nlist.h""... $ac_c" 1>&6 -echo "configure:8752: checking for nlist.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8760: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8717: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8786,7 +8743,7 @@ echo "checking "for sound support"" 1>&6 -echo "configure:8790: checking "for sound support"" >&5 +echo "configure:8747: checking "for sound support"" >&5 case "$with_sound" in native | both ) with_native_sound=yes;; nas | no ) with_native_sound=no;; @@ -8797,15 +8754,15 @@ if test -n "$native_sound_lib"; then ac_safe=`echo "multimedia/audio_device.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for multimedia/audio_device.h""... $ac_c" 1>&6 -echo "configure:8801: checking for multimedia/audio_device.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8809: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8766: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8853,12 +8810,12 @@ if test -z "$native_sound_lib"; then echo $ac_n "checking for ALopenport in -laudio""... $ac_c" 1>&6 -echo "configure:8857: checking for ALopenport in -laudio" >&5 +echo "configure:8814: checking for ALopenport in -laudio" >&5 ac_lib_var=`echo audio'_'ALopenport | sed 'y%./+-%__p_%'` xe_check_libs=" -laudio " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8830: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8900,12 +8857,12 @@ if test -z "$native_sound_lib"; then echo $ac_n "checking for AOpenAudio in -lAlib""... $ac_c" 1>&6 -echo "configure:8904: checking for AOpenAudio in -lAlib" >&5 +echo "configure:8861: checking for AOpenAudio in -lAlib" >&5 ac_lib_var=`echo Alib'_'AOpenAudio | sed 'y%./+-%__p_%'` xe_check_libs=" -lAlib " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8877: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8954,15 +8911,15 @@ for dir in "machine" "sys" "linux"; do ac_safe=`echo "${dir}/soundcard.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ${dir}/soundcard.h""... $ac_c" 1>&6 -echo "configure:8958: checking for ${dir}/soundcard.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8966: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8923: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9032,7 +8989,7 @@ fi libs_x="-laudio $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-laudio\" to \$libs_x"; fi cat > conftest.$ac_ext < EOF @@ -9059,7 +9016,7 @@ if test "$with_tty" = "yes" ; then echo "checking for TTY-related features" 1>&6 -echo "configure:9063: checking for TTY-related features" >&5 +echo "configure:9020: checking for TTY-related features" >&5 { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_TTY EOF @@ -9075,12 +9032,12 @@ if test -z "$with_ncurses"; then echo $ac_n "checking for tgetent in -lncurses""... $ac_c" 1>&6 -echo "configure:9079: checking for tgetent in -lncurses" >&5 +echo "configure:9036: checking for tgetent in -lncurses" >&5 ac_lib_var=`echo ncurses'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -lncurses " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9052: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9124,15 +9081,15 @@ ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:9128: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9136: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9093: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9154,15 +9111,15 @@ ac_safe=`echo "ncurses/term.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/term.h""... $ac_c" 1>&6 -echo "configure:9158: checking for ncurses/term.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9166: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9123: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9192,15 +9149,15 @@ c_switch_site="$c_switch_site -I/usr/include/ncurses" ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:9196: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9204: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9161: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9235,12 +9192,12 @@ for lib in curses termlib termcap; do echo $ac_n "checking for tgetent in -l$lib""... $ac_c" 1>&6 -echo "configure:9239: checking for tgetent in -l$lib" >&5 +echo "configure:9196: checking for tgetent in -l$lib" >&5 ac_lib_var=`echo $lib'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -l$lib " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9212: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9282,12 +9239,12 @@ else echo $ac_n "checking for tgetent in -lcurses""... $ac_c" 1>&6 -echo "configure:9286: checking for tgetent in -lcurses" >&5 +echo "configure:9243: checking for tgetent in -lcurses" >&5 ac_lib_var=`echo curses'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -lcurses " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9259: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9316,12 +9273,12 @@ else echo "$ac_t""no" 1>&6 echo $ac_n "checking for tgetent in -ltermcap""... $ac_c" 1>&6 -echo "configure:9320: checking for tgetent in -ltermcap" >&5 +echo "configure:9277: checking for tgetent in -ltermcap" >&5 ac_lib_var=`echo termcap'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -ltermcap " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9293: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9380,15 +9337,15 @@ test -z "$with_gpm" && { ac_safe=`echo "gpm.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for gpm.h""... $ac_c" 1>&6 -echo "configure:9384: checking for gpm.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9392: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9349: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9411,12 +9368,12 @@ } test -z "$with_gpm" && { echo $ac_n "checking for Gpm_Open in -lgpm""... $ac_c" 1>&6 -echo "configure:9415: checking for Gpm_Open in -lgpm" >&5 +echo "configure:9372: checking for Gpm_Open in -lgpm" >&5 ac_lib_var=`echo gpm'_'Gpm_Open | sed 'y%./+-%__p_%'` xe_check_libs=" -lgpm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9388: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9476,17 +9433,17 @@ echo "checking for database support" 1>&6 -echo "configure:9480: checking for database support" >&5 +echo "configure:9437: checking for database support" >&5 if test "$with_database_gnudbm" != "no"; then echo $ac_n "checking for dbm_open in -lgdbm""... $ac_c" 1>&6 -echo "configure:9485: checking for dbm_open in -lgdbm" >&5 +echo "configure:9442: checking for dbm_open in -lgdbm" >&5 ac_lib_var=`echo gdbm'_'dbm_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lgdbm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9458: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9519,10 +9476,10 @@ if test "$with_database_gnudbm" != "yes"; then echo $ac_n "checking for dbm_open""... $ac_c" 1>&6 -echo "configure:9523: checking for dbm_open" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9506: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbm_open=yes" else @@ -9581,10 +9538,10 @@ if test "$with_database_dbm" != "no"; then echo $ac_n "checking for dbm_open""... $ac_c" 1>&6 -echo "configure:9585: checking for dbm_open" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9568: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbm_open=yes" else @@ -9628,12 +9585,12 @@ if test "$need_libdbm" != "no"; then echo $ac_n "checking for dbm_open in -ldbm""... $ac_c" 1>&6 -echo "configure:9632: checking for dbm_open in -ldbm" >&5 +echo "configure:9589: checking for dbm_open in -ldbm" >&5 ac_lib_var=`echo dbm'_'dbm_open | sed 'y%./+-%__p_%'` xe_check_libs=" -ldbm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9605: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9681,10 +9638,10 @@ if test "$with_database_berkdb" != "no"; then echo $ac_n "checking for dbopen""... $ac_c" 1>&6 -echo "configure:9685: checking for dbopen" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9668: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbopen=yes" else @@ -9728,12 +9685,12 @@ if test "$need_libdb" != "no"; then echo $ac_n "checking for dbopen in -ldb""... $ac_c" 1>&6 -echo "configure:9732: checking for dbopen in -ldb" >&5 +echo "configure:9689: checking for dbopen in -ldb" >&5 ac_lib_var=`echo db'_'dbopen | sed 'y%./+-%__p_%'` xe_check_libs=" -ldb " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9705: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9768,7 +9725,7 @@ if test "$with_database_berkdb" = "yes"; then for path in "db/db.h" "db.h"; do cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:9747: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* db_h_path="$path"; break else @@ -9838,12 +9795,12 @@ if test "$with_socks" = "yes"; then echo $ac_n "checking for SOCKSinit in -lsocks""... $ac_c" 1>&6 -echo "configure:9842: checking for SOCKSinit in -lsocks" >&5 +echo "configure:9799: checking for SOCKSinit in -lsocks" >&5 ac_lib_var=`echo socks'_'SOCKSinit | sed 'y%./+-%__p_%'` xe_check_libs=" -lsocks " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9815: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else diff -r d8688acf4c5b -r 78f53ef88e17 configure.in --- a/configure.in Mon Aug 13 10:05:53 2007 +0200 +++ b/configure.in Mon Aug 13 10:06:47 2007 +0200 @@ -2920,27 +2920,6 @@ AC_DEFINE(GETTIMEOFDAY_ONE_ARGUMENT)]) fi -AC_MSG_CHECKING(whether the timezone variable is already declared) -AC_TRY_LINK([ -#ifdef TIME_WITH_SYS_TIME -#include -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif - ], - [ - timezone = 0; -], - [AC_MSG_RESULT(yes) - AC_DEFINE(HAVE_TIMEZONE_DECL)], - [AC_MSG_RESULT(no)]) - - AC_C_INLINE if test "$ac_cv_c_inline" != "no"; then diff -r d8688acf4c5b -r 78f53ef88e17 lib-src/ChangeLog --- a/lib-src/ChangeLog Mon Aug 13 10:05:53 2007 +0200 +++ b/lib-src/ChangeLog Mon Aug 13 10:06:47 2007 +0200 @@ -1,3 +1,15 @@ +1997-11-13 SL Baur + + * pop.c: Add includes from movemail.c so standard functions get + declared. + (pop_retrieve): Return NULL if falling off the end of the + function. + + * movemail.c: Hide declarations of popmail(), mbx_write(), + mbc_delimit_begin(), and mbx_delimit_end() behind MAIL_USE_POP + guard. + (pop_retr): Change 4th parameter to void *. + 1997-11-02 SL Baur * update-custom.sh (dirs): Remove packaged directories. diff -r d8688acf4c5b -r 78f53ef88e17 lib-src/movemail.c --- a/lib-src/movemail.c Mon Aug 13 10:05:53 2007 +0200 +++ b/lib-src/movemail.c Mon Aug 13 10:06:47 2007 +0200 @@ -139,13 +139,13 @@ static void pfatal_and_delete (char *); static char *concat (char *, char *, char *); static long *xmalloc (unsigned int); +#ifdef MAIL_USE_POP static int popmail (char *, char *, char *); -#ifdef MAIL_USE_POP -static int pop_retr (popserver server, int msgno, int (*action)(), int arg); -#endif +static int pop_retr (popserver server, int msgno, int (*action)(), void *arg); static int mbx_write (char *, FILE *); static int mbx_delimit_begin (FILE *); static int mbx_delimit_end (FILE *); +#endif /* Nonzero means this is name of a lock file to delete on fatal error. */ char *delete_lockname; @@ -505,7 +505,6 @@ int mbfi; FILE *mbf; char *getenv (); - int mbx_write (); popserver server; extern char *strerror (); @@ -606,7 +605,7 @@ } static int -pop_retr (popserver server, int msgno, int (*action)(), int arg) +pop_retr (popserver server, int msgno, int (*action)(), void *arg) { char *line; int ret; diff -r d8688acf4c5b -r 78f53ef88e17 lib-src/pop.c --- a/lib-src/pop.c Mon Aug 13 10:05:53 2007 +0200 +++ b/lib-src/pop.c Mon Aug 13 10:06:47 2007 +0200 @@ -73,6 +73,14 @@ #include #include +#include +#include +#include +#include "../src/syswait.h" +#include "../src/systime.h" +#include +#include + #ifdef KERBEROS #ifndef KRB5 #include @@ -627,8 +635,10 @@ if (ret) { free (ptr); - return (0); + /* return (0); */ } + /* This function used to fall off the end, but that doesn't make any sense */ + return (0); } int diff -r d8688acf4c5b -r 78f53ef88e17 lisp/ChangeLog --- a/lisp/ChangeLog Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 10:06:47 2007 +0200 @@ -1,3 +1,95 @@ +1997-11-15 SL Baur + + * packages.el (list-autoloads): Fix typo (I hope). [Doesn't work] + +1997-11-14 Hrvoje Niksic + + * custom/wid-edit.el (widget-before-change): Check for inactive + editable fields. + +1997-11-13 SL Baur + + * prim/about.el (about-xemacs): Update maintainers. + +1997-11-12 Hrvoje Niksic + + * custom/cus-edit.el (custom-face-save): Save the face. + +1997-11-13 Kyle Jones + + * packages/font-lock.el (font-lock-fontify-keywords-region): + If not fontifying a MATCH-ANCHORED style keyword, + backtrack to just after the end of the keyword before + doing the next search. + +1997-11-13 Olivier Galibert + + * language/vietnamese.el: Synched ccl with FSF 20.2. + + * language/cyrillic.el: Synched ccl with FSF 20.2. + + * language/chinese.el: Synched ccl with FSF 20.2. + + * mule/mule-ccl.el: Synched with FSF 20.2. + +1997-11-12 SL Baur + + * leim/quail.el (quail-translation-keymap): Guard against + meta-prefix-char being -1 (documented as disabling it :-(). + (quail-simple-translation-keymap): Ditto. + (quail-conversion-keymap): Ditto. + +1997-11-11 Hrvoje Niksic + + * custom/cus-face.el (custom-face-attributes): Use + `set-face-stipple' instead of `set-face-background-pixmap'. + + * prim/faces.el (set-face-stipple): Search through + x-bitmap-file-path. + +1997-11-09 Hrvoje Niksic + + * speedbar/speedbar.el (speedbar-needed-height): New function. + (speedbar-frame-mode): Use it. + +1997-11-07 Karl M. Hegbloom + + * speedbar/speedbar.el: Various docfixes. + +1997-11-12 SL Baur + + * pcl-cvs/pcl-cvs-xemacs.el: Fix emerge menu item. + From Jens Krinke + + * mule/mule-cmds.el (set-language-info): Don't add mule menu if + menubars haven't been compiled in. + +1997-11-10 Jens-Ulrik Holger Petersen + + * custom/cus-edit.el (custom-file): Use `user-init-directory' + instead of `emacs-user-extension-dir'. + +1997-11-12 SL Baur + + * modes/image-mode.el: Add command to enter xpm mode when viewing XPM + image. + From: Jens Krinke + +1997-11-12 Greg Klanderman + + * packages/compile.el (compilation-build-compilation-error-regexp-alist): + Added documentation for this function. + + ** (compilation-error-regexp-systems-list): Update documentation + to note that `compilation-build-compilation-error-regexp-alist' + must be called after changing the value. Update customization to + add a set method which automatically calls + `compilation-build-compilation-error-regexp-alist' when the value + is set by custom. Move declaration below declarations that it now + depends upon. + + ** (compilation-mouse-motion-initiate-parsing): Default to nil. + 1997-11-12 Hrvoje Niksic * help.el (help-for-help): Use `make-help-screen'. @@ -188,6 +280,17 @@ * Added file headers to: w32-faces.el, w32-init.el +1997-11-06 Hrvoje Niksic + + * facemenu.el (facemenu-insert-menu-entry): Check for + menubar availability. + + * easymenu.el (easy-menu-change): Check for menubar + availability. + + * wid-edit.el (widget-echo-help): Use `help-echo' as label + for help-echo messages. + Sun Nov 01 12:00:00 1997 Jonathan Harris * make-docfile.el: Fixed typo when dumped file does not exist. diff -r d8688acf4c5b -r 78f53ef88e17 lisp/cus-edit.el --- a/lisp/cus-edit.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/cus-edit.el Mon Aug 13 10:06:47 2007 +0200 @@ -2107,10 +2107,10 @@ :sibling-args (:help-echo "\ OS/2 Presentation Manager") pm) - (const :format "Win32 " + (const :format "MSWindows " :sibling-args (:help-echo "\ Windows NT/95/97") - win32) + mswindows) (const :format "DOS " :sibling-args (:help-echo "\ Plain MS-DOS") @@ -2387,6 +2387,7 @@ (face-spec-set symbol value) (put symbol 'saved-face value) (put symbol 'customized-face nil) + (custom-save-all) (custom-face-state-set widget) (custom-redraw-magic widget))) @@ -2921,10 +2922,10 @@ ;;; The `custom-save-all' Function. ;;;###autoload -(defcustom custom-file (if (boundp 'emacs-user-extension-dir) +(defcustom custom-file (if (boundp 'user-init-directory) (concat "~" init-file-user - emacs-user-extension-dir + user-init-directory "options.el") "~/.emacs") "File used for storing customization information. diff -r d8688acf4c5b -r 78f53ef88e17 lisp/cus-face.el --- a/lisp/cus-face.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/cus-face.el Mon Aug 13 10:06:47 2007 +0200 @@ -81,7 +81,7 @@ set-face-reverse-p face-reverse-p) (:stipple (editable-field :format "Stipple: %v" :help-echo "Name of background bitmap file.") - set-face-background-pixmap custom-face-stipple) + set-face-stipple custom-face-stipple) (:family (editable-field :format "Font Family: %v" :help-echo "\ Name of font family to use (e.g. times).") diff -r d8688acf4c5b -r 78f53ef88e17 lisp/device.el --- a/lisp/device.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/device.el Mon Aug 13 10:06:47 2007 +0200 @@ -41,7 +41,7 @@ Value is `tty' for a tty device (a character-only terminal), `x' for a device that is a screen on an X display, `ns' for a device that is a NeXTstep connection (not yet implemented), -`w32' for a device that is a Windows or Windows NT connection, +`mswindows' for a device that is a Windows or Windows NT connection, `pc' for a device that is a direct-write MS-DOS screen (not yet implemented), `stream' for a stream device (which acts like a stdio stream), and `dead' for a deleted device." @@ -67,9 +67,9 @@ "Create a new device connected to DISPLAY." (make-device 'x display)) -(defun make-w32-device () - "Create a new win32 device." - (make-device 'w32 nil)) +(defun make-mswindows-device () + "Create a new mswindows device." + (make-device 'mswindows nil)) (defun device-on-window-system-p (&optional device) "Return non-nil if DEVICE is on a window system. diff -r d8688acf4c5b -r 78f53ef88e17 lisp/faces.el --- a/lisp/faces.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/faces.el Mon Aug 13 10:06:47 2007 +0200 @@ -962,8 +962,8 @@ ;; handle X specific entries (cond ((featurep 'x) (frob-face-property face 'font 'x-make-font-bold locale)) - ((featurep 'w32) - (frob-face-property face 'font 'w32-make-font-bold locale)) + ((featurep 'mswindows) + (frob-face-property face 'font 'mswindows-make-font-bold locale)) )) '(([default] . [bold]) ([bold] . t) @@ -987,8 +987,8 @@ ;; handle X specific entries (cond ((featurep 'x) (frob-face-property face 'font 'x-make-font-italic locale)) - ((featurep 'w32) - (frob-face-property face 'font 'w32-make-font-italic locale)) + ((featurep 'mswindows) + (frob-face-property face 'font 'mswindows-make-font-italic locale)) )) '(([default] . [italic]) ([bold] . [bold-italic]) @@ -1013,8 +1013,8 @@ ;; handle X specific entries (cond ((featurep 'x) (frob-face-property face 'font 'x-make-font-bold-italic locale)) - ((featurep 'w32) - (frob-face-property face 'font 'w32-make-font-bold-italic locale)) + ((featurep 'mswindows) + (frob-face-property face 'font 'mswindows-make-font-bold-italic locale)) )) '(([default] . [italic]) ([bold] . [bold-italic]) @@ -1038,8 +1038,8 @@ ;; handle X specific entries (cond ((featurep 'x) (frob-face-property face 'font 'x-make-font-unbold locale)) - ((featurep 'w32) - (frob-face-property face 'font 'w32-make-font-unbold locale)) + ((featurep 'mswindows) + (frob-face-property face 'font 'mswindows-make-font-unbold locale)) )) '(([default] . t) ([bold] . [default]) @@ -1063,8 +1063,8 @@ ;; handle X specific entries (cond ((featurep 'x) (frob-face-property face 'font 'x-make-font-unitalic locale)) - ((featurep 'w32) - (frob-face-property face 'font 'w32-make-font-unitalic locale)) + ((featurep 'mswindows) + (frob-face-property face 'font 'mswindows-make-font-unitalic locale)) )) '(([default] . t) ([bold] . t) @@ -1084,8 +1084,8 @@ ;; handle X specific entries (cond ((featurep 'x) (frob-face-property face 'font 'x-find-smaller-font locale)) - ((featurep 'w32) - (frob-face-property face 'font 'w32-find-smaller-font locale)))) + ((featurep 'mswindows) + (frob-face-property face 'font 'mswindows-find-smaller-font locale)))) (defun make-face-larger (face &optional locale) "Make the font of the given face be larger, if possible. @@ -1094,8 +1094,8 @@ ;; handle X specific entries (cond ((featurep 'x) (frob-face-property face 'font 'x-find-larger-font locale)) - ((featurep 'w32) - (frob-face-property face 'font 'w32-find-larger-font locale)))) + ((featurep 'mswindows) + (frob-face-property face 'font 'mswindows-find-larger-font locale)))) (defun invert-face (face &optional locale) "Swap the foreground and background colors of the face." @@ -1346,8 +1346,8 @@ ;; Then do any device-specific initialization. (cond ((eq 'x (device-type device)) (x-init-device-faces device)) - ((eq 'w32 (device-type device)) - (w32-init-device-faces device)) + ((eq 'mswindows (device-type device)) + (mswindows-init-device-faces device)) ;; Nothing to do for TTYs? ) (init-other-random-faces device))) @@ -1360,8 +1360,8 @@ ;; Then do any frame-specific initialization. (cond ((eq 'x (frame-type frame)) (x-init-frame-faces frame)) - ((eq 'w32 (frame-type frame)) - (w32-init-frame-faces frame)) + ((eq 'mswindows (frame-type frame)) + (mswindows-init-frame-faces frame)) ;; Is there anything which should be done for TTY's? ))) @@ -1550,12 +1550,11 @@ (face-background 'list-mode-item-selected 'global)) (set-face-background 'list-mode-item-selected "gray68" 'global 'color) (set-face-background 'list-mode-item-selected "gray68" 'global 'grayscale) - (if (featurep 'x) - (unless (face-foreground 'list-mode-item-selected 'global) - (set-face-background 'list-mode-item-selected - [default foreground] 'global '(mono x)) - (set-face-foreground 'list-mode-item-selected - [default background] 'global '(mono x))))) + (unless (face-foreground 'list-mode-item-selected 'global) + (set-face-background 'list-mode-item-selected + [default foreground] 'global '(mono x)) + (set-face-foreground 'list-mode-item-selected + [default background] 'global '(mono x)))) ;; if the list-mode-item-selected face isn't distinguished on this device, ;; at least try inverting it. @@ -1614,7 +1613,6 @@ PIXMAP should be a string, the name of a file of pixmap data. The directories listed in the `x-bitmap-file-path' variable are searched. -Any kind of image file for which XEmacs has builtin support can be used. Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is @@ -1625,6 +1623,7 @@ in that frame; otherwise change each frame." (while (not (find-face face)) (setq face (signal 'wrong-type-argument (list 'facep face)))) + (locate-file pixmap x-bitmap-file-path ".xbm:" 4) (while (cond ((stringp pixmap) (unless (file-readable-p pixmap) (setq pixmap `[xbm :file ,pixmap])) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/frame.el --- a/lisp/frame.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/frame.el Mon Aug 13 10:06:47 2007 +0200 @@ -448,20 +448,20 @@ "Create a frame of type TYPE on CONNECTION. TYPE should be a symbol naming the device type, i.e. one of -x An X display. CONNECTION should be a standard display string - such as \"unix:0\", or nil for the display specified on the - command line or in the DISPLAY environment variable. Only if - support for X was compiled into XEmacs. -tty A standard TTY connection or terminal. CONNECTION should be - a TTY device name such as \"/dev/ttyp2\" (as determined by - the Unix command `tty') or nil for XEmacs' standard input - and output (usually the TTY in which XEmacs started). Only - if support for TTY's was compiled into XEmacs. -ns A connection to a machine running the NeXTstep windowing - system. Not currently implemented. -w32 A connection to a machine running Microsoft Windows NT or - Windows 95. -pc A direct-write MS-DOS frame. Not currently implemented. +x An X display. CONNECTION should be a standard display string + such as \"unix:0\", or nil for the display specified on the + command line or in the DISPLAY environment variable. Only if + support for X was compiled into XEmacs. +tty A standard TTY connection or terminal. CONNECTION should be + a TTY device name such as \"/dev/ttyp2\" (as determined by + the Unix command `tty') or nil for XEmacs' standard input + and output (usually the TTY in which XEmacs started). Only + if support for TTY's was compiled into XEmacs. +ns A connection to a machine running the NeXTstep windowing + system. Not currently implemented. +mswindows A connection to a machine running Microsoft Windows NT or + Windows 95/97. +pc A direct-write MS-DOS frame. Not currently implemented. PROPS should be a plist of properties, as in the call to `make-frame'. @@ -558,8 +558,7 @@ Value is `tty' for a tty frame (a character-only terminal), `x' for a frame that is an X window, `ns' for a frame that is a NeXTstep window (not yet implemented), -`win32' for a frame that is a Windows or Windows NT window (not yet - implemented), +`mswindows' for a frame that is a Windows NT or Windows 95/97 window, `pc' for a frame that is a direct-write MS-DOS frame (not yet implemented), `stream' for a stream frame (which acts like a stdio stream), and `dead' for a deleted frame." diff -r d8688acf4c5b -r 78f53ef88e17 lisp/language/chinese.el --- a/lisp/language/chinese.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/language/chinese.el Mon Aug 13 10:06:47 2007 +0200 @@ -219,40 +219,25 @@ (copy-coding-system 'big5 'chinese-big5) ;; Big5 font requires special encoding. -;; (define-ccl-program ccl-encode-big5-font -;; `(0 -;; ;; In: R0:chinese-big5-1 or chinese-big5-2 -;; ;; R1:position code 1 -;; ;; R2:position code 2 -;; ;; Out: R1:font code point 1 -;; ;; R2:font code point 2 -;; ((r2 = ((((r1 - ?\x21) * 94) + r2) - ?\x21)) -;; (if (r0 == ,(charset-id 'chinese-big5-2)) (r2 += 6280)) -;; (r1 = ((r2 / 157) + ?\xA1)) -;; (r2 %= 157) -;; (if (r2 < ?\x3F) (r2 += ?\x40) (r2 += ?\x62)))) -;; "CCL program to encode a Big5 code to code point of Big5 font.") +(define-ccl-program ccl-encode-big5-font + `(0 + ;; In: R0:chinese-big5-1 or chinese-big5-2 + ;; R1:position code 1 + ;; R2:position code 2 + ;; Out: R1:font code point 1 + ;; R2:font code point 2 + ((r2 = ((((r1 - ?\x21) * 94) + r2) - ?\x21)) + (if (r0 == ,(charset-id 'chinese-big5-2)) (r2 += 6280)) + (r1 = ((r2 / 157) + ?\xA1)) + (r2 %= 157) + (if (r2 < ?\x3F) (r2 += ?\x40) (r2 += ?\x62)))) + "CCL program to encode a Big5 code to code point of Big5 font.") ;; (setq font-ccl-encoder-alist ;; (cons (cons "big5" ccl-encode-big5-font) font-ccl-encoder-alist)) -(define-ccl-program ccl-encode-big5-1-font - '(((r1 = ((((r0 - #x21) * 94) + r1) - #x21)) - (r0 = ((r1 / 157) + #xA1)) - (r1 %= 157) - (if (r1 < #x3F) (r1 += #x40) (r1 += #x62)))) - "CCL program to encode a Big5 code (level1) to code point of Big5 font.") - -;; 6280 is the number of characters that got shoved into `chinese-big5-1'. -(define-ccl-program ccl-encode-big5-2-font - '(((r1 = (((((r0 - #x21) * 94) + r1) - #x21) + 6280)) - (r0 = ((r1 / 157) + #xA1)) - (r1 %= 157) - (if (r1 < #x3F) (r1 += #x40) (r1 += #x62)))) - "CCL program to encode a Big5 code (level2) to code point of Big5 font.") - -(set-charset-ccl-program 'chinese-big5-1 ccl-encode-big5-1-font) -(set-charset-ccl-program 'chinese-big5-2 ccl-encode-big5-2-font) +(set-charset-ccl-program 'chinese-big5-1 ccl-encode-big5-font) +(set-charset-ccl-program 'chinese-big5-2 ccl-encode-big5-font) (set-language-info-alist "Chinese-BIG5" '((setup-function . (setup-chinese-big5-environment diff -r d8688acf4c5b -r 78f53ef88e17 lisp/language/cyrillic.el --- a/lisp/language/cyrillic.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/language/cyrillic.el Mon Aug 13 10:06:47 2007 +0200 @@ -94,11 +94,12 @@ ;; KOI-8 staff (define-ccl-program ccl-decode-koi8 - '(((read r0) + '(3 + ((read r0) (loop - (write-read-repeat - r0 - [0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + (write-read-repeat + r0 + [0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 @@ -117,53 +118,55 @@ "CCL program to decode KOI8.") (define-ccl-program ccl-encode-koi8 - '(((read r0) + `(1 + ((read r0) (loop - (if (r0 != 140) ; lc-crl == 140 - (write-read-repeat r0) - ((read r0) - (r0 -= 160) - (write-read-repeat - r0 - [ 32 179 32 32 32 32 32 32 32 32 32 32 32 32 32 32 + (if (r0 != ,(charset-id 'cyrillic-iso8859-5)) + (write-read-repeat r0) + ((read r0) + (r0 -= 160) + (write-read-repeat + r0 + [ 32 179 32 32 32 32 32 32 32 32 32 32 32 32 32 32 + 225 226 247 231 228 229 246 250 233 234 235 236 237 238 239 240 + 242 243 244 245 230 232 227 254 251 253 255 249 248 252 224 241 + 193 194 215 199 196 197 214 218 201 202 203 204 205 206 207 208 + 210 211 212 213 198 200 195 222 219 221 223 217 216 220 192 209 + 32 163 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) + ))))) + "CCL program to encode KOI8.") + +;(make-coding-system +; 'cyrillic-koi8 4 +; ;; We used to use ?K. It is true that ?K is more strictly correct, +; ;; but it is also used for Korean. +; ;; So people who use koi8 for languages other than Russian +; ;; will have to forgive us. +; ?R "KOI8 8-bit encoding for Cyrillic (MIME: KOI8-R)" +; (cons ccl-decode-koi8 ccl-encode-koi8)) + +;(define-coding-system-alias 'koi8-r 'cyrillic-koi8) +;(define-coding-system-alias 'koi8 'cyrillic-koi8) + +;(make-coding-system +; 'koi8-r 'ccl +; "Coding-system used for KOI8-R." +; `(decode ,ccl-decode-koi8 +; encode ,ccl-encode-koi8 +; mnemonic "KOI8")) + +;(define-coding-system-alias 'koi8-r 'koi8) + +(define-ccl-program ccl-encode-koi8-font + '(0 + ((r1 -= 160) + (r1 = r1 + [ 32 179 32 32 32 32 32 32 32 32 32 32 32 32 32 32 225 226 247 231 228 229 246 250 233 234 235 236 237 238 239 240 242 243 244 245 230 232 227 254 251 253 255 249 248 252 224 241 193 194 215 199 196 197 214 218 201 202 203 204 205 206 207 208 210 211 212 213 198 200 195 222 219 221 223 217 216 220 192 209 - 32 163 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) - ))))) - "CCL program to encode KOI8.") - -;; (make-coding-system -;; 'cyrillic-koi8 4 -;; ;; We used to use ?K. It is true that ?K is more strictly correct, -;; ;; but it is also used for Korean. -;; ;; So people who use koi8 for languages other than Russian -;; ;; will have to forgive us. -;; ?R "KOI8 8-bit encoding for Cyrillic (MIME: KOI8-R)" -;; (cons ccl-decode-koi8 ccl-encode-koi8)) - -;; (define-coding-system-alias 'koi8-r 'cyrillic-koi8) -;; (define-coding-system-alias 'koi8 'cyrillic-koi8) - -;; (make-coding-system -;; 'koi8-r 'ccl -;; "Coding-system used for KOI8-R." -;; `(decode ,ccl-decode-koi8 -;; encode ,ccl-encode-koi8 -;; mnemonic "KOI8")) - -;;(define-coding-system-alias 'koi8-r 'koi8) - -(define-ccl-program ccl-encode-koi8-font - '(((r1 -= 160) - (r1 = r1 - [ 32 179 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 225 226 247 231 228 229 246 250 233 234 235 236 237 238 239 240 - 242 243 244 245 230 232 227 254 251 253 255 249 248 252 224 241 - 193 194 215 199 196 197 214 218 201 202 203 204 205 206 207 208 - 210 211 212 213 198 200 195 222 219 221 223 217 216 220 192 209 - 32 163 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) + 32 163 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) )) "CCL program to encode Cyrillic chars to KOI font.") @@ -182,44 +185,46 @@ ;;; ALTERNATIVNYJ staff (define-ccl-program ccl-decode-alternativnyj - '(((read r0) + '(3 + ((read r0) (loop - (write-read-repeat - r0 - [ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 - 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 - 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 - 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 - 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 - 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 - 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 - 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 - ?,L0(B ?,L1(B ?,L2(B ?,L3(B ?,L4(B ?,L5(B ?,L6(B ?,L7(B ?,L8(B ?,L9(B ?,L:(B ?,L;(B ?,L<(B ?,L=(B ?,L>(B ?,L?(B - ?,L@(B ?,LA(B ?,LB(B ?,LC(B ?,LD(B ?,LE(B ?,LF(B ?,LG(B ?,LH(B ?,LI(B ?,LJ(B ?,LK(B ?,LL(B ?,LM(B ?,LN(B ?,LO(B - ?,LP(B ?,LQ(B ?,LR(B ?,LS(B ?,LT(B ?,LU(B ?,LV(B ?,LW(B ?,LX(B ?,LY(B ?,LZ(B ?,L[(B ?,L\(B ?,L](B ?,L^(B ?,L_(B - 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - ?,L`(B ?,La(B ?,Lb(B ?,Lc(B ?,Ld(B ?,Le(B ?,Lf(B ?,Lg(B ?,Lh(B ?,Li(B ?,Lj(B ?,Lk(B ?,Ll(B ?,Lm(B ?,Ln(B ?,Lo(B - ?,L!(B ?,Lq(B 32 32 32 32 32 32 32 32 32 32 32 32 32 ?,Lp(B])))) + (write-read-repeat + r0 + [ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 + 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 + 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 + 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 + 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 + 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 + 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 + ?,L0(B ?,L1(B ?,L2(B ?,L3(B ?,L4(B ?,L5(B ?,L6(B ?,L7(B ?,L8(B ?,L9(B ?,L:(B ?,L;(B ?,L<(B ?,L=(B ?,L>(B ?,L?(B + ?,L@(B ?,LA(B ?,LB(B ?,LC(B ?,LD(B ?,LE(B ?,LF(B ?,LG(B ?,LH(B ?,LI(B ?,LJ(B ?,LK(B ?,LL(B ?,LM(B ?,LN(B ?,LO(B + ?,LP(B ?,LQ(B ?,LR(B ?,LS(B ?,LT(B ?,LU(B ?,LV(B ?,LW(B ?,LX(B ?,LY(B ?,LZ(B ?,L[(B ?,L\(B ?,L](B ?,L^(B ?,L_(B + 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 + 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 + 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 + ?,L`(B ?,La(B ?,Lb(B ?,Lc(B ?,Ld(B ?,Le(B ?,Lf(B ?,Lg(B ?,Lh(B ?,Li(B ?,Lj(B ?,Lk(B ?,Ll(B ?,Lm(B ?,Ln(B ?,Lo(B + ?,L!(B ?,Lq(B 32 32 32 32 32 32 32 32 32 32 32 32 32 ?,Lp(B])))) "CCL program to decode Alternativnyj.") (define-ccl-program ccl-encode-alternativnyj - '(((read r0) + `(1 + ((read r0) (loop - (if (r0 != 140) ; lc-crl == 140 - (write-read-repeat r0) - ((read r0) - (r0 -= 160) - (write-read-repeat - r0 - [ 32 240 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 - 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 - 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 - 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 - 255 241 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) - ))))) + (if (r0 != ,(charset-id 'cyrillic-iso8859-5)) + (write-read-repeat r0) + ((read r0) + (r0 -= 160) + (write-read-repeat + r0 + [ 32 240 32 32 32 32 32 32 32 32 32 32 32 32 32 32 + 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 + 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 + 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 + 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 + 255 241 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) + ))))) "CCL program to encode Alternativnyj.") ;; (make-coding-system @@ -235,7 +240,8 @@ mnemonic "Cy.Alt")) (define-ccl-program ccl-encode-alternativnyj-font - '(((r1 -= 160) + '(0 + ((r1 -= 160) (r1 = r1 [ 32 240 32 32 32 32 32 32 32 32 32 32 32 32 32 32 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 @@ -261,35 +267,35 @@ ;;; GENERAL -;; (defun setup-cyrillic-environment () -;; "Setup multilingual environment for Cyrillic users." -;; (interactive) -;; (setq primary-language "Cyrillic") -;; -;; (setq coding-category-iso-8-1 'iso-8859-5) -;; -;; (set-coding-priority -;; '(coding-category-iso-7 -;; coding-category-iso-8-1)) -;; -;; (setq-default buffer-file-coding-system 'iso-8859-5) -;; (set-terminal-coding-system 'iso-8859-5) -;; (set-keyboard-coding-system 'iso-8859-5) -;; -;; (setq default-input-method '("Cyrillic" . "quail-yawerty")) -;; ) +(defun setup-cyrillic-environment () + "Setup multilingual environment for Cyrillic users." + (interactive) + (setq primary-language "Cyrillic") + + (setq coding-category-iso-8-1 'iso-8859-5) + + (set-coding-priority + '(coding-category-iso-7 + coding-category-iso-8-1)) + + (setq-default buffer-file-coding-system 'iso-8859-5) + (set-terminal-coding-system 'iso-8859-5) + (set-keyboard-coding-system 'iso-8859-5) -;; (defun describe-cyrillic-support () -;; "Describe how Emacs support Cyrillic." -;; (interactive) -;; (describe-language-support-internal "Cyrillic")) + (setq default-input-method '("Cyrillic" . "quail-yawerty")) + ) + +(defun describe-cyrillic-support () + "Describe how Emacs support Cyrillic." + (interactive) + (describe-language-support-internal "Cyrillic")) -;; (set-language-info-alist -;; "Cyrillic" '((setup-function . setup-cyrillic-environment) -;; (describe-function . describe-cyrillic-support) -;; (charset . (cyrillic-iso8859-5)) -;; (coding-system . (iso-8859-5 koi8-r alternativnyj)) -;; (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") -;; (documentation . nil))) +(set-language-info-alist + "Cyrillic" '((setup-function . setup-cyrillic-environment) + (describe-function . describe-cyrillic-support) + (charset . (cyrillic-iso8859-5)) + (coding-system . (iso-8859-5 koi8-r alternativnyj)) + (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") + (documentation . nil))) ;;; cyrillic.el ends here diff -r d8688acf4c5b -r 78f53ef88e17 lisp/language/vietnamese.el --- a/lisp/language/vietnamese.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/language/vietnamese.el Mon Aug 13 10:06:47 2007 +0200 @@ -108,7 +108,8 @@ ) (define-ccl-program ccl-read-viscii - `(((read r0) + `(3 + ((read r0) (loop (write-read-repeat r0 ,viet-viscii-decode-table)) )) @@ -128,188 +129,91 @@ ;; `vietnamese-viscii-lower' or `vietnamese-viscii-upper'. (define-ccl-program ccl-write-viscii - `(((read r0) + `(1 + ((read r0) (loop (if (r0 < 128) + ;; ASCII (write-read-repeat r0) - (if (r0 != 154) + ;; not ASCII + (if (r0 != ,leading-code-private-11) + ;; not Vietnamese (write-read-repeat r0) - ((read-if (r0 == 163) - ((read r0) - (r0 -= 160) + ((read-if (r0 == ,(charset-id 'vietnamese-viscii-lower)) + (;; Vietnamese lower + (read r0) + (r0 -= 128) (write-read-repeat r0 ,(car viet-viscii-encode-table)) - (if (r0 == 164) - ((read r0) - (r0 -= 160) + (if (r0 == ,(charset-id 'vietnamese-viscii-upper)) + (;; Vietnamese upper + (read r0) + (r0 -= 128) (write-read-repeat r0 ,(cdr viet-viscii-encode-table))) + ;; not Vietnamese (write-read-repeat r0)))))))))) "CCL program to write VISCII 1.1") -;; (define-ccl-program ccl-encode-viscii -;; `(1 -;; ((read r0) -;; (loop -;; (if (r0 < 128) -;; ;; ASCII -;; (write-read-repeat r0) -;; ;; not ASCII -;; (if (r0 != ,leading-code-private-11) -;; ;; not Vietnamese -;; (write-read-repeat r0) -;; ((read-if (r0 == ,(charset-id 'vietnamese-viscii-lower)) -;; (;; Vietnamese lower -;; (read r0) -;; (r0 -= 128) -;; (write-read-repeat r0 ,(car viet-viscii-encode-table))) -;; (if (r0 == ,(charset-id 'vietnamese-viscii-upper)) -;; (;; Vietnamese upper -;; (read r0) -;; (r0 -= 128) -;; (write-read-repeat r0 ,(cdr viet-viscii-encode-table))) -;; ;; not Vietnamese -;; (write-read-repeat r0))))))))) -;; "CCL program to encode VISCII 1.1") - -(define-ccl-program ccl-vietnamese-lower-to-viscii - `(((r1 = r1 - ,(car viet-viscii-encode-table)))) - "CCL program to convert chars of 'vietnamese-lower to VISCII 1.1 font") +(define-ccl-program ccl-encode-viscii-font + `(0 + ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper + ;; R1:position code + ;; Out: R1:font code point + (if (r0 == ,(charset-id 'vietnamese-viscii-lower)) + (r1 = r1 ,(car viet-viscii-encode-table)) + (r1 = r1 ,(cdr viet-viscii-encode-table))) + ) + "CCL program to encode Vietnamese chars to VISCII 1.1 font") -(define-ccl-program ccl-vietnamese-upper-to-viscii - `(((r1 = r1 - ,(cdr viet-viscii-encode-table)))) - "CCL program to convert chars of 'vietnamese-upper to VISCII 1.1 font") - -;; (define-ccl-program ccl-encode-viscii-font -;; `(0 -;; ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper -;; ;; R1:position code -;; ;; Out: R1:font code point -;; (if (r0 == ,(charset-id 'vietnamese-viscii-lower)) -;; (r1 = r1 ,(car viet-viscii-encode-table)) -;; (r1 = r1 ,(cdr viet-viscii-encode-table))) -;; ) -;; "CCL program to encode Vietnamese chars to VISCII 1.1 font") +(define-ccl-program ccl-decode-vscii + `(3 + ((read r0) + (loop + (write-read-repeat r0 ,viet-vscii-decode-table)) + )) + "CCL program to decode VSCII-1.") -(define-ccl-program ccl-read-vscii - `(((read r0) - (loop - (write-read-repeat r0 ,viet-vscii-decode-table)) - )) - "CCL program to read VSCII-1.") - -;; (define-ccl-program ccl-decode-vscii -;; `(3 -;; ((read r0) -;; (loop -;; (write-read-repeat r0 ,viet-vscii-decode-table)) -;; )) -;; "CCL program to decode VSCII-1.") - -(define-ccl-program ccl-write-vscii - `(((read r0) +(define-ccl-program ccl-encode-vscii + `(1 + ((read r0) (loop - (if (r0 < 128) - (write-read-repeat r0) - (if (r0 != 154) - (write-read-repeat r0) - (read-if (r0 == 163) - ((read r0) - (r0 -= 160) - (write-read-repeat r0 ,(car viet-vscii-encode-table))) - (if (r0 == 164) - ((read r0) - (r0 -= 160) - (write-read-repeat - r0 ,(cdr viet-viscii-encode-table))) - (write-read-repeat r0)))))))) - "CCL program to write VSCII-1.") - -;; (define-ccl-program ccl-encode-vscii -;; `(1 -;; ((read r0) -;; (loop -;; (if (r0 < 128) -;; ;; ASCII -;; (write-read-repeat r0) -;; ;; not ASCII -;; (if (r0 != ,leading-code-private-11) -;; ;; not Vietnamese -;; (write-read-repeat r0) -;; (read-if (r0 == ,(charset-id 'vietnamese-viscii-lower)) -;; (;; Vietnamese lower -;; (read r0) -;; (r0 -= 128) -;; (write-read-repeat r0 ,(car viet-vscii-encode-table))) -;; (if (r0 == ,(charset-id 'vietnamese-viscii-upper)) -;; (;; Vietnamese upper -;; (read r0) -;; (r0 -= 128) -;; (write-read-repeat r0 ,(cdr viet-viscii-encode-table))) -;; ;; not Vietnamese -;; (write-read-repeat r0)))))))) -;; "CCL program to encode VSCII-1.") - -(define-ccl-program ccl-vietnamese-lower-to-vscii - '(((r1 = r1 - [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 190 187 198 202 199 200 203 207 209 213 210 211 212 214 232 - 229 230 231 0 0 233 234 235 222 0 0 0 0 0 237 0 - 0 0 0 0 0 0 188 189 0 0 0 0 0 0 0 250 - 0 248 0 0 0 185 251 245 246 0 0 252 254 0 236 0 - 181 184 169 183 182 168 247 201 204 208 170 206 215 221 220 216 - 174 249 223 227 171 226 225 228 244 239 243 242 241 253 238 0 - ]))) - "CCL program to convert chars of 'vietnamese-lower to VSCII-1 font.") - -(define-ccl-program ccl-vietnamese-upper-to-vscii - '(((r1 = r1 - [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 192 175 133 0 196 194 134 137 139 218 197 205 217 140 255 - 219 224 240 0 0 151 152 153 145 0 0 0 0 165 155 0 - 0 0 0 0 0 0 186 191 0 0 0 0 0 0 0 19 - 0 17 0 0 0 132 20 4 5 0 0 21 23 0 154 166 - 128 131 162 130 129 161 6 195 135 138 163 136 141 144 143 142 - 167 0 146 149 164 148 147 150 2 157 1 159 158 22 156 0 - ]))) - "CCL program to convert chars of 'vietnamese-upper to VSCII-1 font.") - -;; (define-ccl-program ccl-encode-vscii-font -;; `(0 -;; ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper -;; ;; R1:position code -;; ;; Out: R1:font code point -;; (if (r0 == ,(charset-id 'vietnamese-viscii-lower)) -;; (r1 = r1 ,(car viet-vscii-encode-table)) -;; (r1 = r1 ,(cdr viet-vscii-encode-table))) -;; ) -;; "CCL program to encode Vietnamese chars to VSCII-1 font.") + (if (r0 < 128) + ;; ASCII + (write-read-repeat r0) + ;; not ASCII + (if (r0 != ,leading-code-private-11) + ;; not Vietnamese + (write-read-repeat r0) + (read-if (r0 == ,(charset-id 'vietnamese-viscii-lower)) + (;; Vietnamese lower + (read r0) + (r0 -= 128) + (write-read-repeat r0 ,(car viet-vscii-encode-table))) + (if (r0 == ,(charset-id 'vietnamese-viscii-upper)) + (;; Vietnamese upper + (read r0) + (r0 -= 128) + (write-read-repeat r0 ,(cdr viet-viscii-encode-table))) + ;; not Vietnamese + (write-read-repeat r0)))))))) + "CCL program to encode VSCII-1.") +(define-ccl-program ccl-encode-vscii-font + `(0 + ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper + ;; R1:position code + ;; Out: R1:font code point + (if (r0 == ,(charset-id 'vietnamese-viscii-lower)) + (r1 = r1 ,(car viet-vscii-encode-table)) + (r1 = r1 ,(cdr viet-vscii-encode-table))) + ) + "CCL program to encode Vietnamese chars to VSCII-1 font.") (make-coding-system 'viscii 'ccl "Coding-system used for VISCII 1.1." `(mnemonic "VISCII" - decode ,ccl-read-viscii - encode ,ccl-write-viscii)) + decode ,ccl-decode-viscii + encode ,ccl-encode-viscii)) ;; (make-coding-system ;; 'vietnamese-viscii 4 ?V @@ -322,8 +226,8 @@ 'vscii 'ccl "Coding-system used for VSCII 1.1." `(mnemonic "VSCII" - decode ,ccl-read-vscii - encode ,ccl-write-vscii)) + decode ,ccl-encode-vscii + encode ,ccl-decode-vscii)) ;; (make-coding-system ;; 'vietnamese-vscii 4 ?v @@ -351,12 +255,12 @@ ;; For VISCII users (set-charset-ccl-program 'vietnamese-viscii-lower - ccl-vietnamese-lower-to-viscii) + ccl-encode-viscii-font) (set-charset-ccl-program 'vietnamese-viscii-upper - ccl-vietnamese-upper-to-viscii) + ccl-encode-viscii-font) ;; For VSCII users -;; (set-charset-ccl-program 'vietnamese-lower ccl-vietnamese-lower-to-vscii) -;; (set-charset-ccl-program 'vietnamese-upper ccl-vietnamese-upper-to-vscii) +(set-charset-ccl-program 'vietnamese-lower ccl-encode-vscii-font) +(set-charset-ccl-program 'vietnamese-upper ccl-encode-vscii-font) ;; (setq font-ccl-encoder-alist ;; (cons (cons "viscii" ccl-encode-viscii-font) font-ccl-encoder-alist)) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/leim/quail.el --- a/lisp/leim/quail.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/leim/quail.el Mon Aug 13 10:06:47 2007 +0200 @@ -309,10 +309,12 @@ (define-key map [delete] 'quail-delete-last-char) (define-key map [backspace] 'quail-delete-last-char) (let ((meta-map (make-sparse-keymap))) - (define-key map (char-to-string meta-prefix-char) meta-map) + (when (characterp meta-prefix-char) + (define-key map (char-to-string meta-prefix-char) meta-map)) (define-key map [escape] meta-map)) - (define-key map (vector meta-prefix-char t) - 'quail-execute-non-quail-command) + (when (characterp meta-prefix-char) + (define-key map (vector meta-prefix-char t) + 'quail-execute-non-quail-command)) ;; At last, define default key binding. (set-keymap-default-binding map 'quail-execute-non-quail-command) map) @@ -336,10 +338,12 @@ ;;; This interferes with handling of escape sequences on non-X terminals. ;;; (define-key map "\e" '(keymap (t . quail-execute-non-quail-command))) (let ((meta-map (make-sparse-keymap))) - (define-key map (char-to-string meta-prefix-char) meta-map) + (when (characterp meta-prefix-char) + (define-key map (char-to-string meta-prefix-char) meta-map)) (define-key map [escape] meta-map)) - (define-key map (vector meta-prefix-char t) - 'quail-execute-non-quail-command) + (when (characterp meta-prefix-char) + (define-key map (vector meta-prefix-char t) + 'quail-execute-non-quail-command)) ;; At last, define default key binding. (set-keymap-default-binding map 'quail-execute-non-quail-command) map) @@ -370,10 +374,12 @@ (define-key map [delete] 'quail-conversion-backward-delete-char) (define-key map [backspace] 'quail-conversion-backward-delete-char) (let ((meta-map (make-sparse-keymap))) - (define-key map (char-to-string meta-prefix-char) meta-map) + (when (characterp meta-prefix-char) + (define-key map (char-to-string meta-prefix-char) meta-map)) (define-key map [escape] meta-map)) - (define-key map (vector meta-prefix-char t) - 'quail-execute-non-quail-command) + (when (characterp meta-prefix-char) + (define-key map (vector meta-prefix-char t) + 'quail-execute-non-quail-command)) ;; At last, define default key binding. (set-keymap-default-binding map 'quail-execute-non-quail-command) map) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/modes/image-mode.el --- a/lisp/modes/image-mode.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/modes/image-mode.el Mon Aug 13 10:06:47 2007 +0200 @@ -49,6 +49,8 @@ raw data. Please type `\\[image-enter-hexl-mode]' if you would like to edit hex data. +Please type `\\[image-enter-xpm-mode]' if you would like to edit xpm +data. Please type `\\[image-start-external-viewer]' if you would like to display contents of this buffer by external viewer.\n"))) (call-interactively 'fill-paragraph) @@ -60,6 +62,7 @@ (define-key image-mode-map "v" 'image-start-external-viewer) (define-key image-mode-map "t" 'image-toggle-decoding) (define-key image-mode-map "h" 'image-enter-hexl-mode) +(define-key image-mode-map "e" 'image-enter-xpm-mode) (define-key image-mode-map "q" 'image-mode-quit) (defvar image-external-viewer @@ -117,6 +120,25 @@ (hexl-mode) ) +(defun image-enter-xpm-mode () + "Enter to xpm-mode." + (interactive) + (if (not (eq buffer-image-format 'image/x-xpm)) + (error "Not a xpm-picture.")) + (when buffer-file-format + (setq buffer-read-only nil) + (erase-buffer) + (map-extents (function + (lambda (extent maparg) + (delete-extent extent) + )) nil (point-min)(point-min)) + (setq buffer-file-format nil) + (insert-file-contents-literally buffer-file-name) + (set-buffer-modified-p nil) + ) + (xpm-mode 1) + ) + (defun image-mode-quit () "Exit image-mode." (interactive) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/msw-faces.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/msw-faces.el Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,105 @@ +;;; msw-faces.el --- mswindows-specific face stuff. + +;;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. +;;; Copyright (C) 1995, 1996 Ben Wing. + +;; Author: Jamie Zawinski +;; Modified by: Chuck Thompson +;; Modified by: Ben Wing +;; Modified by: Martin Buchholz +;; Rewritten for mswindows by: Jonathan Harris + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs 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 +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; This file does the magic to parse mswindows font names, and make sure that the +;; default and modeline attributes of new frames are specified enough. + +(defun mswindows-init-global-faces () + ) + +;;; ensure that the default face has some reasonable fallbacks if nothing +;;; else is specified. +(defun mswindows-init-device-faces (device) + (or (face-font 'default 'global) + (set-face-font 'default "Courier New:Regular:10") + 'global) + (or (face-foreground 'default 'global) + (set-face-foreground 'default "black" 'global 'mswindows)) + (or (face-background 'default 'global) + (set-face-background 'default "white" 'global 'mswindows)) + (or (face-background 'modeline 'global) + (set-face-background 'modeline "grey75" 'global 'mswindows)) + ) + + +(defun mswindows-init-frame-faces (frame) + ) + + +;;; Fill in missing parts of a font spec. This is primarily intended as a +;;; helper function for the functions below. +;;; mswindows fonts look like: +;;; fontname[:[weight ][style][:pointsize[:effects[:charset]]]] +;;; A minimal mswindows font spec looks like: +;;; Courier New +;;; A maximal mswindows font spec looks like: +;;; Courier New:Bold Italic:10:underline strikeout:ansi +;;; Missing parts of the font spec should be filled in with these values: +;;; Courier New:Normal:10::ansi +(defun mswindows-canicolize-font (font &optional device) + "Given a mswindows font specification, this converts it to canonical form." + nil) + +(defun mswindows-make-font-bold (font &optional device) + "Given a mswindows font specification, this attempts to make a bold font. +If it fails, it returns nil." + nil) + +(defun mswindows-make-font-unbold (font &optional device) + "Given a mswindows font specification, this attempts to make a non-bold font. +If it fails, it returns nil." + nil) + +(defun mswindows-make-font-italic (font &optional device) + "Given a mswindows font specification, this attempts to make an `italic' font. +If it fails, it returns nil." + nil) + +(defun mswindows-make-font-unitalic (font &optional device) + "Given a mswindows font specification, this attempts to make a non-italic font. +If it fails, it returns nil." + nil) + +(defun mswindows-make-font-bold-italic (font &optional device) + "Given a mswindows font specification, this attempts to make a `bold-italic' +font. If it fails, it returns nil." + nil) + +(defun mswindows-find-smaller-font (font &optional device) + "Loads a new, version of the given font (or font name). +Returns the font if it succeeds, nil otherwise. +If scalable fonts are available, this returns a font which is 1 point smaller. +Otherwise, it returns the next smaller version of this font that is defined." + nil) + +(defun mswindows-find-larger-font (font &optional device) + "Loads a new, slightly larger version of the given font (or font name). +Returns the font if it succeeds, nil otherwise. +If scalable fonts are available, this returns a font which is 1 point larger. +Otherwise, it returns the next larger version of this font that is defined." + nil) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/msw-init.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/msw-init.el Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,47 @@ +;;; msw-init.el --- initialization code for mswindows +;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1995 Board of Trustees, University of Illinois. +;; Copyright (C) 1995, 1996 Ben Wing. + +;; Author: various +;; Rewritten for mswindows by: Jonathan Harris + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs 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 +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +(defvar mswindows-win-initted nil) +(defvar mswindows-pre-win-initted nil) +(defvar mswindows-post-win-initted nil) + +(defun init-pre-mswindows-win () + "Initialize mswindows GUI at startup (pre). Don't call this." + (unless mswindows-pre-win-initted + (setq mswindows-pre-win-initted t))) + +(defun init-mswindows-win () + "Initialize mswindows GUI at startup. Don't call this." + (unless mswindows-win-initted + (init-pre-mswindows-win) + (make-mswindows-device) + (init-post-mswindows-win (selected-console)) + (setq mswindows-win-initted t))) + +(defun init-post-mswindows-win (console) + "Initialize mswindows GUI at startup (post). Don't call this." + (unless mswindows-post-win-initted + (setq mswindows-post-win-initted t))) + diff -r d8688acf4c5b -r 78f53ef88e17 lisp/mule/auto-autoloads.el --- a/lisp/mule/auto-autoloads.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/mule/auto-autoloads.el Mon Aug 13 10:06:47 2007 +0200 @@ -19,21 +19,31 @@ ;;;*** -;;;### (autoloads (define-ccl-program ccl-dump ccl-compile ccl-program-p) "mule-ccl" "mule/mule-ccl.el") +;;;### (autoloads (ccl-execute-with-args define-ccl-program declare-ccl-program ccl-dump ccl-compile ccl-program-p) "mule-ccl" "mule/mule-ccl.el") (autoload 'ccl-program-p "mule-ccl" "\ T if OBJECT is a valid CCL compiled code." nil nil) (autoload 'ccl-compile "mule-ccl" "\ -Compile a CCL source program and return the compiled equivalent. -The return value will be a vector of integers." nil nil) +Return a compiled code of CCL-PROGRAM as a vector of integer." nil nil) (autoload 'ccl-dump "mule-ccl" "\ Disassemble compiled CCL-CODE." nil nil) +(autoload 'declare-ccl-program "mule-ccl" "\ +Declare NAME as a name of CCL program. + +To compile a CCL program which calls another CCL program not yet +defined, it must be declared as a CCL program in advance." nil 'macro) + (autoload 'define-ccl-program "mule-ccl" "\ -Does (defconst NAME (ccl-compile (eval CCL-PROGRAM)) DOC). -Byte-compiler expand this macro while compiling." nil 'macro) +Set NAME the compiled code of CCL-PROGRAM. +CCL-PROGRAM is `eval'ed before being handed to the CCL compiler `ccl-compile'. +The compiled code is a vector of integers." nil 'macro) + +(autoload 'ccl-execute-with-args "mule-ccl" "\ +Execute CCL-PROGRAM with registers initialized by the remaining args. +The return value is a vector of resulting CCL registeres." nil nil) ;;;*** diff -r d8688acf4c5b -r 78f53ef88e17 lisp/mule/mule-ccl.el --- a/lisp/mule/mule-ccl.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/mule/mule-ccl.el Mon Aug 13 10:06:47 2007 +0200 @@ -1,58 +1,171 @@ -;;; mule-ccl.el --- Code Conversion Language functions. +;;; ccl.el --- CCL (Code Conversion Language) compiler -;; Copyright (C) 1992 Free Software Foundation, Inc. +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. -;; This file is part of XEmacs. +;; Keywords: CCL, mule, multilingual, character set, coding-system -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by +;; This file is part of X Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. -;; XEmacs 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 -;; General Public License for more details. +;; GNU Emacs 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 General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; 93.5.26 created for Mule Ver.0.9.8 by K.Handa +;; Synched up with: FSF 20.2 -;;;; #### This stuff doesn't work yet. +;;; Commentary: -(defconst ccl-operator-table - '[if branch loop break repeat write-repeat write-read-repeat - read read-if read-branch write end]) +;; CCL (Code Conversion Language) is a simple programming language to +;; be used for various kind of code conversion. CCL program is +;; compiled to CCL code (vector of integers) and executed by CCL +;; interpreter of Emacs. +;; +;; CCL is used for code conversion at process I/O and file I/O for +;; non-standard coding-system. In addition, it is used for +;; calculating a code point of X's font from a character code. +;; However, since CCL is designed as a powerful programming language, +;; it can be used for more generic calculation. For instance, +;; combination of three or more arithmetic operations can be +;; calculated faster than Emacs Lisp. +;; +;; Here's the syntax of CCL program in BNF notation. +;; +;; CCL_PROGRAM := +;; (BUFFER_MAGNIFICATION +;; CCL_MAIN_BLOCK +;; [ CCL_EOF_BLOCK ]) +;; +;; BUFFER_MAGNIFICATION := integer +;; CCL_MAIN_BLOCK := CCL_BLOCK +;; CCL_EOF_BLOCK := CCL_BLOCK +;; +;; CCL_BLOCK := +;; STATEMENT | (STATEMENT [STATEMENT ...]) +;; STATEMENT := +;; SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL +;; +;; SET := +;; (REG = EXPRESSION) +;; | (REG ASSIGNMENT_OPERATOR EXPRESSION) +;; | integer +;; +;; EXPRESSION := ARG | (EXPRESSION OPERATOR ARG) +;; +;; IF := (if EXPRESSION CCL_BLOCK CCL_BLOCK) +;; BRANCH := (branch EXPRESSION CCL_BLOCK [CCL_BLOCK ...]) +;; LOOP := (loop STATEMENT [STATEMENT ...]) +;; BREAK := (break) +;; REPEAT := +;; (repeat) +;; | (write-repeat [REG | integer | string]) +;; | (write-read-repeat REG [integer | ARRAY]) +;; READ := +;; (read REG ...) +;; | (read-if (REG OPERATOR ARG) CCL_BLOCK CCL_BLOCK) +;; | (read-branch REG CCL_BLOCK [CCL_BLOCK ...]) +;; WRITE := +;; (write REG ...) +;; | (write EXPRESSION) +;; | (write integer) | (write string) | (write REG ARRAY) +;; | string +;; CALL := (call ccl-program-name) +;; END := (end) +;; +;; REG := r0 | r1 | r2 | r3 | r4 | r5 | r6 | r7 +;; ARG := REG | integer +;; OPERATOR := +;; + | - | * | / | % | & | '|' | ^ | << | >> | <8 | >8 | // +;; | < | > | == | <= | >= | != | de-sjis | en-sjis +;; ASSIGNMENT_OPERATOR := +;; += | -= | *= | /= | %= | &= | '|=' | ^= | <<= | >>= +;; ARRAY := '[' interger ... ']' -(let (op (i 0) (len (length ccl-operator-table))) +;;; Code: + +(defconst ccl-command-table + [if branch loop break repeat write-repeat write-read-repeat + read read-if read-branch write call end] + "*Vector of CCL commands (symbols).") + +;; Put a property to each symbol of CCL commands for the compiler. +(let (op (i 0) (len (length ccl-command-table))) (while (< i len) - (setq op (aref ccl-operator-table i)) + (setq op (aref ccl-command-table i)) (put op 'ccl-compile-function (intern (format "ccl-compile-%s" op))) (setq i (1+ i)))) -(defconst ccl-machine-code-table - '[set-cs set-cl set-r set-a - jump jump-cond write-jump write-read-jump write-c-jump - write-c-read-jump write-s-jump write-s-read-jump write-a-read-jump - branch - read1 read2 read-branch write1 write2 write-c write-s write-a - end - set-self-cs set-self-cl set-self-r set-expr-cl set-expr-r - jump-cond-c jump-cond-r read-jump-cond-c read-jump-cond-r - ]) +(defconst ccl-code-table + [set-register + set-short-const + set-const + set-array + jump + jump-cond + write-register-jump + write-register-read-jump + write-const-jump + write-const-read-jump + write-string-jump + write-array-read-jump + read-jump + branch + read-register + write-expr-const + read-branch + write-register + write-expr-register + call + write-const-string + write-array + end + set-assign-expr-const + set-assign-expr-register + set-expr-const + set-expr-register + jump-cond-expr-const + jump-cond-expr-register + read-jump-cond-expr-const + read-jump-cond-expr-register + ] + "*Vector of CCL compiled codes (symbols).") -(let (code (i 0) (len (length ccl-machine-code-table))) +;; Put a property to each symbol of CCL codes for the disassembler. +(let (code (i 0) (len (length ccl-code-table))) (while (< i len) - (setq code (aref ccl-machine-code-table i)) + (setq code (aref ccl-code-table i)) (put code 'ccl-code i) (put code 'ccl-dump-function (intern (format "ccl-dump-%s" code))) (setq i (1+ i)))) -(defconst ccl-register-table '[r0 r1 r2 r3 r4 r5 r6 r7]) +(defconst ccl-jump-code-list + '(jump jump-cond write-register-jump write-register-read-jump + write-const-jump write-const-read-jump write-string-jump + write-array-read-jump read-jump)) +;; Put a property `jump-flag' to each CCL code which execute jump in +;; some way. +(let ((l ccl-jump-code-list)) + (while l + (put (car l) 'jump-flag t) + (setq l (cdr l)))) + +(defconst ccl-register-table + [r0 r1 r2 r3 r4 r5 r6 r7] + "*Vector of CCL registers (symbols).") + +;; Put a property to indicate register number to each symbol of CCL. +;; registers. (let (reg (i 0) (len (length ccl-register-table))) (while (< i len) (setq reg (aref ccl-register-table i)) @@ -60,52 +173,94 @@ (setq i (1+ i)))) (defconst ccl-arith-table - '[+ - * / % & | ^ << >> <8 >8 // nil nil nil < > == <= >= !=]) + [+ - * / % & | ^ << >> <8 >8 // nil nil nil + < > == <= >= != de-sjis en-sjis] + "*Vector of CCL arithmetic/logical operators (symbols).") +;; Put a property to each symbol of CCL operators for the compiler. (let (arith (i 0) (len (length ccl-arith-table))) (while (< i len) (setq arith (aref ccl-arith-table i)) (if arith (put arith 'ccl-arith-code i)) (setq i (1+ i)))) -(defconst ccl-self-arith-table - '[+= -= *= /= %= &= |= ^= <<= >>= <8= >8= //=]) +(defconst ccl-assign-arith-table + [+= -= *= /= %= &= |= ^= <<= >>= <8= >8= //=] + "*Vector of CCL assignment operators (symbols).") -(let (arith (i 0) (len (length ccl-self-arith-table))) +;; Put a property to each symbol of CCL assignment operators for the compiler. +(let (arith (i 0) (len (length ccl-assign-arith-table))) (while (< i len) - (setq arith (aref ccl-self-arith-table i)) + (setq arith (aref ccl-assign-arith-table i)) (put arith 'ccl-self-arith-code i) (setq i (1+ i)))) -;; this holds the compiled CCL program as it is being compiled. -(defvar ccl-program-vector nil) +(defvar ccl-program-vector nil + "Working vector of CCL codes produced by CCL compiler.") +(defvar ccl-current-ic 0 + "The current index for `ccl-program-vector'.") + +;; Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and +;; increment it. If IC is specified, embed DATA at IC. +(defun ccl-embed-data (data &optional ic) + (let ((val (if (characterp data) (char-int data) data))) + (if ic + (aset ccl-program-vector ic val) + (aset ccl-program-vector ccl-current-ic val) + (setq ccl-current-ic (1+ ccl-current-ic))))) -;; this holds the index into ccl-program-vector where the next -;; instruction is to be stored. -(defvar ccl-current-ic 0) +;; Embed string STR of length LEN in `ccl-program-vector' at +;; `ccl-current-ic'. +(defun ccl-embed-string (len str) + (let ((i 0)) + (while (< i len) + (ccl-embed-data (logior (ash (aref str i) 16) + (if (< (1+ i) len) + (ash (aref str (1+ i)) 8) + 0) + (if (< (+ i 2) len) + (aref str (+ i 2)) + 0))) + (setq i (+ i 3))))) -;; add a constant to the compiled CCL program, either at IC (if specified) -;; or at the current instruction counter (and bumping that value) -(defun ccl-embed-const (const &optional ic) - (if ic - (aset ccl-program-vector ic const) - (aset ccl-program-vector ccl-current-ic const) +;; Embed a relative jump address to `ccl-current-ic' in +;; `ccl-program-vector' at IC without altering the other bit field. +(defun ccl-embed-current-address (ic) + (let ((relative (- ccl-current-ic (1+ ic)))) + (aset ccl-program-vector ic + (logior (aref ccl-program-vector ic) (ash relative 8))))) + +;; Embed CCL code for the operation OP and arguments REG and DATA in +;; `ccl-program-vector' at `ccl-current-ic' in the following format. +;; |----------------- integer (28-bit) ------------------| +;; |------------ 20-bit ------------|- 3-bit --|- 5-bit -| +;; |------------- DATA -------------|-- REG ---|-- OP ---| +;; If REG2 is specified, embed a code in the following format. +;; |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -| +;; |-------- DATA -------|-- REG2 --|-- REG ---|-- OP ---| + +;; If REG is a CCL register symbol (e.g. r0, r1...), the register +;; number is embedded. If OP is one of unconditional jumps, DATA is +;; changed to an relative jump address. + +(defun ccl-embed-code (op reg data &optional reg2) + (if (and (> data 0) (get op 'jump-flag)) + ;; DATA is an absolute jump address. Make it relative to the + ;; next of jump code. + (setq data (- data (1+ ccl-current-ic)))) + (let ((code (logior (get op 'ccl-code) + (ash + (if (symbolp reg) (get reg 'ccl-register-number) reg) 5) + (if reg2 + (logior (ash (get reg2 'ccl-register-number) 8) + (ash data 11)) + (ash data 8))))) + (aset ccl-program-vector ccl-current-ic code) (setq ccl-current-ic (1+ ccl-current-ic)))) -(defun ccl-embed-code (op reg const &optional ic) - (let ((machine-code (logior (get op 'ccl-code) - (if (symbolp reg) - (ash (get reg 'ccl-register-number) 5) - 0) - (ash const 8)))) - (if ic - (aset ccl-program-vector ic machine-code) - (aset ccl-program-vector ccl-current-ic machine-code) - (setq ccl-current-ic (1+ ccl-current-ic))))) - -;; advance the instruction counter by INC without doing anything else -(defun ccl-embed-nop (&optional inc) - (setq ccl-current-ic (+ ccl-current-ic (or inc 1)))) +;; Just advance `ccl-current-ic' by INC. +(defun ccl-increment-ic (inc) + (setq ccl-current-ic (+ ccl-current-ic inc))) ;;;###autoload (defun ccl-program-p (obj) @@ -119,30 +274,45 @@ (setq i (1+ i))) flag))))) +;; If non-nil, index of the start of the current loop. (defvar ccl-loop-head nil) +;; If non-nil, list of absolute addresses of the breaking points of +;; the current loop. (defvar ccl-breaks nil) ;;;###autoload (defun ccl-compile (ccl-program) - "Compile a CCL source program and return the compiled equivalent. -The return value will be a vector of integers." + "Return a compiled code of CCL-PROGRAM as a vector of integer." (if (or (null (consp ccl-program)) - (null (listp (car ccl-program)))) - (error "CCL: Invalid source program: %s" ccl-program)) + (null (integer-or-char-p (car ccl-program))) + (null (listp (car (cdr ccl-program))))) + (error "CCL: Invalid CCL program: %s" ccl-program)) (if (null (vectorp ccl-program-vector)) - (setq ccl-program-vector (make-vector 8192 0)) - ;; perhaps not necessary but guarantees some sort of determinism - (fillarray ccl-program-vector 0)) + (setq ccl-program-vector (make-vector 8192 0))) (setq ccl-loop-head nil ccl-breaks nil) (setq ccl-current-ic 0) - ;; leave space for offset to EOL program - (ccl-embed-nop) - (ccl-compile-1 (car ccl-program)) - ;; store offset to EOL program in first word of compiled prog - (ccl-embed-const ccl-current-ic 0) - (if (car (cdr ccl-program)) - (ccl-compile-1 (car (cdr ccl-program)))) + + ;; The first element is the buffer magnification. + (ccl-embed-data (car ccl-program)) + + ;; The second element is the address of the start CCL code for + ;; processing end of input buffer (we call it eof-processor). We + ;; set it later. + (ccl-increment-ic 1) + + ;; Compile the main body of the CCL program. + (ccl-compile-1 (car (cdr ccl-program))) + + ;; Embed the address of eof-processor. + (ccl-embed-data ccl-current-ic 1) + + ;; Then compile eof-processor. + (if (nth 2 ccl-program) + (ccl-compile-1 (nth 2 ccl-program))) + + ;; At last, embed termination code. (ccl-embed-code 'end 0 0) + (let ((vec (make-vector ccl-current-ic 0)) (i 0)) (while (< i ccl-current-ic) @@ -150,235 +320,351 @@ (setq i (1+ i))) vec)) -(defun ccl-check-constant (arg cmd) - (if (>= arg 0) - arg - (error "CCL: Negative constant %s not allowed: %s" arg cmd))) +;; Signal syntax error. +(defun ccl-syntax-error (cmd) + (error "CCL: Syntax error: %s" cmd)) +;; Check if ARG is a valid CCL register. (defun ccl-check-register (arg cmd) (if (get arg 'ccl-register-number) arg - (error "CCL: Invalid register %s: %s" arg cmd))) + (error "CCL: Invalid register %s in %s." arg cmd))) -(defun ccl-check-reg-const (arg cmd) - (if (integer-or-char-p arg) - (ccl-check-constant arg cmd) - (ccl-check-register arg cmd))) - +;; Check if ARG is a valid CCL command. (defun ccl-check-compile-function (arg cmd) (or (get arg 'ccl-compile-function) (error "CCL: Invalid command: %s" cmd))) -;; compile a block of CCL code (see CCL_BLOCK above). -(defun ccl-compile-1 (cmd-list) - (let (cmd) - ;; a CCL_BLOCK is either STATEMENT or (STATEMENT [STATEMENT ...]) - ;; convert the former into the latter. - (if (or (not (listp cmd-list)) - (and cmd-list (symbolp (car cmd-list)))) - (setq cmd-list (list cmd-list))) - (while cmd-list - (setq cmd (car cmd-list)) - ;; an int-or-char is equivalent to (r0 = int-or-char) - ;; a string is equivalent to (write string) - ;; convert the above two into their equivalent forms. - ;; everything else is a list. - (cond ((integer-or-char-p cmd) - (ccl-compile-set (list 'r0 '= cmd))) - ((stringp cmd) - (ccl-compile-write-string (list 'write cmd))) - ((listp cmd) - (if (eq (nth 1 cmd) '=) - (ccl-compile-set cmd) - (if (and (symbolp (nth 1 cmd)) - (get (nth 1 cmd) 'ccl-self-arith-code)) - (ccl-compile-self-set cmd) - (funcall (ccl-check-compile-function (car cmd) cmd) cmd)))) - (t - (error "CCL: Invalid command: %s" cmd))) - (setq cmd-list (cdr cmd-list))))) +;; In the following code, most ccl-compile-XXXX functions return t if +;; they end with unconditional jump, else return nil. + +;; Compile CCL-BLOCK (see the syntax above). +(defun ccl-compile-1 (ccl-block) + (let (unconditional-jump + cmd) + (if (or (integer-or-char-p ccl-block) + (stringp ccl-block) + (and ccl-block (symbolp (car ccl-block)))) + ;; This block consists of single statement. + (setq ccl-block (list ccl-block))) + + ;; Now CCL-BLOCK is a list of statements. Compile them one by + ;; one. + (while ccl-block + (setq cmd (car ccl-block)) + (setq unconditional-jump + (cond ((integer-or-char-p cmd) + ;; SET statement for the register 0. + (ccl-compile-set (list 'r0 '= cmd))) + ((stringp cmd) + ;; WRITE statement of string argument. + (ccl-compile-write-string cmd)) + + ((listp cmd) + ;; The other statements. + (cond ((eq (nth 1 cmd) '=) + ;; SET statement of the form `(REG = EXPRESSION)'. + (ccl-compile-set cmd)) + + ((and (symbolp (nth 1 cmd)) + (get (nth 1 cmd) 'ccl-self-arith-code)) + ;; SET statement with an assignment operation. + (ccl-compile-self-set cmd)) + + (t + (funcall (ccl-check-compile-function (car cmd) cmd) + cmd)))) + + (t + (ccl-syntax-error cmd)))) + (setq ccl-block (cdr ccl-block))) + unconditional-jump)) + +(defconst ccl-max-short-const (ash 1 19)) +(defconst ccl-min-short-const (ash -1 19)) + +;; Compile SET statement. (defun ccl-compile-set (cmd) (let ((rrr (ccl-check-register (car cmd) cmd)) (right (nth 2 cmd))) (cond ((listp right) - ;; cmd == (RRR = (XXX OP YYY)) + ;; CMD has the form `(RRR = (XXX OP YYY))'. (ccl-compile-expression rrr right)) + ((integer-or-char-p right) - (ccl-check-constant right cmd) - (if (< right 524288) ; (< right 2^19) - (ccl-embed-code 'set-cs rrr right) - (ccl-embed-code 'set-cl rrr 0) - (ccl-embed-const right))) + ;; CMD has the form `(RRR = integer)'. + (if (and (<= right ccl-max-short-const) + (>= right ccl-min-short-const)) + (ccl-embed-code 'set-short-const rrr right) + (ccl-embed-code 'set-const rrr 0) + (ccl-embed-data right))) + (t + ;; CMD has the form `(RRR = rrr [ array ])'. (ccl-check-register right cmd) (let ((ary (nth 3 cmd))) (if (vectorp ary) (let ((i 0) (len (length ary))) - (ccl-embed-code 'set-a rrr (get right 'ccl-register-number)) - (ccl-embed-const len) + (ccl-embed-code 'set-array rrr len right) (while (< i len) - (ccl-check-constant (aref ary i) cmd) - (ccl-embed-const (aref ary i)) + (ccl-embed-data (aref ary i)) (setq i (1+ i)))) - (ccl-embed-code 'set-r rrr right))))))) + (ccl-embed-code 'set-register rrr 0 right)))))) + nil) +;; Compile SET statement with ASSIGNMENT_OPERATOR. (defun ccl-compile-self-set (cmd) (let ((rrr (ccl-check-register (car cmd) cmd)) (right (nth 2 cmd))) (if (listp right) - ;; cmd == (RRR SELF-OP= (XXX OP YYY)) + ;; CMD has the form `(RRR ASSIGN_OP (XXX OP YYY))', compile + ;; the right hand part as `(r7 = (XXX OP YYY))' (note: the + ;; register 7 can be used for storing temporary value). (progn (ccl-compile-expression 'r7 right) (setq right 'r7))) + ;; Now CMD has the form `(RRR ASSIGN_OP ARG)'. Compile it as + ;; `(RRR = (RRR OP ARG))'. (ccl-compile-expression rrr - (list rrr (intern (substring (symbol-name (nth 1 cmd)) 0 -1)) right)))) + (list rrr (intern (substring (symbol-name (nth 1 cmd)) 0 -1)) right))) + nil) +;; Compile SET statement of the form `(RRR = EXPR)'. (defun ccl-compile-expression (rrr expr) (let ((left (car expr)) + (op (get (nth 1 expr) 'ccl-arith-code)) (right (nth 2 expr))) (if (listp left) (progn + ;; EXPR has the form `((EXPR2 OP2 ARG) OP RIGHT)'. Compile + ;; the first term as `(r7 = (EXPR2 OP2 ARG)).' (ccl-compile-expression 'r7 left) (setq left 'r7))) + + ;; Now EXPR has the form (LEFT OP RIGHT). (if (eq rrr left) + ;; Compile this SET statement as `(RRR OP= RIGHT)'. (if (integer-or-char-p right) - (if (< right 32768) - (ccl-embed-code 'set-self-cs rrr right) - (ccl-embed-code 'set-self-cl rrr 0) - (ccl-embed-const right)) + (progn + (ccl-embed-code 'set-assign-expr-const rrr (ash op 3) 'r0) + (ccl-embed-data right)) (ccl-check-register right expr) - (ccl-embed-code 'set-self-r rrr (get right 'ccl-register-number))) + (ccl-embed-code 'set-assign-expr-register rrr (ash op 3) right)) + + ;; Compile this SET statement as `(RRR = (LEFT OP RIGHT))'. (if (integer-or-char-p right) (progn - (ccl-embed-code 'set-expr-cl rrr (get left 'ccl-register-number)) - (ccl-embed-const right)) + (ccl-embed-code 'set-expr-const rrr (ash op 3) left) + (ccl-embed-data right)) (ccl-check-register right expr) - (ccl-embed-code 'set-expr-r rrr (get left 'ccl-register-number)) - (ccl-embed-const (get right 'ccl-register-number)))) - (ccl-embed-const (get (nth 1 expr) 'ccl-arith-code)))) + (ccl-embed-code 'set-expr-register + rrr + (logior (ash op 3) (get right 'ccl-register-number)) + left))))) -(defun ccl-compile-write-string (cmd) - (if (/= (length cmd) 2) - (error "CCL: Invalid number of arguments: %s" cmd)) - (let* ((str (nth 1 cmd)) - (len (length str)) - (i 0)) - (ccl-embed-code 'write-s 0 0) - (ccl-embed-const len) - (while (< i len) - (ccl-embed-const (aref str i)) - (setq i (1+ i))))) +;; Compile WRITE statement with string argument. +(defun ccl-compile-write-string (str) + (let ((len (length str))) + (ccl-embed-code 'write-const-string 1 len) + (ccl-embed-string len str)) + nil) -(defun ccl-compile-if (cmd) +;; Compile IF statement of the form `(if CONDITION TRUE-PART FALSE-PART)'. +;; If READ-FLAG is non-nil, this statement has the form +;; `(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART)'. +(defun ccl-compile-if (cmd &optional read-flag) (if (and (/= (length cmd) 3) (/= (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((condition (nth 1 cmd)) (true-cmds (nth 2 cmd)) (false-cmds (nth 3 cmd)) - ic0 ic1 ic2) - (if (listp condition) - ;; cmd == (if (XXX OP YYY) ...) - (if (listp (car condition)) - ;; cmd == (if ((xxx op yyy) OP YYY) ...) - (progn - (ccl-compile-expression 'r7 (car condition)) - (setq condition (cons 'r7 (cdr condition))) - (setq cmd (cons (car cmd) - (cons condition - (cdr (cdr cmd)))))))) - (setq ic0 ccl-current-ic) - (ccl-embed-nop (if (listp condition) 3 1)) - (ccl-compile-1 true-cmds) - (if (null false-cmds) - (setq ic1 ccl-current-ic) - (setq ic2 ccl-current-ic) - (ccl-embed-const 0) - (setq ic1 ccl-current-ic) - (ccl-compile-1 false-cmds) - (ccl-embed-code 'jump 0 ccl-current-ic ic2)) + jump-cond-address + false-ic) + (if (and (listp condition) + (listp (car condition))) + ;; If CONDITION is a nested expression, the inner expression + ;; should be compiled at first as SET statement, i.e.: + ;; `(if ((X OP2 Y) OP Z) ...)' is compiled into two statements: + ;; `(r7 = (X OP2 Y)) (if (r7 OP Z) ...)'. + (progn + (ccl-compile-expression 'r7 (car condition)) + (setq condition (cons 'r7 (cdr condition))) + (setq cmd (cons (car cmd) + (cons condition (cdr (cdr cmd))))))) + + (setq jump-cond-address ccl-current-ic) + ;; Compile CONDITION. (if (symbolp condition) - (ccl-embed-code 'jump-cond condition ic1 ic0) - (let ((arg (nth 2 condition))) + ;; CONDITION is a register. + (progn + (ccl-check-register condition cmd) + (ccl-embed-code 'jump-cond condition 0)) + ;; CONDITION is a simple expression of the form (RRR OP ARG). + (let ((rrr (car condition)) + (op (get (nth 1 condition) 'ccl-arith-code)) + (arg (nth 2 condition))) + (ccl-check-register rrr cmd) (if (integer-or-char-p arg) (progn - (ccl-embed-code 'jump-cond-c (car condition) ic1 ic0) - (ccl-embed-const arg (1+ ic0))) + (ccl-embed-code (if read-flag 'read-jump-cond-expr-const + 'jump-cond-expr-const) + rrr 0) + (ccl-embed-data op) + (ccl-embed-data arg)) (ccl-check-register arg cmd) - (ccl-embed-code 'jump-cond-r (car condition) ic1 ic0) - (ccl-embed-const (get arg 'ccl-register-number) (1+ ic0))) - (ccl-embed-const (get (nth 1 condition) 'ccl-arith-code) (+ ic0 2)))))) + (ccl-embed-code (if read-flag 'read-jump-cond-expr-register + 'jump-cond-expr-register) + rrr 0) + (ccl-embed-data op) + (ccl-embed-data (get arg 'ccl-register-number))))) + ;; Compile TRUE-PART. + (let ((unconditional-jump (ccl-compile-1 true-cmds))) + (if (null false-cmds) + ;; This is the place to jump to if condition is false. + (ccl-embed-current-address jump-cond-address) + (let (end-true-part-address) + (if (not unconditional-jump) + (progn + ;; If TRUE-PART does not end with unconditional jump, we + ;; have to jump to the end of FALSE-PART from here. + (setq end-true-part-address ccl-current-ic) + (ccl-embed-code 'jump 0 0))) + ;; This is the place to jump to if CONDITION is false. + (ccl-embed-current-address jump-cond-address) + ;; Compile FALSE-PART. + (setq unconditional-jump + (and (ccl-compile-1 false-cmds) unconditional-jump)) + (if end-true-part-address + ;; This is the place to jump to after the end of TRUE-PART. + (ccl-embed-current-address end-true-part-address)))) + unconditional-jump))) + +;; Compile BRANCH statement. (defun ccl-compile-branch (cmd) (if (< (length cmd) 3) (error "CCL: Invalid number of arguments: %s" cmd)) - (if (listp (nth 1 cmd)) - (progn - (ccl-compile-expression 'r7 (nth 1 cmd)) - (setq cmd (cons (car cmd) - (cons 'r7 (cdr (cdr cmd))))))) - (ccl-compile-branch-1 cmd)) + (ccl-compile-branch-blocks 'branch + (ccl-compile-branch-expression (nth 1 cmd) cmd) + (cdr (cdr cmd)))) +;; Compile READ statement of the form `(read-branch EXPR BLOCK0 BLOCK1 ...)'. (defun ccl-compile-read-branch (cmd) - (ccl-compile-branch-1 cmd)) - -(defun ccl-compile-branch-1 (cmd) (if (< (length cmd) 3) (error "CCL: Invalid number of arguments: %s" cmd)) - (let ((rrr (ccl-check-register (car (cdr cmd)) cmd)) - (branches (cdr (cdr cmd))) - i ic0 ic1 ic2 - branch-tails) - (ccl-embed-code (car cmd) rrr (- (length cmd) 2)) - (setq ic0 ccl-current-ic) - (ccl-embed-nop (1- (length cmd))) - (setq i 0) - (while branches - (ccl-embed-const ccl-current-ic (+ ic0 i)) - (ccl-compile-1 (car branches)) - (setq branch-tails (cons ccl-current-ic branch-tails)) - (ccl-embed-nop) - (setq i (1+ i)) - (setq branches (cdr branches))) - ;; We don't need `jump' from the last branch. - (setq branch-tails (cdr branch-tails)) - (setq ccl-current-ic (1- ccl-current-ic)) - (while branch-tails - (ccl-embed-code 'jump 0 ccl-current-ic (car branch-tails)) - (setq branch-tails (cdr branch-tails))) - ;; This is the case `rrr' is out of range. - (ccl-embed-const ccl-current-ic (+ ic0 i)) - )) + (ccl-compile-branch-blocks 'read-branch + (ccl-compile-branch-expression (nth 1 cmd) cmd) + (cdr (cdr cmd)))) + +;; Compile EXPRESSION part of BRANCH statement and return register +;; which holds a value of the expression. +(defun ccl-compile-branch-expression (expr cmd) + (if (listp expr) + ;; EXPR has the form `(EXPR2 OP ARG)'. Compile it as SET + ;; statement of the form `(r7 = (EXPR2 OP ARG))'. + (progn + (ccl-compile-expression 'r7 expr) + 'r7) + (ccl-check-register expr cmd))) +;; Compile BLOCKs of BRANCH statement. CODE is 'branch or 'read-branch. +;; REG is a register which holds a value of EXPRESSION part. BLOCKs +;; is a list of CCL-BLOCKs. +(defun ccl-compile-branch-blocks (code rrr blocks) + (let ((branches (length blocks)) + branch-idx + jump-table-head-address + empty-block-indexes + block-tail-addresses + block-unconditional-jump) + (ccl-embed-code code rrr branches) + (setq jump-table-head-address ccl-current-ic) + ;; The size of jump table is the number of blocks plus 1 (for the + ;; case RRR is out of range). + (ccl-increment-ic (1+ branches)) + (setq empty-block-indexes (list branches)) + ;; Compile each block. + (setq branch-idx 0) + (while blocks + (if (null (car blocks)) + ;; This block is empty. + (setq empty-block-indexes (cons branch-idx empty-block-indexes) + block-unconditional-jump t) + ;; This block is not empty. + (ccl-embed-data (- ccl-current-ic jump-table-head-address) + (+ jump-table-head-address branch-idx)) + (setq block-unconditional-jump (ccl-compile-1 (car blocks))) + (if (not block-unconditional-jump) + (progn + ;; Jump address of the end of branches are embedded later. + ;; For the moment, just remember where to embed them. + (setq block-tail-addresses + (cons ccl-current-ic block-tail-addresses)) + (ccl-embed-code 'jump 0 0)))) + (setq branch-idx (1+ branch-idx)) + (setq blocks (cdr blocks))) + (if (not block-unconditional-jump) + ;; We don't need jump code at the end of the last block. + (setq block-tail-addresses (cdr block-tail-addresses) + ccl-current-ic (1- ccl-current-ic))) + ;; Embed jump address at the tailing jump commands of blocks. + (while block-tail-addresses + (ccl-embed-current-address (car block-tail-addresses)) + (setq block-tail-addresses (cdr block-tail-addresses))) + ;; For empty blocks, make entries in the jump table point directly here. + (while empty-block-indexes + (ccl-embed-data (- ccl-current-ic jump-table-head-address) + (+ jump-table-head-address (car empty-block-indexes))) + (setq empty-block-indexes (cdr empty-block-indexes)))) + ;; Branch command ends by unconditional jump if RRR is out of range. + nil) + +;; Compile LOOP statement. (defun ccl-compile-loop (cmd) (if (< (length cmd) 2) (error "CCL: Invalid number of arguments: %s" cmd)) - (let ((ccl-loop-head ccl-current-ic) - (ccl-breaks nil)) + (let* ((ccl-loop-head ccl-current-ic) + (ccl-breaks nil) + unconditional-jump) (setq cmd (cdr cmd)) - (while cmd - (ccl-compile-1 (car cmd)) - (setq cmd (cdr cmd))) - (while ccl-breaks - (ccl-embed-code 'jump 0 ccl-current-ic (car ccl-breaks)) - (setq ccl-breaks (cdr ccl-breaks))))) + (if cmd + (progn + (setq unconditional-jump t) + (while cmd + (setq unconditional-jump + (and (ccl-compile-1 (car cmd)) unconditional-jump)) + (setq cmd (cdr cmd))) + (if (not ccl-breaks) + unconditional-jump + ;; Embed jump address for break statements encountered in + ;; this loop. + (while ccl-breaks + (ccl-embed-current-address (car ccl-breaks)) + (setq ccl-breaks (cdr ccl-breaks)))) + nil)))) +;; Compile BREAK statement. (defun ccl-compile-break (cmd) (if (/= (length cmd) 1) (error "CCL: Invalid number of arguments: %s" cmd)) (if (null ccl-loop-head) (error "CCL: No outer loop: %s" cmd)) (setq ccl-breaks (cons ccl-current-ic ccl-breaks)) - (ccl-embed-nop)) + (ccl-embed-code 'jump 0 0) + t) +;; Compile REPEAT statement. (defun ccl-compile-repeat (cmd) (if (/= (length cmd) 1) (error "CCL: Invalid number of arguments: %s" cmd)) (if (null ccl-loop-head) (error "CCL: No outer loop: %s" cmd)) - (ccl-embed-code 'jump 0 ccl-loop-head)) + (ccl-embed-code 'jump 0 ccl-loop-head) + t) +;; Compile WRITE-REPEAT statement. (defun ccl-compile-write-repeat (cmd) (if (/= (length cmd) 2) (error "CCL: Invalid number of arguments: %s" cmd)) @@ -386,19 +672,20 @@ (error "CCL: No outer loop: %s" cmd)) (let ((arg (nth 1 cmd))) (cond ((integer-or-char-p arg) - (ccl-embed-code 'write-c-jump 0 ccl-loop-head) - (ccl-embed-const arg)) + (ccl-embed-code 'write-const-jump 0 ccl-loop-head) + (ccl-embed-data arg)) ((stringp arg) - (ccl-embed-code 'write-s-jump 0 ccl-loop-head) - (let ((i 0) (len (length arg))) - (ccl-embed-const (length arg)) - (while (< i len) - (ccl-embed-const (aref arg i)) - (setq i (1+ i))))) + (let ((len (length arg)) + (i 0)) + (ccl-embed-code 'write-string-jump 0 ccl-loop-head) + (ccl-embed-data len) + (ccl-embed-string len arg))) (t (ccl-check-register arg cmd) - (ccl-embed-code 'write-jump arg ccl-loop-head))))) + (ccl-embed-code 'write-register-jump arg ccl-loop-head)))) + t) +;; Compile WRITE-READ-REPEAT statement. (defun ccl-compile-write-read-repeat (cmd) (if (or (< (length cmd) 2) (> (length cmd) 3)) (error "CCL: Invalid number of arguments: %s" cmd)) @@ -407,290 +694,417 @@ (let ((rrr (ccl-check-register (nth 1 cmd) cmd)) (arg (nth 2 cmd))) (cond ((null arg) - (ccl-embed-code 'write-read-jump rrr ccl-loop-head)) + (ccl-embed-code 'write-register-read-jump rrr ccl-loop-head)) ((integer-or-char-p arg) - (ccl-embed-code 'write-c-read-jump rrr ccl-loop-head) - (ccl-embed-const arg)) - ((or (stringp arg) (vectorp arg)) - (ccl-embed-code (if (stringp arg) - 'write-s-read-jump - 'write-a-read-jump) - rrr ccl-loop-head) - (let ((i 0) (len (length arg))) - (ccl-embed-const (length arg)) + (ccl-embed-code 'write-const-read-jump rrr arg ccl-loop-head)) + ((vectorp arg) + (let ((len (length arg)) + (i 0)) + (ccl-embed-code 'write-array-read-jump rrr ccl-loop-head) + (ccl-embed-data len) (while (< i len) - (ccl-embed-const (aref arg i)) + (ccl-embed-data (aref arg i)) (setq i (1+ i))))) - (t (error "CCL: Invalide argument %s: %s" arg cmd))))) + (t + (error "CCL: Invalid argument %s: %s" arg cmd))) + (ccl-embed-code 'read-jump rrr ccl-loop-head)) + t) +;; Compile READ statement. (defun ccl-compile-read (cmd) - (let ((rrr (ccl-check-register (nth 1 cmd) cmd))) - (cond ((= (length cmd) 2) - (ccl-embed-code 'read1 rrr 0)) - ((= (length cmd) 3) - (ccl-embed-code 'read2 rrr (get (nth 2 cmd) 'ccl-register-number))) - (t (error "CCL: Invalid number of arguments: %s" cmd))))) - -(defun ccl-compile-read-if (cmd) - (if (and (/= (length cmd) 3) (/= (length cmd) 4)) + (if (< (length cmd) 2) (error "CCL: Invalid number of arguments: %s" cmd)) - (let* ((expr (nth 1 cmd)) - (rrr (ccl-check-register (car expr) cmd)) - (true-cmds (nth 2 cmd)) - (false-cmds (nth 3 cmd)) - ic0 ic1 ic2) - (setq ic0 ccl-current-ic) - (ccl-embed-nop 3) - (ccl-compile-1 true-cmds) - (if (null false-cmds) - (setq ic1 ccl-current-ic) - (setq ic2 ccl-current-ic) - (ccl-embed-const 0) - (setq ic1 ccl-current-ic) - (ccl-compile-1 false-cmds) - (ccl-embed-code 'jump 0 ccl-current-ic ic2)) - (let ((arg (nth 2 expr))) - (ccl-embed-code (if (integer-or-char-p arg) 'read-jump-cond-c - 'read-jump-cond-r) - rrr ic1 ic0) - (ccl-embed-const (if (integer-or-char-p arg) arg - (get arg 'ccl-register-number)) - (1+ ic0)) - (ccl-embed-const (get (nth 1 expr) 'ccl-arith-code) (+ ic0 2))))) + (let* ((args (cdr cmd)) + (i (1- (length args)))) + (while args + (let ((rrr (ccl-check-register (car args) cmd))) + (ccl-embed-code 'read-register rrr i) + (setq args (cdr args) i (1- i))))) + nil) +;; Compile READ-IF statement. +(defun ccl-compile-read-if (cmd) + (ccl-compile-if cmd 'read)) + +;; Compile WRITE statement. (defun ccl-compile-write (cmd) - (if (and (/= (length cmd) 2) (/= (length cmd) 3)) + (if (< (length cmd) 2) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((rrr (nth 1 cmd))) (cond ((integer-or-char-p rrr) - (ccl-embed-code 'write-c 0 0) - (ccl-embed-const rrr)) + (ccl-embed-code 'write-const-string 0 rrr)) ((stringp rrr) - (ccl-compile-write-string (list 'write rrr))) - (t + (ccl-compile-write-string rrr)) + ((and (symbolp rrr) (vectorp (nth 2 cmd))) (ccl-check-register rrr cmd) - (let ((arg (nth 2 cmd))) - (if arg - (cond ((symbolp arg) - (ccl-check-register arg cmd) - (ccl-embed-code 'write2 rrr - (get arg 'ccl-register-number))) - ((vectorp arg) - (let ((i 0) (len (length arg))) - (ccl-embed-code 'write-a rrr 0) - (ccl-embed-const len) - (while (< i len) - (ccl-embed-const (aref arg i)) - (setq i (1+ i))))) - (t (error "CCL: Invalid argument %s: %s" arg cmd))) - (ccl-embed-code 'write1 rrr 0))))))) + ;; CMD has the form `(write REG ARRAY)'. + (let* ((arg (nth 2 cmd)) + (len (length arg)) + (i 0)) + (ccl-embed-code 'write-array rrr len) + (while (< i len) + (if (not (integer-or-char-p (aref arg i))) + (error "CCL: Invalid argument %s: %s" arg cmd)) + (ccl-embed-data (aref arg i)) + (setq i (1+ i))))) + + ((symbolp rrr) + ;; CMD has the form `(write REG ...)'. + (let* ((args (cdr cmd)) + (i (1- (length args)))) + (while args + (setq rrr (ccl-check-register (car args) cmd)) + (ccl-embed-code 'write-register rrr i) + (setq args (cdr args) i (1- i))))) + ((listp rrr) + ;; CMD has the form `(write (LEFT OP RIGHT))'. + (let ((left (car rrr)) + (op (get (nth 1 rrr) 'ccl-arith-code)) + (right (nth 2 rrr))) + (if (listp left) + (progn + ;; RRR has the form `((EXPR OP2 ARG) OP RIGHT)'. + ;; Compile the first term as `(r7 = (EXPR OP2 ARG))'. + (ccl-compile-expression 'r7 left) + (setq left 'r7))) + ;; Now RRR has the form `(ARG OP RIGHT)'. + (if (integer-or-char-p right) + (progn + (ccl-embed-code 'write-expr-const 0 (ash op 3) left) + (ccl-embed-data right)) + (ccl-check-register right rrr) + (ccl-embed-code 'write-expr-register 0 + (logior (ash op 3) + (get right 'ccl-register-number)))))) + + (t + (error "CCL: Invalid argument: %s" cmd)))) + nil) + +;; Compile CALL statement. +(defun ccl-compile-call (cmd) + (if (/= (length cmd) 2) + (error "CCL: Invalid number of arguments: %s" cmd)) + (if (not (symbolp (nth 1 cmd))) + (error "CCL: Subroutine should be a symbol: %s" cmd)) + (let* ((name (nth 1 cmd)) + (idx (get name 'ccl-program-idx))) + (if (not idx) + (error "CCL: Unknown subroutine name: %s" name)) + (ccl-embed-code 'call 0 idx)) + nil) + +;; Compile END statement. (defun ccl-compile-end (cmd) (if (/= (length cmd) 1) (error "CCL: Invalid number of arguments: %s" cmd)) - (ccl-embed-code 'end 0 0)) + (ccl-embed-code 'end 0 0) + t) ;;; CCL dump staffs -(defvar ccl-program-vector-dump nil) + +;; To avoid byte-compiler warning. +(defvar ccl-code) ;;;###autoload (defun ccl-dump (ccl-code) "Disassemble compiled CCL-CODE." - (save-excursion - (set-buffer (get-buffer-create "*CCL-Dump*")) - (erase-buffer) - (setq ccl-program-vector-dump ccl-code) - (let ((len (length ccl-code))) - (insert "Main:\n") - (setq ccl-current-ic 1) - (if (> (aref ccl-code 0) 0) - (progn - (while (< ccl-current-ic (aref ccl-code 0)) - (ccl-dump-1)) - (insert "At EOF:\n"))) - (while (< ccl-current-ic len) - (ccl-dump-1)) - )) - (display-buffer (get-buffer "*CCL-Dump*"))) + (let ((len (length ccl-code)) + (buffer-mag (aref ccl-code 0))) + (cond ((= buffer-mag 0) + (insert "Don't output anything.\n")) + ((= buffer-mag 1) + (insert "Out-buffer must be as large as in-buffer.\n")) + (t + (insert + (format "Out-buffer must be %d times bigger than in-buffer.\n" + buffer-mag)))) + (insert "Main-body:\n") + (setq ccl-current-ic 2) + (if (> (aref ccl-code 1) 0) + (progn + (while (< ccl-current-ic (aref ccl-code 1)) + (ccl-dump-1)) + (insert "At EOF:\n"))) + (while (< ccl-current-ic len) + (ccl-dump-1)) + )) +;; Return a CCL code in `ccl-code' at `ccl-current-ic'. (defun ccl-get-next-code () (prog1 - (aref ccl-program-vector-dump ccl-current-ic) + (aref ccl-code ccl-current-ic) (setq ccl-current-ic (1+ ccl-current-ic)))) (defun ccl-dump-1 () - (let* ((opcode (ccl-get-next-code)) - (code (logand opcode 31)) - (cmd (aref ccl-machine-code-table code)) - (rrr (logand (ash opcode -5) 7)) - (cc (ash opcode -8))) - (insert (format "%4d: " (1- ccl-current-ic))) + (let* ((code (ccl-get-next-code)) + (cmd (aref ccl-code-table (logand code 31))) + (rrr (ash (logand code 255) -5)) + (cc (ash code -8))) + (insert (format "%5d:[%s] " (1- ccl-current-ic) cmd)) (funcall (get cmd 'ccl-dump-function) rrr cc))) -(defun ccl-dump-set-cs (rrr cc) - (insert (format "r%d = %s\n" rrr cc))) - -(defun ccl-dump-set-cl (rrr cc) - (setq cc (ccl-get-next-code)) - (insert (format "r%d = %s\n" rrr cc))) - -(defun ccl-dump-set-r (rrr cc) +(defun ccl-dump-set-register (rrr cc) (insert (format "r%d = r%d\n" rrr cc))) -(defun ccl-dump-set-a (rrr cc) - (let ((range (ccl-get-next-code)) (i 0)) - (insert (format "r%d = array[r%d] of length %d\n\t" - rrr cc range)) - (let ((i 0)) - (while (< i range) - (insert (format "%d " (ccl-get-next-code))) - (setq i (1+ i)))) - (insert "\n"))) +(defun ccl-dump-set-short-const (rrr cc) + (insert (format "r%d = %d\n" rrr cc))) -(defun ccl-dump-jump (rrr cc) - (insert (format "jump to %d\n" cc))) - -(defun ccl-dump-jump-cond (rrr cc) - (insert (format "if !(r%d), jump to %d\n" rrr cc))) - -(defun ccl-dump-write-jump (rrr cc) - (insert (format "write r%d, jump to %d\n" rrr cc))) - -(defun ccl-dump-write-read-jump (rrr cc) - (insert (format "write r%d, read r%d, jump to %d\n" rrr rrr cc))) +(defun ccl-dump-set-const (rrr ignore) + (insert (format "r%d = %d\n" rrr (ccl-get-next-code)))) -(defun ccl-dump-write-c-jump (rrr cc) - (let ((const (ccl-get-next-code))) - (insert (format "write %s, jump to %d\n" const cc)))) - -(defun ccl-dump-write-c-read-jump (rrr cc) - (let ((const (ccl-get-next-code))) - (insert (format "write %s, read r%d, jump to %d\n" const rrr cc)))) - -(defun ccl-dump-write-s-jump (rrr cc) - (let ((len (ccl-get-next-code)) (i 0)) - (insert "write \"") - (while (< i len) - (insert (format "%c" (ccl-get-next-code))) - (setq i (1+ i))) - (insert (format "\", jump to %d\n" cc)))) - -(defun ccl-dump-write-s-read-jump (rrr cc) - (let ((len (ccl-get-next-code)) (i 0)) - (insert "write \"") - (while (< i len) - (insert (format "%c" (ccl-get-next-code))) - (setq i (1+ i))) - (insert (format "\", read r%d, jump to %d\n" rrr cc)))) - -(defun ccl-dump-write-a-read-jump (rrr cc) - (let ((len (ccl-get-next-code)) (i 0)) - (insert (format "write array[r%d] of length %d, read r%d, jump to %d\n\t" - rrr len rrr cc)) +(defun ccl-dump-set-array (rrr cc) + (let ((rrr2 (logand cc 7)) + (len (ash cc -3)) + (i 0)) + (insert (format "r%d = array[r%d] of length %d\n\t" + rrr rrr2 len)) (while (< i len) (insert (format "%d " (ccl-get-next-code))) (setq i (1+ i))) (insert "\n"))) -(defun ccl-dump-branch (rrr cc) - (let ((i 0)) - (insert (format "jump to array[r%d] of length %d)\n\t" rrr cc)) - (while (<= i cc) - (insert (format "%d " (ccl-get-next-code))) - (setq i (1+ i))) - (insert "\n"))) +(defun ccl-dump-jump (ignore cc &optional address) + (insert (format "jump to %d(" (+ (or address ccl-current-ic) cc))) + (if (>= cc 0) + (insert "+")) + (insert (format "%d)\n" (1+ cc)))) + +(defun ccl-dump-jump-cond (rrr cc) + (insert (format "if (r%d == 0), " rrr)) + (ccl-dump-jump nil cc)) + +(defun ccl-dump-write-register-jump (rrr cc) + (insert (format "write r%d, " rrr)) + (ccl-dump-jump nil cc)) -(defun ccl-dump-read1 (rrr cc) - (insert (format "read r%d\n" rrr))) +(defun ccl-dump-write-register-read-jump (rrr cc) + (insert (format "write r%d, read r%d, " rrr rrr)) + (ccl-dump-jump nil cc) + (ccl-get-next-code) ; Skip dummy READ-JUMP + ) -(defun ccl-dump-read2 (rrr cc) - (insert (format "read r%d and r%d\n" rrr cc))) +(defun ccl-extract-arith-op (cc) + (aref ccl-arith-table (ash cc -6))) + +(defun ccl-dump-write-expr-const (ignore cc) + (insert (format "write (r%d %s %d)\n" + (logand cc 7) + (ccl-extract-arith-op cc) + (ccl-get-next-code)))) -(defun ccl-dump-read-branch (rrr cc) - (insert (format "read r%d, " rrr)) - (ccl-dump-branch rrr cc)) +(defun ccl-dump-write-expr-register (ignore cc) + (insert (format "write (r%d %s r%d)\n" + (logand cc 7) + (ccl-extract-arith-op cc) + (logand (ash cc -3) 7)))) -(defun ccl-dump-write1 (rrr cc) - (insert (format "write r%d\n" rrr))) +(defun ccl-dump-insert-char (cc) + (cond ((= cc ?\t) (insert " \"^I\"")) + ((= cc ?\n) (insert " \"^J\"")) + (t (insert (format " \"%c\"" cc))))) -(defun ccl-dump-write2 (rrr cc) - (insert (format "write r%d and r%d\n" rrr cc))) +(defun ccl-dump-write-const-jump (ignore cc) + (let ((address ccl-current-ic)) + (insert "write char") + (ccl-dump-insert-char (ccl-get-next-code)) + (insert ", ") + (ccl-dump-jump nil cc address))) -(defun ccl-dump-write-c (rrr cc) - (insert (format "write %s\n" (ccl-get-next-code)))) +(defun ccl-dump-write-const-read-jump (rrr cc) + (let ((address ccl-current-ic)) + (insert "write char") + (ccl-dump-insert-char (ccl-get-next-code)) + (insert (format ", read r%d, " rrr)) + (ccl-dump-jump cc address) + (ccl-get-next-code) ; Skip dummy READ-JUMP + )) -(defun ccl-dump-write-s (rrr cc) - (let ((len (ccl-get-next-code)) (i 0)) +(defun ccl-dump-write-string-jump (ignore cc) + (let ((address ccl-current-ic) + (len (ccl-get-next-code)) + (i 0)) (insert "write \"") (while (< i len) - (insert (format "%c" (ccl-get-next-code))) - (setq i (1+ i))) - (insert "\"\n"))) + (let ((code (ccl-get-next-code))) + (insert (ash code -16)) + (if (< (1+ i) len) (insert (logand (ash code -8) 255))) + (if (< (+ i 2) len) (insert (logand code 255)))) + (setq i (+ i 3))) + (insert "\", ") + (ccl-dump-jump nil cc address))) -(defun ccl-dump-write-a (rrr cc) - (let ((len (ccl-get-next-code)) (i 0)) - (insert (format "write array[r%d] of length %d\n\t" rrr len)) - (while (< i 0) - (insert "%d " (ccl-get-next-code)) +(defun ccl-dump-write-array-read-jump (rrr cc) + (let ((address ccl-current-ic) + (len (ccl-get-next-code)) + (i 0)) + (insert (format "write array[r%d] of length %d,\n\t" rrr len)) + (while (< i len) + (ccl-dump-insert-char (ccl-get-next-code)) + (setq i (1+ i))) + (insert (format "\n\tthen read r%d, " rrr)) + (ccl-dump-jump nil cc address) + (ccl-get-next-code) ; Skip dummy READ-JUMP. + )) + +(defun ccl-dump-read-jump (rrr cc) + (insert (format "read r%d, " rrr)) + (ccl-dump-jump nil cc)) + +(defun ccl-dump-branch (rrr len) + (let ((jump-table-head ccl-current-ic) + (i 0)) + (insert (format "jump to array[r%d] of length %d\n\t" rrr len)) + (while (<= i len) + (insert (format "%d " (+ jump-table-head (ccl-get-next-code)))) (setq i (1+ i))) (insert "\n"))) -(defun ccl-dump-end (rrr cc) +(defun ccl-dump-read-register (rrr cc) + (insert (format "read r%d (%d remaining)\n" rrr cc))) + +(defun ccl-dump-read-branch (rrr len) + (insert (format "read r%d, " rrr)) + (ccl-dump-branch rrr len)) + +(defun ccl-dump-write-register (rrr cc) + (insert (format "write r%d (%d remaining)\n" rrr cc))) + +(defun ccl-dump-call (ignore cc) + (insert (format "call subroutine #%d\n" cc))) + +(defun ccl-dump-write-const-string (rrr cc) + (if (= rrr 0) + (progn + (insert "write char") + (ccl-dump-insert-char cc) + (newline)) + (let ((len cc) + (i 0)) + (insert "write \"") + (while (< i len) + (let ((code (ccl-get-next-code))) + (insert (format "%c" (lsh code -16))) + (if (< (1+ i) len) + (insert (format "%c" (logand (lsh code -8) 255)))) + (if (< (+ i 2) len) + (insert (format "%c" (logand code 255)))) + (setq i (+ i 3)))) + (insert "\"\n")))) + +(defun ccl-dump-write-array (rrr cc) + (let ((i 0)) + (insert (format "write array[r%d] of length %d\n\t" rrr cc)) + (while (< i cc) + (ccl-dump-insert-char (ccl-get-next-code)) + (setq i (1+ i))) + (insert "\n"))) + +(defun ccl-dump-end (&rest ignore) (insert "end\n")) -(defun ccl-dump-set-self-cs (rrr cc) - (let ((arith (aref ccl-arith-table (ccl-get-next-code)))) - (insert (format "r%d %s= %s\n" rrr arith cc)))) +(defun ccl-dump-set-assign-expr-const (rrr cc) + (insert (format "r%d %s= %d\n" + rrr + (ccl-extract-arith-op cc) + (ccl-get-next-code)))) -(defun ccl-dump-set-self-cl (rrr cc) - (setq cc (ccl-get-next-code)) - (let ((arith (aref ccl-arith-table (ccl-get-next-code)))) - (insert (format "r%d %s= %s\n" rrr arith cc)))) +(defun ccl-dump-set-assign-expr-register (rrr cc) + (insert (format "r%d %s= r%d\n" + rrr + (ccl-extract-arith-op cc) + (logand cc 7)))) -(defun ccl-dump-set-self-r (rrr cc) - (let ((arith (aref ccl-arith-table (ccl-get-next-code)))) - (insert (format "r%d %s= r%d\n" rrr arith cc)))) +(defun ccl-dump-set-expr-const (rrr cc) + (insert (format "r%d = r%d %s %d\n" + rrr + (logand cc 7) + (ccl-extract-arith-op cc) + (ccl-get-next-code)))) -(defun ccl-dump-set-expr-cl (rrr cc) - (let ((const (ccl-get-next-code)) - (arith (aref ccl-arith-table (ccl-get-next-code)))) - (insert (format "r%d = r%d %s %s\n" rrr cc arith const)))) +(defun ccl-dump-set-expr-register (rrr cc) + (insert (format "r%d = r%d %s r%d\n" + rrr + (logand cc 7) + (ccl-extract-arith-op cc) + (logand (ash cc -3) 7)))) -(defun ccl-dump-set-expr-r (rrr cc) - (let ((reg (ccl-get-next-code)) - (arith (aref ccl-arith-table (ccl-get-next-code)))) - (insert (format "r%d = r%d %s r%d\n" rrr cc arith reg)))) +(defun ccl-dump-jump-cond-expr-const (rrr cc) + (let ((address ccl-current-ic)) + (insert (format "if !(r%d %s %d), " + rrr + (aref ccl-arith-table (ccl-get-next-code)) + (ccl-get-next-code))) + (ccl-dump-jump nil cc address))) -(defun ccl-dump-jump-cond-c (rrr cc) - (let ((const (ccl-get-next-code)) - (arith (aref ccl-arith-table (ccl-get-next-code)))) - (insert (format "if !(r%d %s %s), jump to %d\n" rrr arith const cc)))) +(defun ccl-dump-jump-cond-expr-register (rrr cc) + (let ((address ccl-current-ic)) + (insert (format "if !(r%d %s r%d), " + rrr + (aref ccl-arith-table (ccl-get-next-code)) + (ccl-get-next-code))) + (ccl-dump-jump nil cc address))) -(defun ccl-dump-jump-cond-r (rrr cc) - (let ((reg (ccl-get-next-code)) - (arith (aref ccl-arith-table (ccl-get-next-code)))) - (insert (format "if !(r%d %s r%d), jump to %d\n" rrr arith reg cc)))) +(defun ccl-dump-read-jump-cond-expr-const (rrr cc) + (insert (format "read r%d, " rrr)) + (ccl-dump-jump-cond-expr-const rrr cc)) + +(defun ccl-dump-read-jump-cond-expr-register (rrr cc) + (insert (format "read r%d, " rrr)) + (ccl-dump-jump-cond-expr-register rrr cc)) -(defun ccl-dump-read-jump-cond-c (rrr cc) - (insert (format "read r%d, " rrr)) - (ccl-dump-jump-cond-c rrr cc)) - -(defun ccl-dump-read-jump-cond-r (rrr cc) - (insert (format "read r%d, " rrr)) - (ccl-dump-jump-cond-r rrr cc)) +(defun ccl-dump-binary (ccl-code) + (let ((len (length ccl-code)) + (i 2)) + (while (< i len) + (let ((code (aref ccl-code i)) + (j 27)) + (while (>= j 0) + (insert (if (= (logand code (ash 1 j)) 0) ?0 ?1)) + (setq j (1- j))) + (setq code (logand code 31)) + (if (< code (length ccl-code-table)) + (insert (format ":%s" (aref ccl-code-table code)))) + (insert "\n")) + (setq i (1+ i))))) ;; CCL emulation staffs ;; Not yet implemented. + +;;;###autoload +(defmacro declare-ccl-program (name) + "Declare NAME as a name of CCL program. -;; For byte-compiler +To compile a CCL program which calls another CCL program not yet +defined, it must be declared as a CCL program in advance." + `(put ',name 'ccl-program-idx (register-ccl-program ',name nil))) ;;;###autoload (defmacro define-ccl-program (name ccl-program &optional doc) - "Does (defconst NAME (ccl-compile (eval CCL-PROGRAM)) DOC). -Byte-compiler expand this macro while compiling." - (` (defconst (, name) (, (ccl-compile (eval ccl-program))) (, doc)))) + "Set NAME the compiled code of CCL-PROGRAM. +CCL-PROGRAM is `eval'ed before being handed to the CCL compiler `ccl-compile'. +The compiled code is a vector of integers." + `(let ((prog ,(ccl-compile (eval ccl-program)))) + (defconst ,name prog ,doc) + (put ',name 'ccl-program-idx (register-ccl-program ',name prog)) + nil)) -(put 'define-ccl-program 'byte-hunk-handler 'macroexpand) +;;;###autoload +(defun ccl-execute-with-args (ccl-prog &rest args) + "Execute CCL-PROGRAM with registers initialized by the remaining args. +The return value is a vector of resulting CCL registeres." + (let ((reg (make-vector 8 0)) + (i 0)) + (while (and args (< i 8)) + (if (not (integerp (car args))) + (error "Arguments should be integer")) + (aset reg i (car args)) + (setq args (cdr args) i (1+ i))) + (ccl-execute ccl-prog reg) + reg)) (provide 'ccl) + +;; ccl.el ends here diff -r d8688acf4c5b -r 78f53ef88e17 lisp/mule/mule-cmds.el --- a/lisp/mule/mule-cmds.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/mule/mule-cmds.el Mon Aug 13 10:06:47 2007 +0200 @@ -208,12 +208,14 @@ ;; t) (if (consp info) (setq info (car info))) - (eval-after-load "x-menubar" - `(add-menu-button - '("Mule" "Describe Language Support") - (vector ,language-name - '(describe-language-environment ,language-name) - t))) + (when (featurep 'menubar) + (eval-after-load + "x-menubar" + `(add-menu-button + '("Mule" "Describe Language Support") + (vector ,language-name + '(describe-language-environment ,language-name) + t)))) ) ((eq key 'setup-function) ;; (define-key-after @@ -226,12 +228,14 @@ ;; t) (if (consp info) (setq info (car info))) - (eval-after-load "x-menubar" - `(add-menu-button - '("Mule" "Set Language Environment") - (vector ,language-name - '(set-language-environment ,language-name) - t))) + (when (featurep 'menubar) + (eval-after-load + "x-menubar" + `(add-menu-button + '("Mule" "Set Language Environment") + (vector ,language-name + '(set-language-environment ,language-name) + t)))) )) (setcdr key-slot info) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/packages.el --- a/lisp/packages.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/packages.el Mon Aug 13 10:06:47 2007 +0200 @@ -137,8 +137,8 @@ ;; Source directory may not be initialized yet. ;; (print (prin1-to-string load-path)) (if (null source-directory) - (setq source-directory (concat (car load-path) "/.."))) - (let ((files (directory-files source-directory t ".*")) + (setq source-directory (concat (car load-path) "/./"))) + (let ((files (directory-files (file-name-as-directory source-directory) t ".*")) file autolist) (while (setq file (car-safe files)) (if (and (file-directory-p file) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/packages/backup-dir.el --- a/lisp/packages/backup-dir.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/packages/backup-dir.el Mon Aug 13 10:06:47 2007 +0200 @@ -1,5 +1,5 @@ ;;; BACKUP-DIR.EL: Emacs functions to allow backup files to live in -;;; some other directory(s). Version 2.0 +;;; some other directory(s). Version 2.1 ;;; ;;; Copyright (C) 1992-97 Greg Klanderman ;;; @@ -23,6 +23,14 @@ ;;; Modification History ;;; ==================== ;;; +;;; 10/27/1997 Version 2.1 +;;; Updated to support GNU Emacs 20.2. The function `backup-extract-version' +;;; now uses the free variable `backup-extract-version-start' rather than +;;; `bv-length'. Note, we continue to support older GNU Emacs and XEmacsen. +;;; +;;; 10/22/1997 +;;; Customization by Karl M. Hegbloom +;;; ;;; 12/28/1996 Version 2.0 ;;; Updated for XEmacs 19.15b4, much of code reorganized & cleaned up ;;; @@ -84,7 +92,9 @@ ;;; (require 'backup-dir) ;;; (setq bkup-backup-directory-info ;;; '(("/home/greg/.*" "/~/.backups/" ok-create full-path) -;;; (t ".backups/" full-path search-upward))) +;;; ("^/[^/:]+:" ".backups/") ; handle EFS files specially: we don't +;;; ("^/[^/:]+:" "./") ; want to search-upward... its very slow +;;; (t ".backups/" full-path search-upward))) ;;; ;;; ;;; The package also provides a new function, `find-file-latest-backup' to find @@ -133,19 +143,20 @@ Once you save this variable with `M-x customize-variable', `backup-dir' will be loaded for you each time you start XEmacs." :type '(repeat - (list (regexp :tag "File regexp") - (string :tag "Backup Dir") - (set :inline t - (const ok-create) - (const full-path) - (const search-upward)))) + (list (regexp :tag "File regexp") + (string :tag "Backup Dir") + (set :inline t + (const ok-create) + (const full-path) + (const search-upward)))) :require 'backup-dir :group 'backup) + ;;; New functions ;;; (defun bkup-search-upward-for-backup-dir (base bd-name) - "search upward for a directory named BD-NAME, starting in the + "Search upward for a directory named BD-NAME, starting in the directory BASE and continuing with its parent directories until one is found or the root is reached." (let ((prev nil) (curr base) (gotit nil) (tryit nil)) @@ -174,7 +185,7 @@ ns)) (defun bkup-try-making-directory (dir) - "try making directory DIR, return non-nil if successful" + "Try making directory DIR, return non-nil if successful" (condition-case () (progn (make-directory dir t) t) @@ -368,7 +379,8 @@ (bk-base (cdr dir-n-base)) ;add (base-versions (concat bk-base ".~")) ;mod ;; used by backup-extract-version: - (bv-length (length base-versions)) + (bv-length (length base-versions)) ;; older GNU Emacsen and XEmacs + (backup-extract-version-start (length base-versions)) ;; new GNU Emacs (20.2) possibilities (versions nil) (high-water-mark 0) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/packages/compile.el --- a/lisp/packages/compile.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/packages/compile.el Mon Aug 13 10:06:47 2007 +0200 @@ -127,38 +127,11 @@ (defvar compilation-num-errors-found) -(defcustom compilation-error-regexp-systems-list 'all - "*This is either the symbol `all', or a list of systems for which -compilation error regexps should be included in -`compilation-error-regexp-alist'. - -The list of known systems is: - gnu: but of course - lcc: Lucid compilers - ada: Ada compilers - of: Using tool that says line xx of foo.c - comma: Using tool that says \"foo.c\", line 12 - 4bsd: Using 4bsd - msft: Using microsoft - borland: Using Borland - mips: Using Mips - sgi: Using SGI - cray: Using Cray - ibm: IBM C compilers - aix: the operating system - ultrix: the operating system - -See also the variable `compilation-error-regexp-alist-alist'." - :type '(choice (const all) - (set :menu-tag "Pick" - (const gnu) (const lcc) (const ada) - (const of) (const comma) (const 4bsd) - (const msft) (const borland) (const mips) - (const sgi) (const cray) (const ibm) - (const aix) (const ultrix))) - :group 'compilation) - (defun compilation-build-compilation-error-regexp-alist () + "Set the regular expressions used for parsing compiler +errors based on the compilers listed in the variable +`compilation-error-regexp-systems-list'. Updates the +variable `compilation-error-regexp-alist'." (interactive) (setq compilation-error-regexp-alist (apply 'append @@ -357,6 +330,42 @@ `compilation-build-compilation-error-regexp-alist' using the value of the variable `compilation-error-regexp-alist-alist'") +(defcustom compilation-error-regexp-systems-list 'all + "*This is either the symbol `all', or a list of systems for which +compilation error regexps should be included in +`compilation-error-regexp-alist'. You must run the function +`compilation-build-compilation-error-regexp-alist' after changing +the value of this variable for the change to take effect. + +The list of known systems is: + gnu: but of course + lcc: Lucid compilers + ada: Ada compilers + of: Using tool that says line xx of foo.c + comma: Using tool that says \"foo.c\", line 12 + 4bsd: Using 4bsd + msft: Using microsoft + borland: Using Borland + mips: Using Mips + sgi: Using SGI + cray: Using Cray + ibm: IBM C compilers + aix: the operating system + ultrix: the operating system + +See also the variable `compilation-error-regexp-alist-alist'." + :type '(choice (const all) + (set :menu-tag "Pick" + (const gnu) (const lcc) (const ada) + (const of) (const comma) (const 4bsd) + (const msft) (const borland) (const mips) + (const sgi) (const cray) (const ibm) + (const aix) (const ultrix))) + :set (lambda (symbol value) + (set-default symbol value) + (compilation-build-compilation-error-regexp-alist)) + :group 'compilation) + (compilation-build-compilation-error-regexp-alist) (defcustom compilation-read-command t @@ -458,7 +467,7 @@ (put 'compilation-mode 'font-lock-defaults '(compilation-font-lock-keywords t)) -(defcustom compilation-mouse-motion-initiate-parsing t +(defcustom compilation-mouse-motion-initiate-parsing nil "*Should mouse motion over the compilation buffer initiate parsing? When set to a non-nil value, mouse motion over the compilation/grep buffer may initiate parsing of the error messages or grep hits. diff -r d8688acf4c5b -r 78f53ef88e17 lisp/packages/custom-load.el --- a/lisp/packages/custom-load.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/packages/custom-load.el Mon Aug 13 10:06:47 2007 +0200 @@ -65,7 +65,7 @@ (custom-add-loads 'programming '("compile")) (custom-add-loads 'metamail '("metamail")) (custom-add-loads 'icomplete '("icomplete")) -(custom-add-loads 'compilation '("compile")) +(custom-add-loads 'compilation '("compile" "auto-autoloads")) (custom-add-loads 'iswitchb '("iswitchb")) (custom-add-loads 'makeinfo '("makeinfo")) (custom-add-loads 'fume '("func-menu")) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/packages/font-lock.el --- a/lisp/packages/font-lock.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/packages/font-lock.el Mon Aug 13 10:06:47 2007 +0200 @@ -1183,11 +1183,16 @@ ;; Apply each highlight to this instance of `matcher', which may be ;; specific highlights or more keywords anchored to `matcher'. (setq highlights (cdr keyword)) - (while highlights - (if (numberp (car (car highlights))) - (font-lock-apply-highlight (car highlights)) - (font-lock-fontify-anchored-keywords (car highlights) end)) - (setq highlights (cdr highlights)))) + (while highlights + (if (numberp (car (car highlights))) + (let ((end (match-end (car (car highlights))))) + (font-lock-apply-highlight (car highlights)) + ;; restart search just after the end of the + ;; keyword so keywords can share bracketing + ;; expressions. + (and end (goto-char end))) + (font-lock-fontify-anchored-keywords (car highlights) end)) + (setq highlights (cdr highlights)))) (setq keywords (cdr keywords)))) (if loudly (display-message 'progress diff -r d8688acf4c5b -r 78f53ef88e17 lisp/packages/igrep.el --- a/lisp/packages/igrep.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/packages/igrep.el Mon Aug 13 10:06:47 2007 +0200 @@ -103,7 +103,7 @@ ;;; (autoload (function dired-do-grep-find) "igrep" ;;; "*Run `grep` via `find` on the marked (or next prefix ARG) directories." t) ;;; 3. If you are running Windows 95/NT, you should install findutils -;;; and grep from release 17.1 (or higher) of the Cygnus GNU-Win32 +;;; and grep from release 17.1 (or higher) of the Cygnus cygwin32 ;;; distribution. See . ;;; Usage: @@ -329,7 +329,7 @@ (defalias 'dired-do-grep-find 'dired-do-igrep-find)) -(defvar win32-quote-process-args) ; XEmacs +(defvar mswindows-quote-process-args) ; XEmacs ;;;###autoload (defun igrep (program expression files &optional options) @@ -379,7 +379,7 @@ ;; (restricted, job-control, or standard) Bourne shell doesn't expand ~: (setq files (mapcar 'expand-file-name files))) - (let* ((win32-quote-process-args nil) ; work around NT Emacs hack + (let* ((mswindows-quote-process-args nil) ; work around NT Emacs hack (use-zgrep (cond ((eq igrep-use-zgrep t)) (igrep-use-zgrep (let ((files files) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/prim/about.el --- a/lisp/prim/about.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/prim/about.el Mon Aug 13 10:06:47 2007 +0200 @@ -257,7 +257,7 @@ firewalls) in order to work correctly. XEmacs is the result of the time and effort of many people. The -developers responsible for the 20.3 release are:\n\n") +developers responsible for the 20.4 release are:\n\n") (flet ((setup-person (who) (widget-insert "\t* ") @@ -273,7 +273,7 @@ :value who) (widget-insert (format " <%s>\n" address))))) ;; Setup persons responsible for this release. - (mapc 'setup-person '(slb mrb hniksic)) + (mapc 'setup-person '(slb hniksic kyle mrb)) (widget-insert "\n\t* ") (widget-create 'link :help-echo "A legion of XEmacs hackers" :action 'about-hackers diff -r d8688acf4c5b -r 78f53ef88e17 lisp/prim/dumped-lisp.el --- a/lisp/prim/dumped-lisp.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/prim/dumped-lisp.el Mon Aug 13 10:06:47 2007 +0200 @@ -154,9 +154,9 @@ #+x "x-misc" #+x "x-init" #+(and x toolbar) "x-toolbar" -;; preload the w32gui code. - #+w32 "w32-faces" - #+w32 "w32-init" +;; preload the mswindows code. + #+mswindows "msw-faces" + #+mswindows "msw-init" ;; preload the TTY init code. #+tty "tty-init" ;;; Formerly in tooltalk/tooltalk-load.el diff -r d8688acf4c5b -r 78f53ef88e17 lisp/utils/font.el --- a/lisp/utils/font.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/utils/font.el Mon Aug 13 10:06:47 2007 +0200 @@ -46,7 +46,8 @@ (if (not (fboundp 'try-font-name)) (defun try-font-name (fontname &rest args) (case window-system - ((x win32 w32 pm) (car-safe (x-list-fonts fontname))) + ((x pm) (car-safe (x-list-fonts fontname))) + (mswindows (car-safe (x-list-fonts fontname))) ; XXX FIXME (ns (car-safe (ns-list-fonts fontname))) (otherwise nil)))) @@ -97,12 +98,11 @@ (setq keywords (cdr keywords))))))) (defconst font-window-system-mappings - '((x . (x-font-create-name x-font-create-object)) - (ns . (ns-font-create-name ns-font-create-object)) - (win32 . (x-font-create-name x-font-create-object)) - (w32 . (x-font-create-name x-font-create-object)) - (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME - (tty . (tty-font-create-plist tty-font-create-object))) + '((x . (x-font-create-name x-font-create-object)) + (ns . (ns-font-create-name ns-font-create-object)) + (mswindows . (x-font-create-name x-font-create-object)) ; XXX FIXME + (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME + (tty . (tty-font-create-plist tty-font-create-object))) "An assoc list mapping device types to the function used to create a font name from a font structure.") @@ -1139,15 +1139,10 @@ (case (device-type device) ((x pm) (apply 'format "#%02x%02x%02x" (font-color-rgb-components color))) - (win32 + (mswindows (let* ((rgb (font-color-rgb-components color)) (color (apply 'format "#%02x%02x%02x" rgb))) - (win32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) - color)) - (w32 - (let* ((rgb (font-color-rgb-components color)) - (color (apply 'format "#%02x%02x%02x" rgb))) - (w32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) + (mswindows-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) color)) (tty (apply 'font-tty-find-closest-color (font-color-rgb-components color))) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/utils/hippie-exp.el --- a/lisp/utils/hippie-exp.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/utils/hippie-exp.el Mon Aug 13 10:06:47 2007 +0200 @@ -495,7 +495,7 @@ (string= (substring name-part 0 2) "[.")) (concat (substring dir-part 0 -1) (substring name-part 1)) (concat dir-part name-part))) - ((memq system-type '(ms-dos w32)) + ((memq system-type '(ms-dos mswindows)) (if (and (string-match "\\\\" dir-part) (not (string-match "/" dir-part)) (= (aref name-part (1- (length name-part))) ?/)) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/utils/sysdep.el --- a/lisp/utils/sysdep.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/utils/sysdep.el Mon Aug 13 10:06:47 2007 +0200 @@ -367,20 +367,20 @@ "Create a frame of type TYPE on CONNECTION. TYPE should be a symbol naming the device type, i.e. one of -x An X display. CONNECTION should be a standard display string - such as \"unix:0\", or nil for the display specified on the - command line or in the DISPLAY environment variable. Only if - support for X was compiled into XEmacs. -tty A standard TTY connection or terminal. CONNECTION should be - a TTY device name such as \"/dev/ttyp2\" (as determined by - the Unix command `tty') or nil for XEmacs' standard input - and output (usually the TTY in which XEmacs started). Only - if support for TTY's was compiled into XEmacs. -ns A connection to a machine running the NeXTstep windowing - system. Not currently implemented. -win32 A connection to a machine running Microsoft Windows NT or - Windows 95. Not currently implemented. -pc A direct-write MS-DOS frame. Not currently implemented. +x An X display. CONNECTION should be a standard display string + such as \"unix:0\", or nil for the display specified on the + command line or in the DISPLAY environment variable. Only if + support for X was compiled into XEmacs. +tty A standard TTY connection or terminal. CONNECTION should be + a TTY device name such as \"/dev/ttyp2\" (as determined by + the Unix command `tty') or nil for XEmacs' standard input + and output (usually the TTY in which XEmacs started). Only + if support for TTY's was compiled into XEmacs. +ns A connection to a machine running the NeXTstep windowing + system. Not currently implemented. +mswindows A connection to a machine running Microsoft Windows NT or + Windows 95/97. +pc A direct-write MS-DOS frame. Not currently implemented. PROPS should be a plist of properties, as in the call to `make-frame'. @@ -625,7 +625,7 @@ Value is `tty' for a tty device (a character-only terminal), `x' for a device which is a connection to an X server, 'ns' for a device which is a connection to a NeXTStep dps server, -'win32' for a Windows-NT window, +'mswindows' for a MSWindows window, 'pm' for an OS/2 Presentation Manager window, 'intuition' for an Amiga screen" (device-or-frame-type device)) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/w32/w32-faces.el --- a/lisp/w32/w32-faces.el Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,105 +0,0 @@ -;;; w32-faces.el --- win32-specific face stuff. - -;;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. -;;; Copyright (C) 1995, 1996 Ben Wing. - -;; Author: Jamie Zawinski -;; Modified by: Chuck Thompson -;; Modified by: Ben Wing -;; Modified by: Martin Buchholz -;; Rewritten for win32 by: Jonathan Harris - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs 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 -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;; This file does the magic to parse w32 font names, and make sure that the -;; default and modeline attributes of new frames are specified enough. - -(defun w32-init-global-faces () - ) - -;;; ensure that the default face has some reasonable fallbacks if nothing -;;; else is specified. -(defun w32-init-device-faces (device) - (or (face-font 'default 'global) - (set-face-font 'default "Courier New:Regular:10") - 'global) - (or (face-foreground 'default 'global) - (set-face-foreground 'default "black" 'global 'w32)) - (or (face-background 'default 'global) - (set-face-background 'default "white" 'global 'w32)) - (or (face-background 'modeline 'global) - (set-face-background 'modeline "grey" 'global 'w32)) - ) - - -(defun w32-init-frame-faces (frame) - ) - - -;;; Fill in missing parts of a font spec. This is primarily intended as a -;;; helper function for the functions below. -;;; w32 fonts look like: -;;; fontname[:[weight ][style][:pointsize[:effects[:charset]]]] -;;; A minimal w32 font spec looks like: -;;; Courier New -;;; A maximal w32 font spec looks like: -;;; Courier New:Bold Italic:10:underline strikeout:ansi -;;; Missing parts of the font spec should be filled in with these values: -;;; Courier New:Normal:10::ansi -(defun w32-canicolize-font (font &optional device) - "Given a win32 font specification, this converts it to canonical form." - nil) - -(defun w32-make-font-bold (font &optional device) - "Given a win32 font specification, this attempts to make a bold font. -If it fails, it returns nil." - nil) - -(defun w32-make-font-unbold (font &optional device) - "Given a win32 font specification, this attempts to make a non-bold font. -If it fails, it returns nil." - nil) - -(defun w32-make-font-italic (font &optional device) - "Given a win32 font specification, this attempts to make an `italic' font. -If it fails, it returns nil." - nil) - -(defun w32-make-font-unitalic (font &optional device) - "Given a win32 font specification, this attempts to make a non-italic font. -If it fails, it returns nil." - nil) - -(defun w32-make-font-bold-italic (font &optional device) - "Given a win32 font specification, this attempts to make a `bold-italic' -font. If it fails, it returns nil." - nil) - -(defun w32-find-smaller-font (font &optional device) - "Loads a new, version of the given font (or font name). -Returns the font if it succeeds, nil otherwise. -If scalable fonts are available, this returns a font which is 1 point smaller. -Otherwise, it returns the next smaller version of this font that is defined." - nil) - -(defun w32-find-larger-font (font &optional device) - "Loads a new, slightly larger version of the given font (or font name). -Returns the font if it succeeds, nil otherwise. -If scalable fonts are available, this returns a font which is 1 point larger. -Otherwise, it returns the next larger version of this font that is defined." - nil) diff -r d8688acf4c5b -r 78f53ef88e17 lisp/w32/w32-init.el --- a/lisp/w32/w32-init.el Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,47 +0,0 @@ -;;; w32-init.el --- initialization code for win32 -;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. -;; Copyright (C) 1995 Board of Trustees, University of Illinois. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Author: various -;; Rewritten for win32 by: Jonathan Harris - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs 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 -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -(defvar w32-win-initted nil) -(defvar w32-pre-win-initted nil) -(defvar w32-post-win-initted nil) - -(defun init-pre-w32-win () - "Initialize win32 GUI at startup (pre). Don't call this." - (unless w32-pre-win-initted - (setq w32-pre-win-initted t))) - -(defun init-w32-win () - "Initialize win32 GUI at startup. Don't call this." - (unless w32-win-initted - (init-pre-w32-win) - (make-w32-device) - (init-post-w32-win (selected-console)) - (setq w32-win-initted t))) - -(defun init-post-w32-win (console) - "Initialize win32 GUI at startup (post). Don't call this." - (unless w32-post-win-initted - (setq w32-post-win-initted t))) - diff -r d8688acf4c5b -r 78f53ef88e17 lisp/wid-edit.el --- a/lisp/wid-edit.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/wid-edit.el Mon Aug 13 10:06:47 2007 +0200 @@ -1414,6 +1414,13 @@ ;; The change begins in one fields, and ends in another one. (add-hook 'post-command-hook 'widget-add-change nil t) (error "Change should be restricted to a single field")) + ((or (and from-field + (get-char-property from 'widget-inactive)) + (and to-field + (get-char-property to 'widget-inactive))) + ;; Trying to change an inactive editable field. + (add-hook 'post-command-hook 'widget-add-change nil t) + (error "Attempt to change an inactive field")) (widget-field-use-before-change ;; #### Bletch! This loses because XEmacs get confused ;; if before-change-functions change the contents of diff -r d8688acf4c5b -r 78f53ef88e17 lisp/x-menubar.el --- a/lisp/x-menubar.el Mon Aug 13 10:05:53 2007 +0200 +++ b/lisp/x-menubar.el Mon Aug 13 10:06:47 2007 +0200 @@ -579,7 +579,7 @@ (strokes-mode) (beep) (message "This option requires a window system.")) - :style toggle :selected (and (fboundp strokes-mode) + :style toggle :selected (and (boundp 'strokes-mode) strokes-mode window-system)]) ("Open URLs With" diff -r d8688acf4c5b -r 78f53ef88e17 man/ChangeLog --- a/man/ChangeLog Mon Aug 13 10:05:53 2007 +0200 +++ b/man/ChangeLog Mon Aug 13 10:06:47 2007 +0200 @@ -1,3 +1,14 @@ +1997-11-15 SL Baur + + * lispref/windows.texi (scroll-conservatively): Fix typo. + +1997-11-12 Hrvoje Niksic + + * lispref/commands.texi (Working With Events): Document fully. + + * lispref/windows.texi (Vertical Scrolling): Document + scroll-conservatively. + 1997-11-09 Hrvoje Niksic * lispref/extents.texi (Intro to Extents): Minor correction. diff -r d8688acf4c5b -r 78f53ef88e17 man/lispref/commands.texi --- a/man/lispref/commands.texi Mon Aug 13 10:05:53 2007 +0200 +++ b/man/lispref/commands.texi Mon Aug 13 10:06:47 2007 +0200 @@ -1309,17 +1309,147 @@ either an event object or @code{nil}, creating the event object first in the latter case. -@defun allocate-event -This function returns an empty event structure. WARNING: The event -object returned may be a reused one; see the function -@code{deallocate-event}. +@defun make-event &optional type plist +This function creates a new event structure. If no arguments are +specified, the created event will be empty. To specify the event type, +use the @var{type} argument. The allowed types are @code{empty}, +@code{key-press}, @code{button-press}, @code{button-release}, or +@code{motion}. + +@var{plist} is a property list, the properties being compatible to those +returned by @code{event-properties}. For events other than +@code{empty}, it is mandatory to specify certain properties. For +@code{empty} events, @var{plist} must be @code{nil}. The list is +@dfn{canonicalized}, which means that if a property keyword is present +more than once, only the first instance is taken into account. +Specifying an unknown or illegal property signals an error. + +The following properties are allowed: + +@table @b +@item @code{channel} +The event channel. This is a frame or a console. For mouse events (of +type @code{button-press}, @code{button-release} and @code{motion}), this +must be a frame. For key-press events, it must be a console. If +channel is unspecified by @var{plist}, it will be set to the selected +frame or selected console, as appropriate. + +@item @code{key} +The event key. This is either a symbol or a character. It is allowed +(and required) only for key-press events. + +@item @code{button} +The event button. This an integer, either 1, 2 or 3. It is allowed +only for button-press and button-release events. + +@item @code{modifiers} +The event modifiers. This is a list of modifier symbols. It is allowed +for key-press, button-press, button-release and motion events. + +@item @code{x} +The event X coordinate. This is an integer. It is relative to the +channel's root window, and is allowed for button-press, button-release +and motion events. + +@item @code{y} +The event Y coordinate. This is an integer. It is relative to the +channel's root window, and is allowed for button-press, button-release +and motion events. This means that, for instance, to access the +toolbar, the @code{y} property will have to be negative. + +@item @code{timestamp} +The event timestamp, a non-negative integer. Allowed for all types of +events. +@end table + +@emph{WARNING}: the event object returned by this function may be a +reused one; see the function @code{deallocate-event}. + +The events created by @code{make-event} can be used as non-interactive +arguments to the functions with an @code{(interactive "e")} +specification. + +Here are some basic examples of usage: + +@lisp +@group +;; @r{Create an empty event.} +(make-event) + @result{} # +@end group + +@group +;; @r{Try creating a key-press event.} +(make-event 'key-press) + @error{} Undefined key for keypress event +@end group + +@group +;; @r{Creating a key-press event, try No. 2.} +(make-event 'key-press '(key home)) + @result{} # +@end group + +@group +;; @r{Create a key-press event of dubious fame.} +(make-event 'key-press '(key escape modifiers (meta alt control shift))) + @result{} # +@end group + +@group +;; @r{Create a M-button1 event at coordinates defined by variables +;; @var{x} and @var{y}.} +(make-event 'button-press `(button 1 modifiers (meta) x ,x y ,y)) + @result{} # +@end group + +@group +;; @r{Create a simmilar button-release event.} +(make-event 'button-release `(button 1 modifiers (meta) x ,x y ,x)) + @result{} # +@end group + +@group +;; @r{Create a mouse-motion event.} +(make-event 'motion '(x 20 y 30)) + @result{} # + +;; @r{(the Y coordinate is printed incompatibly; however:)} +(event-properties (make-event 'motion '(x 20 y 30))) + @result{} (channel # x 20 y 30 modifiers nil timestamp 0) +@end group +@end lisp + +In conjunction with @code{event-properties}, you can use +@code{make-event} to create modified copies of existing events. For +instance, the following code will return an @code{equal} copy of +@var{event}: + +@lisp +(make-event (event-type @var{event}) + (event-properties @var{event})) +@end lisp + +Note, however, that you cannot use @code{make-event} as the generic +replacement for @code{copy-event}, because it does not allow creating +all of the event types. + +To create a changed copy of an event, you can use the canonicalization +feature of @var{plist}. The following example creates a copy of +@var{event}, but with @code{modifiers} reset to @code{nil}. + +@lisp +(make-event (event-type @var{event}) + (append '(modifiers nil) + (event-properties @var{event}))) +@end lisp @end defun @defun copy-event event1 &optional event2 This function makes a copy of the given event object. If a second argument is given, the first event is copied into the second and the second is returned. If the second argument is not supplied (or is -@code{nil}) then a new event will be made as with @code{allocate-event}. +@code{nil}) then a new event will be made. @end defun @defun deallocate-event event diff -r d8688acf4c5b -r 78f53ef88e17 man/lispref/lispref.texi --- a/man/lispref/lispref.texi Mon Aug 13 10:05:53 2007 +0200 +++ b/man/lispref/lispref.texi Mon Aug 13 10:06:47 2007 +0200 @@ -15,7 +15,7 @@ GNU Emacs Lisp Reference Manual v2.4, June 1995 XEmacs Lisp Programmer's Manual (for 19.13) Third Edition, July 1995 XEmacs Lisp Reference Manual (for 19.14 and 20.0) v3.1, March 1996 -XEmacs Lisp Reference Manual (for 19.15 and 20.1, 20.2) v3.2, April, May 1997 +XEmacs Lisp Reference Manual (for 19.15 and 20.1, 20.2, 20.3) v3.2, April, May, November 1997 @c Please REMEMBER to update edition number in *four* places in this file @c and also in *one* place in intro.texi @@ -75,7 +75,7 @@ @c and also in the file intro.texi. @c This manual documents XEmacs 19.14 and 20.0 and was based on the @c documentation for FSF Emacs 19.29 (v2.4). -@subtitle Version 3.2 (for XEmacs 19.15 and 20.1, 20.2), April, May 1997 +@subtitle Version 3.2 (for XEmacs 19.15 and 20.1, 20.2, 20.3), April, May, November 1997 @author by Ben Wing @author @@ -89,7 +89,7 @@ Copyright @copyright{} 1995, 1996 Ben Wing. @sp 2 Version 3.2 @* -Revised for XEmacs Versions 19.15 and 20.1, 20.2,@* +Revised for XEmacs Versions 19.15 and 20.1, 20.2, 20.3,@* April, May 1997.@* Permission is granted to make and distribute verbatim copies of this diff -r d8688acf4c5b -r 78f53ef88e17 man/lispref/windows.texi --- a/man/lispref/windows.texi Mon Aug 13 10:05:53 2007 +0200 +++ b/man/lispref/windows.texi Mon Aug 13 10:06:47 2007 +0200 @@ -1284,6 +1284,14 @@ centers point. The default value is zero. @end defopt +@defopt scroll-conservatively +This variable controls how many lines Emacs tries to scroll before +recentering. If you set it to a small number, then when you move point +a short distance off the screen, XEmacs will scroll the screen just far +enough to bring point back on screen, provided that does not exceed +@var{scroll-conservatively} lines. +@end defopt + @defopt next-screen-context-lines The value of this variable is the number of lines of continuity to retain when scrolling by full screens. For example, @code{scroll-up} diff -r d8688acf4c5b -r 78f53ef88e17 man/xemacs-faq.texi --- a/man/xemacs-faq.texi Mon Aug 13 10:05:53 2007 +0200 +++ b/man/xemacs-faq.texi Mon Aug 13 10:06:47 2007 +0200 @@ -8,7 +8,7 @@ @titlepage @title XEmacs FAQ @subtitle Frequently asked questions about XEmacs -@subtitle Last Modified: 1997-07-17 +@subtitle Last Modified: 1997-11-10 @sp 1 @author Tony Rossini @author Ben Wing @@ -420,21 +420,22 @@ @node Q1.0.2, Q1.0.3, Q1.0.1, Introduction @section What is the current version of XEmacs? -The current stable version of XEmacs is 20.2, released in May, 1997. -The next feature release will XEmacs 20.3. - -XEmacs 19.15 was the last release of v19, released in March, 1997. - -To help users who are not yet ready to move to XEmacs 20, we run a -patch-page with official bugfixes for 19.15 at: +There are currently two released versions of XEmacs: + +The current stable International version of XEmacs is 20.2, released in +May, 1997. The next feature release will XEmacs 20.3. + +The current version of XEmacs without international language support is +XEmacs 19.16 and is the last release of v19. This version was released +in November, 1997. + +We also run a patch-page with official bugfixes for 19.15 at: @example @end example -The page is maintained by Vinnie Shelton @code{}. These -fixes will be integrated to a XEmacs and released as 19.16, which would -serve as stable XEmacs until 20.x settles completely. +The page is maintained by Vinnie Shelton @code{}. @node Q1.0.3, Q1.0.4, Q1.0.2, Introduction @section Where can I find it? @@ -631,7 +632,7 @@ @node Q1.0.14, Q1.1.1, Q1.0.13, Introduction @section Where can I obtain a printed copy of the XEmacs users manual? -InfoDock Associates, a firm specializing in Emacs-related support and +Altrasoft Associates, a firm specializing in Emacs-related support and development, will be maintaining the XEmacs user manual. The firm plans to begin publishing printed copies of the manual soon. @c This used to say `March 1997'! @@ -670,9 +671,7 @@ @section How do I become a Beta Tester? Send an email message to with a -subject line of @samp{subscribe}. Fill out and return the questionnaire -you get back, and you will receive the password to get at the current -beta. +subject line of @samp{subscribe}. Be prepared to get your hands dirty, as beta testers are expected to identify problems as best they can. @@ -713,12 +712,14 @@ @section Who wrote XEmacs? XEmacs is the result of the time and effort of many people. The -developers responsible for the 19.15/20.x releases are: +developers responsible for the 19.16/20.x releases are: @itemize @bullet @item Martin Buchholz @item Steve Baur + +@item Hrvoje Niksic @end itemize The developers responsible for the 19.14 release are: @@ -804,7 +805,7 @@ XEmacs v20 is the version of XEmacs that includes MULE (Asian-language) support. XEmacs 20.0 was released in February 1997, followed by XEmacs 20.2 in May. When compiled without MULE support 20.2 is currently very -similar to 19.15 (except for some changes to the byte-code format, some +similar to 19.16 (except for some changes to the byte-code format, some new primitive types including @code{char}, @code{char-table}, and @code{range-table}) and equally stable. @@ -953,8 +954,7 @@ There is a cyrillic mode in the file @file{mysetup.zip} in . This is a modification to Valery Alexeev's @file{russian.el} -which can be obtained from -. +which can be obtained from . @end quotation Dima Barsky writes: @@ -1073,7 +1073,7 @@ another matter, entirely. A keyboard macro is a key bound to several other keys. Refer to manual for details. -@node Q1.4.7, , Q1.4.6, Introduction +@node Q1.4.7, , Q1.4.6, Introduction @section How come options saved with 19.13 don't work with 19.14 or later? There's a problem with options of the form: @@ -1607,7 +1607,7 @@ cp src/xemacs /usr/local/bin/xemacs @item -cp lib-src/DOC-19.15-XEmacs /usr/local/lib/xemacs-19.15/i586-unknown-linuxaout +cp lib-src/DOC-19.16-XEmacs /usr/local/lib/xemacs-19.16/i586-unknown-linuxaout @end enumerate @end quotation @@ -1633,7 +1633,7 @@ @node Q2.0.14, Q2.1.1, Q2.0.13, Installation @section Make on HP/UX 9 fails after linking temacs -Problem when building xemacs-19.15 on hpux 9: +Problem when building xemacs-19.16 on hpux 9: Richard Cognot writes: @@ -1769,7 +1769,7 @@ set the environment variable @var{XKEYSYMDB} to the location of the @file{XKeysymDB} file on your system or to the location of the one included with XEmacs which should be at -@file{/lib/xemacs-19.15/etc/XKeysymDB}. +@file{/lib/xemacs-19.16/etc/XKeysymDB}. @item The binary is finding the XKeysymDB but it is out-of-date on your system @@ -4007,7 +4007,7 @@ support. When appropriate a message will be decoded in place in an XEmacs buffer. -TM now comes as a package with XEmacs 19.15 and XEmacs 20.0. +TM now comes as a package with XEmacs 19.16 and XEmacs 20.2. TM was written by MORIOKA Tomohiko and KOBAYASHI Shuhei . It is based on the work of UMEDA @@ -4300,7 +4300,7 @@ @section What is AUC TeX? Where do you get it? AUC TeX is a package written by Per Abrahamsen . -Starting with XEmacs 19.15, AUC TeX is bundled with XEmacs. The +Starting with XEmacs 19.16, AUC TeX is bundled with XEmacs. The following information is from the @file{README} and website. AUC TeX is an extensible package that supports writing and formatting @@ -4438,10 +4438,11 @@ * Q5.1.3:: Could you explain @code{read-kbd-macro} in more detail? * Q5.1.4:: What is the performance hit of @code{let}? * Q5.1.5:: What is the recommended use of @code{setq}? -* Q5.1.6:: What is the typical misuse of @code{setq} ? +* Q5.1.6:: What is the typical misuse of @code{setq}? * Q5.1.7:: I like the the @code{do} form of cl, does it slow things down? * Q5.1.8:: I like recursion, does it slow things down? * Q5.1.9:: How do I put a glyph as annotation in a buffer? +* Q5.1.10:: @code{map-extents} won't traverse all of my extents! Sound: * Q5.2.1:: How do I turn off the sound? @@ -5091,7 +5092,7 @@ Please try not to make your code much uglier to gain a very small speed gain. It's not usually worth it. -@node Q5.1.9, Q5.2.1, Q5.1.8, Miscellaneous +@node Q5.1.9, Q5.1.10, Q5.1.8, Miscellaneous @section How do I put a glyph as annotation in a buffer? Here is a solution that will insert the glyph annotation at the @@ -5114,7 +5115,38 @@ name), and inserts the glyph at @code{(point)} instead of @code{(point-min)}. -@node Q5.2.1, Q5.2.2, Q5.1.9, Miscellaneous +@node Q5.1.10, Q5.2.1, Q5.1.9, Miscellaneous +@section @code{map-extents} won't traverse all of my extents! + +I tried to use @code{map-extents} to do an operation on all the extents +in a region. However, it seems to quit after processing a random number +of extents. Is it buggy? + +No. The documentation of @code{map-extents} states that it will iterate +across the extents as long as @var{function} returns @code{nil}. +Unexperienced programmers often forget to return @code{nil} explicitly, +which results in buggy code. For instance, the following code is +supposed to delete all the extents in a buffer, and issue as many +@samp{fubar!} messages. + +@lisp +(map-extents (lambda (ext ignore) + (delete-extent ext) + (message "fubar!"))) +@end lisp + +Instead, it will delete only the first extent, and stop right there -- +because @code{message} will return a non-nil value. The correct code +is: + +@lisp +(map-extents (lambda (ext ignore) + (delete-extent ext) + (message "fubar!") + nil)) +@end lisp + +@node Q5.2.1, Q5.2.2, Q5.1.10, Miscellaneous @section How do I turn off the sound? Add the following line to your @file{.emacs}: diff -r d8688acf4c5b -r 78f53ef88e17 nt/ChangeLog --- a/nt/ChangeLog Mon Aug 13 10:05:53 2007 +0200 +++ b/nt/ChangeLog Mon Aug 13 10:06:47 2007 +0200 @@ -1,3 +1,13 @@ +Thu September 25 23:06:44 1997 davidh + + * xemacs.mak updated to make the build as simple as typing + nmake -f xemacs.mak. Also support for native gui included + which should mean the w32 directory is no longer required. + + * config.h synced with config.h.in from 20.3-b2 + + * synced in changes to support native gui. + Thu September 25 23:06:44 1997 davidh * August Hill provided a patch to xemacs.mak to greatly simplify diff -r d8688acf4c5b -r 78f53ef88e17 nt/README --- a/nt/README Mon Aug 13 10:05:53 2007 +0200 +++ b/nt/README Mon Aug 13 10:06:47 2007 +0200 @@ -2,10 +2,9 @@ David Hobley Marc Paquette + Jonathon Harris -Currently XEmacs for NT is in an early stage of development. Only X support -works at the moment, although native GUI/terminal support will be added at a -later date. If anyone wants to help with this, please contact us. +Currently XEmacs for Win32 is in an early stage of development. The port was made much easier by the groundbreaking work of Geoff Voelker and others who worked on the GNU Emacs port to NT. Their version is available @@ -13,6 +12,30 @@ To get it working you will need: +1. You will need Visual C++ V4.2 or later to compile everything. Personally we + have tested V4.2 and V5.0. +2. Grab the latest XEmacs beta from ftp.xemacs.org if necessary. All Win32 + support is in the nt/ subdirectory. +3. Edit the xemacs.mak file and ensure variables point to the correct place. + Note that Visual C++ assumes a couple of environment variables INCLUDE and + LIB to be set which specify the location of the includes and libraries. + At this point you can select X or Win32 native support. +4. Run make. I simply use nmake -f xemacs.mak. This will build temacs, the + DOC file, if startup.elc does not exist it will update the elc's and + then it will dump xemacs. +5. The build process creates debugging and "Source Browser" information for + use with MS DevStudio. To use this create a new "console" project and set + the Project/Settings/Debug executable name to the full path of + src\xemacs.exe. Remember to close the Source Browser file in DevStudio + before rebuilding. +6. If you're going to edit sources I recommend that you first get a copy of + makedepend and make a list of dependencies in the makefile by doing + "nmake -f xemacs.mak depend". I (jhar) have a hacked-up copy of X11R5 + makedepend which I can distribute if anyone wants it. Is there a real + version anywhere which handles '\' as the path delimiter? + +If you want support for X you will need: + 1. An X server. MI/X is available on the Internet for free; It is available from: http://www.microimages.com/www/html/freestuf/mixdlfrm.htm 2. The MIT X11R6.3 libraries available from: ftp.x.org @@ -34,29 +57,6 @@ - +#endif -4. You will need Visual C++ V4.2 or later to compile everything. Personally we - have tested V4.2 and V5.0. -5. Grab the latest XEmacs beta from ftp.xemacs.org if necessary. All nt - support is in the nt/ subdirectory. -6. Edit the xemacs.mak file and ensure variables point to the correct place. - Note that Visual C++ assumes a couple of environment variables INCLUDE and - LIB to be set which specify the location of the includes and libraries. -7. Copy the files Emacs.ad.h, config.h and paths.h from nt/ to src/. - Note, to rebuild Emacs.ad.h a sed script is run. SED for NT is available - from the Virtually Unix site: http://www.itribe.net/virtunix - This is not required however in normal operation. -8. Run make. I simply use nmake -f xemacs.mak. -9. Change directory to the src/ directory and run the temacs executable - manually: - temacs -batch -l loadup.el dump - This will produce an xemacs.exe which can be run in conjunction with your - X server. -10. Ensure your HOME environment variable is set correctly. Also ensure TERM - isn't set anywhere. -11. When you build, the DOC file will get created correctly. However I don't - update the elc's by default. This means the build will fail on the DOC - file if they don't exist. Just use the update-elcs rule and then rebuild. - Known Problems: Please look at the TODO list for the current list of problems and people working on them. @@ -64,9 +64,12 @@ Any other problems you need clarified, please email us and we will endeavour to provide any assistance we can: -David Hobley david_hobley@optusvision.com.au -- work email. - davidh@wr.com.au -- home account. +The XEmacs NT Mailing List: xemacs-nt@xemacs.org +Subscribe address: xemacs-nt-request@xemacs.org -Marc Paquette marcpa@cam.org -- home account. +David Hobley +Marc Paquette +August Hill +Jonathon Harris -August Hill awhill@inlink.com +and others. diff -r d8688acf4c5b -r 78f53ef88e17 nt/Todo --- a/nt/Todo Mon Aug 13 10:05:53 2007 +0200 +++ b/nt/Todo Mon Aug 13 10:06:47 2007 +0200 @@ -1,18 +1,46 @@ # List of problems with XEmacs. If anyone wants to work on these, please # mail me and I'll update the table below. -1. vfork references -2. provide working select which supports handles as well as sockets -3. make "Save Options" actually save options to home directory. Currently I get - it trying to save in g:\home\davidh\~davidh -4. build a binary distribution (just install temacs and get user to _easily_ - build an xemacs.exe on their system. This will ensure heap problems do not - occur) -5. provide option for dired to use dir/attrib on Win32 platforms -6. verify MULE supports CRLF correctly -7. get subprocesses working +# Core NT issues + 1. Subprocess support is completely broken. + 2. Networking support is completely broken. This is due to the fact that + the model relies on the subprocess support also working. + 4. No binary release. We know a binary release would be A Good Thing. + However we want to make things stable before producing one so we don't + have to field too many problems. Sorry. + 5. Support for dired is perhaps not quite there. We need to port ls-lisp.el + from FSF Emacs. + 6. Currently the backup files do not get the same permissions as the file + being edited. August Hill is looking at this one. + 7. Verify that CRLF issues are dealt with correctly. Marc Paquette is + looking at this. + 8. Use the registry to store the root directory(ies) of lisp packages; that + is the path name, not the elisp files. + +# X issues + 1. Redrawing on my (davidh) system seems fairly broken - I don't know if + this is the XEmacs redraw functionality, my X server or just something + strange with X under NT. Has anyone else experiences with this ? +# Native GUI issues + 1. Mouse drags can cause aborts. I think this is because the timeout + implementation is broken and can cause the same timeout to go + off twice (especially during mouse drags?), which makes XEmacs abort. + Windows95 doesn't appear to provide any one-shot timers (NT does). + 2. XEmacs starts-up with "Arithmetic error". + 3. It might be a good idea if someone sanity-checked my (jhar) changes to + faces.el. + 4. w32-make-font-foo in w32/w32-faces.el need to be written. + 5. Calling mouse_[enter|leave]_frame_hook. + 6. Eliminate resizing funnies + 7. Scrollbar + 8. Menubar + 9. Palette handling + 10. Middle mouse button emulation. Dragging off-frame. + 11. Images + 12. Toolbar -Issue - Person -2 David Hobley -3 August Hill +Old Issues. + + 1. For some reason, HOME is a required environment variable. + diff -r d8688acf4c5b -r 78f53ef88e17 nt/config.h --- a/nt/config.h Mon Aug 13 10:05:53 2007 +0200 +++ b/nt/config.h Mon Aug 13 10:06:47 2007 +0200 @@ -23,16 +23,45 @@ /* No code in XEmacs #includes config.h twice, but some of the code intended to work with other packages as well (like gmalloc.c) think they can include it as many times as they like. */ -#ifndef _CONFIG_H_ -#define _CONFIG_H_ - -/* #### This will be removed in 19.15. */ -#define LOSING_BYTECODE +#ifndef _SRC_CONFIG_H_ +#define _SRC_CONFIG_H_ #define NTHEAP_PROBE_BASE 1 +#undef LOSING_BYTECODE -/* These are all defined in the top-level Makefile by configure. - They're here only for reference. */ +/* Use this to add code in a structured way to FSF-maintained source + files so as to make it obvious where XEmacs changes are. */ +#define XEMACS + +/* Allow s&m files to differentiate OS versions without having + multiple files to maintain. */ +#undef OS_RELEASE + +/* The configuration name. This is used as the install directory name + for the lib-src programs. */ +#undef EMACS_CONFIGURATION + +/* The configuration options. This is exported to Lisp. */ +#undef EMACS_CONFIG_OPTIONS + +/* The version info from xemacs.mak via version.sh. Used in #pragma ident + in emacs.c */ +#if 0 +#undef EMACS_MAJOR_VERSION +#undef EMACS_MINOR_VERSION +#undef EMACS_BETA_VERSION +#undef EMACS_VERSION +#undef XEMACS_CODENAME +#endif + +/* Make all functions available on AIX. See AC_AIX. */ +#undef _ALL_SOURCE + +/* Used to identify the XEmacs version in stack traces. */ +#undef STACK_TRACE_EYE_CATCHER + +/* Allow the configurer to specify (additional) package directories. */ +#undef PACKAGE_PATH /* Define LISP_FLOAT_TYPE if you want XEmacs to support floating-point numbers. */ @@ -47,20 +76,26 @@ /* Define HAVE_TTY if you want TTY support compiled in. */ #undef HAVE_TTY -/* Define HAVE_X_WINDOWS if you want to use the X window system. */ -#define HAVE_X_WINDOWS - -/* Define HAVE_NEXTSTEP if you want to use the NeXTstep window system. */ -#undef HAVE_NEXTSTEP +/* Compile in support for the X window system? */ +/* #undef HAVE_X_WINDOWS -- defined in xemacs.mak */ -/* Define HAVE_WINDOW_SYSTEM if any windowing system is available. */ -#if defined (HAVE_X_WINDOWS) || defined (HAVE_NEXTSTEP) -#define HAVE_WINDOW_SYSTEM +/* Defines for building X applications */ +#ifdef HAVE_X_WINDOWS +/* The following will be defined if xmkmf thinks they are necessary */ +#undef SVR4 +#undef SYSV +#undef AIXV3 +#undef _POSIX_SOURCE +#undef _BSD_SOURCE +#undef _GNU_SOURCE +#undef X_LOCALE +#undef NARROWPROTO +/* The following should always be defined, no matter what xmkmf thinks. */ +#ifndef NeedFunctionPrototypes +#define NeedFunctionPrototypes 1 #endif - -/* Define HAVE_UNIXOID_EVENT_LOOP if we use select() to wait for events. */ -#if defined (HAVE_X_WINDOWS) || defined (HAVE_TTY) -#define HAVE_UNIXOID_EVENT_LOOP +#ifndef FUNCPROTO +#define FUNCPROTO 15 #endif /* Define this if you're using XFree386. */ @@ -70,6 +105,39 @@ #undef THIS_IS_X11R5 #define THIS_IS_X11R6 +/* Define HAVE_XPM if you have the `xpm' library and want XEmacs to use it. */ +#undef HAVE_XPM + +/* Define HAVE_XFACE if you have the `compface' library and want to use it. + This will permit X-face pixmaps in mail and news messages to display + quickly. */ +#undef HAVE_XFACE + +#define HAVE_IMAGEMAGICK + +/* Define HAVE_XMU if you have the Xmu library. This should always be + the case except on losing HPUX systems. */ +#define HAVE_XMU + +/* Define HAVE_XAUTH if the Xauth library is present. This will add + some extra functionality to gnuserv. */ +#undef HAVE_XAUTH + +/* Define HAVE_XLOCALE_H if X11/Xlocale.h is present. */ +#define HAVE_XLOCALE_H + +#endif /* HAVE_X_WINDOWS */ + +/* Define HAVE_WINDOW_SYSTEM if any windowing system is available. */ +#if defined (HAVE_X_WINDOWS) || defined (HAVE_NEXTSTEP) || defined (HAVE_MS_WINDOWS) +#define HAVE_WINDOW_SYSTEM +#endif + +/* Define HAVE_UNIXOID_EVENT_LOOP if we use select() to wait for events. */ +#if defined (HAVE_X_WINDOWS) || defined (HAVE_TTY) || defined (HAVE_MS_WINDOWS) +#define HAVE_UNIXOID_EVENT_LOOP +#endif + /* Define USER_FULL_NAME to return a string that is the user's full name. It can assume that the variable `pw' @@ -80,9 +148,6 @@ field contains the right thing, use pw_name, giving the user's login name, since that is better than nothing. */ #define USER_FULL_NAME pw->pw_gecos -#if 0 -#define USER_FULL_NAME unknown -#endif /* Define AMPERSAND_FULL_NAME if you use the convention that & in the full name stands for the login id. */ @@ -103,7 +168,9 @@ #define HAVE_SYS_TIME_H #define HAVE_LOCALE_H +#ifdef HAVE_X_WINDOWS #define HAVE_X11_LOCALE_H +#endif #define STDC_HEADERS #define HAVE_LIMITS_H #define HAVE_GETCWD @@ -114,6 +181,8 @@ #define CLASH_DETECTION #endif +#undef HAVE_LIBKSTAT +#undef HAVE_LIBINTL #undef HAVE_LIBDNET #undef HAVE_LIBRESOLV @@ -126,7 +195,6 @@ /* Define if `struct timeval' is declared by . */ #define HAVE_TIMEVAL - #undef TM_IN_SYS_TIME #undef HAVE_TM_ZONE #undef HAVE_TZNAME @@ -144,19 +212,19 @@ #undef GETTIMEOFDAY_ONE_ARGUMENT #endif -/* Define in keyword `inline' exists. */ -#undef HAVE_INLINE - -#undef HAVE_ALLOCA_H -#undef HAVE_VFORK_H -#undef vfork +/* Is the timezone variable already declared in system headers? */ +#undef HAVE_TIMEZONE_DECL #undef HAVE_MMAP #undef HAVE_STRCOLL +#undef HAVE_GETPGRP +#undef GETPGRP_VOID #undef SIZEOF_SHORT #undef SIZEOF_INT #undef SIZEOF_LONG +#undef SIZEOF_LONG_LONG +#undef SIZEOF_VOID_P #undef HAVE_ACOSH #undef HAVE_ASINH @@ -217,9 +285,6 @@ #undef NLIST_STRUCT -#undef UNEXEC_SRC -#undef AIX_SMT_EXP - /* Define HAVE_SOCKS if you have the `socks' library and want XEmacs to use it. */ #undef HAVE_SOCKS @@ -228,80 +293,23 @@ want XEmacs to use it. */ #undef HAVE_TERM -/* Define HAVE_XPM if you have the `xpm' library and want XEmacs to use it. */ -#undef HAVE_XPM - -/* Define HAVE_XFACE if you have the `compface' library and want to use it. - This will permit X-face pixmaps in mail and news messages to display - quickly. */ -#undef HAVE_XFACE - -/* Define HAVE_GIF if you want XEmacs to support converting GIF - (Graphics Interchange Format) images. */ -#undef HAVE_GIF - -/* Define HAVE_JPEG if you have the JPEG library and want XEmacs to use it. - This is for converting JPEG images. */ -#undef HAVE_JPEG - -/* Define HAVE_PNG if you have the PNG library and want XEmacs to use it. - This is for converting PNG images. */ -#undef HAVE_PNG - -/* Define HAVE_PNG_GNUZ if you want to use -lgz instead of -lz for PNG. */ -#undef HAVE_PNG_GNUZ - -/* Define HAVE_TIFF if you have the TIFF library and want XEmacs to use it. - This is for converting TIFF images. */ -#undef HAVE_TIFF - -/* Define HAVE_XMU if you have the Xmu library. This should always be - the case except on losing HPUX systems. */ -#define HAVE_XMU - /* Define HAVE_DBM if you want to use the DBM libraries */ #undef HAVE_DBM -/* Define HAVE_GNU_DBM if you want to use the GNU DBM libraries; - if you define this, you should also define HAVE_DBM */ -#undef HAVE_GNU_DBM - /* Define HAVE_BERKELEY_DB if you want to use the BerkDB libraries */ #undef HAVE_BERKELEY_DB - -/* Define HAVE_LIBGDBM if you have -lgdbm (separated from HAVE_DBM - stuff because FreeBSD has the DBM routines in libc) */ -#undef HAVE_LIBGDBM - -/* Define HAVE_LIBDBM if you have -ldbm */ -#undef HAVE_LIBDBM - -/* Define HAVE_LIBDB if you have -ldb */ -#undef HAVE_LIBDB +/* Full #include file path for Berkeley DB's db.h */ +#undef DB_H_PATH #if defined (HAVE_DBM) || defined (HAVE_BERKELEY_DB) # define HAVE_DATABASE #endif -/* Define HAVE_XAUTH if the Xauth library is present. This will add - some extra functionality to gnuserv. */ -#undef HAVE_XAUTH - -/* Define HAVE_XLOCALE_H if X11/Xlocale.h is present. */ -#define HAVE_XLOCALE_H - /* Define HAVE_NCURSES if -lncurses is present. */ #undef HAVE_NCURSES - -/* Define HAVE_NCURSES_CURSES_H if ncurses/curses.h is present. */ -#undef HAVE_NCURSES_CURSES_H - -/* Define HAVE_NCURSES_TERM_H if ncurses/term.h is present. */ -#undef HAVE_NCURSES_TERM_H - -/* Define EPOCH to include extra functionality that was present in Epoch. - This code has received only limited testing. */ -#undef EPOCH +/* Full #include file paths for ncurses' curses.h and term.h. */ +#undef CURSES_H_PATH +#undef TERM_H_PATH #define LOWTAGS @@ -319,6 +327,7 @@ /* Check the entire extent structure of a buffer each time an extent change is done, and do other extent-related checks. */ #define ERROR_CHECK_EXTENTS + /* Make sure that all X... macros are dereferencing the correct type, and that all XSET... macros (as much as possible) are setting the correct type of structure. Highly recommended for all @@ -357,22 +366,42 @@ /* Allow the user to override the default value of PURESIZE at configure time. This must come before we include the sys files in order for it to be able to override any changes in them. */ -#undef PURESIZE +#undef RAW_PURESIZE +/* Define this if you want level 2 internationalization compliance + (localized collation and formatting). Generally this should be + defined, unless your system doesn't have the strcoll() and + setlocale() library routines. This really should be (NOT! -mrb) + defined in the appropriate s/ or m/ file. */ +#undef I18N2 -/* Define this if you want to use the Common Desktop Environment -*/ +/* Define this if you want level 3 internationalization compliance + (localized messaging). This will cause a small runtime performance + penalty, as the strings are read from the message catalog(s). + For this you need the gettext() and dgetext() library routines. + WARNING, this code is under construction. */ +#undef I18N3 + +/* Compile in support for CDE (Common Desktop Environment) drag and drop? + Requires libDtSvc, which typically must be present at runtime. */ #undef HAVE_CDE +/* Compile in support for OffiX Drag and Drop? */ +#undef HAVE_OFFIX_DND + +/* Compile in support for proper session-management. */ +#undef HAVE_SESSION + /* Define this if you want Mule support (multi-byte character support). There may be some performance penalty, although it should be small if you're working with ASCII files. */ -#define MULE +/* #undef MULE */ +#ifdef MULE /* Do we want to use X window input methods for use with Mule? (requires X11R5) If so, use raw Xlib or higher level Motif interface? */ -#define HAVE_XIM -#define XIM_XLIB +#undef HAVE_XIM +#undef XIM_XLIB #undef XIM_MOTIF /* Non-XIM input methods for use with Mule. */ @@ -380,6 +409,8 @@ #undef HAVE_WNN #undef WNN6 +#endif + /* enable special GNU Make features in the Makefiles. */ #undef USE_GNU_MAKE @@ -431,38 +462,10 @@ #define SYSTEM_MALLOC #endif -/* The configuration name. This is used as the install directory name - for the lib-src programs. */ -#undef EMACS_CONFIGURATION - /* Define REL_ALLOC if you want to use the relocating allocator for buffer space. */ #undef REL_ALLOC -/* Define LD_SWITCH_SITE to contain any special flags your loader may need. */ -#undef LD_SWITCH_SITE - -/* Define C_SWITCH_SITE to contain any special flags your compiler needs. */ -#undef C_SWITCH_SITE - -/* Define LD_SWITCH_X_SITE to contain any special flags your loader - may need to deal with X Windows. For instance, if you've defined - HAVE_X_WINDOWS above and your X libraries aren't in a place that - your loader can find on its own, you might want to add "-L/..." or - something similar. */ -#undef LD_SWITCH_X_SITE - -/* Define LD_SWITCH_X_SITE_AUX with an -R option - in case it's needed (for Solaris, for example). */ -#undef LD_SWITCH_X_SITE_AUX - -/* Define C_SWITCH_X_SITE to contain any special flags your compiler - may need to deal with X Windows. For instance, if you've defined - HAVE_X_WINDOWS above and your X include files aren't in a place - that your compiler can find on its own, you might want to add - "-I/..." or something similar. */ -#undef C_SWITCH_X_SITE - /* Define the return type of signal handlers if the s-xxx file did not already do so. */ #define RETSIGTYPE void @@ -473,15 +476,18 @@ #define SIGRETURN return #endif +/* Allow the source to use standard types */ +#undef size_t +#undef pid_t +#undef mode_t +#undef off_t +#undef uid_t +#undef gid_t + /* Define DYNODUMP if it is necessary to properly dump on this system. Currently this is only Solaris. */ #undef DYNODUMP -/* Define NEED_XILDOFF if the -xildoff flag must be passed to cc to - avoid invoking the incremental linker ild which is incompatible - with dynodump. This is needed for recent Sunsoft compilers. */ -#undef NEED_XILDOFF - /* Define ENERGIZE to compile with support for the Energize Programming System. If you do this, don't forget to define ENERGIZE in lwlib/Imakefile as well. You will need to set your C_SWITCH_SITE and LD_SWITCH_SITE to point at the @@ -517,6 +523,8 @@ /* Define TOOLTALK if your site supports the ToolTalk library. */ #undef TOOLTALK +#ifdef HAVE_X_WINDOWS + #undef LWLIB_USES_MOTIF #define LWLIB_MENUBARS_LUCID #undef LWLIB_MENUBARS_MOTIF @@ -532,6 +540,7 @@ #define HAVE_DIALOGS #undef HAVE_TOOLBARS +#endif #if defined (HAVE_MENUBARS) || defined (HAVE_DIALOGS) #define HAVE_POPUPS @@ -665,4 +674,24 @@ # define JMP_BUF jmp_buf #endif -#endif /* _CONFIG_H_ */ +/* movemail options */ +/* Should movemail use POP3 for mail access? */ +#undef MAIL_USE_POP +/* Should movemail use kerberos for POP authentication? */ +#undef KERBEROS +/* Should movemail use hesiod for getting POP server host? */ +#undef HESIOD +/* Determine type of mail locking. */ +/* Play preprocessor games so that configure options override s&m files */ +#undef REAL_MAIL_USE_LOCKF +#undef REAL_MAIL_USE_FLOCK +#undef MAIL_USE_LOCKF +#undef MAIL_USE_FLOCK +#ifdef REAL_MAIL_USE_FLOCK +#define MAIL_USE_FLOCK +#endif +#ifdef REAL_MAIL_USE_LOCKF +#define MAIL_USE_LOCKF +#endif + +#endif /* _SRC_CONFIG_H_ */ diff -r d8688acf4c5b -r 78f53ef88e17 nt/xemacs.mak --- a/nt/xemacs.mak Mon Aug 13 10:05:53 2007 +0200 +++ b/nt/xemacs.mak Mon Aug 13 10:06:47 2007 +0200 @@ -1,29 +1,54 @@ -MSDEV=E:\msdev -X11R6=E:\utils\X11R6 +MSDEV=c:\msdev XEMACS=.. LISP=$(XEMACS)\lisp +HAVE_X=0 +HAVE_MSW=1 + +HAVE_MULE=0 + OPT=-Od -Zi #OPT=-O2 -G5 -Zi +#------------------------------------------------------------------------------ + +!if $(HAVE_X) +MAGICK=e:\utils\ImageMagick +X11R6=e:\utils\X11R6 + +X_DEFINES=-DHAVE_X_WINDOWS +X_INCLUDES=-I$(X11R6)\include -I$(MAGICK)\Magick +X_LIBS=Magick.dll.lib Xaw.lib Xmu.lib Xt.lib SM.lib ICE.lib Xext.lib X11.lib +!endif + +!if $(HAVE_MSW) +MSW_DEFINES=-DHAVE_MS_WINDOWS +!endif + +!if $(HAVE_MULE) +MULE_DEFINES=-DMULE +!endif + !include "..\version.sh" #------------------------------------------------------------------------------ # Generic variables -INCLUDES=-I$(X11R6)\include -I$(XEMACS)\nt\inc -I$(XEMACS)\src\ - -I$(XEMACS)\lwlib -I$(MSDEV)\include -LIBRARIES= +INCLUDES=$(X_INCLUDES) -I$(XEMACS)\nt\inc -I$(XEMACS)\src -I$(XEMACS)\lwlib -I"$(MSVCDIR)\include" + +DEFINES=$(X_DEFINES) $(MSW_DEFINES) $(MULE_DEFINES) -DWIN32 -D_WIN32 \ + -D_M_IX86 -D_X86_ \ + -DWIN32_LEAN_AND_MEAN -DWINDOWSNT -Demacs -DHAVE_CONFIG_H \ + -D_MSC_VER=999 -D_DEBUG OUTDIR=obj #------------------------------------------------------------------------------ -default: objdir all +default: $(OUTDIR)\nul all -objdir: - @echo "Ignore error message if $(OUTDIR) subdirectory already exists." +$(OUTDIR)\nul: -@mkdir $(OUTDIR) XEMACS_INCLUDES=\ @@ -32,7 +57,7 @@ $(XEMACS)\src\paths.h $(XEMACS_INCLUDES): - !"copy *.h $(XEMACS)\src" + !copy *.h $(XEMACS)\src #------------------------------------------------------------------------------ @@ -52,26 +77,27 @@ #------------------------------------------------------------------------------ +!if $(HAVE_X) + # LWLIB Library LWLIB=$(OUTDIR)\lwlib.lib LWLIB_SRC=$(XEMACS)\lwlib -LWLIB_FLAGS=-nologo -w $(OPT) $(INCLUDES) -D "WIN32" -D "_DEBUG" \ - -D "_NTSDK" -D "_M_IX86" -D "_X86_" \ - -D "NEED_ATHENA" -D "NEED_LUCID" \ - -D "_WINDOWS" -D "MENUBARS_LUCID" -D "SCROLLBARS_LUCID" -D "DIALOGS_ATHENA" \ - -D "WINDOWSNT" -Fo$@ -c +LWLIB_FLAGS=-nologo -w $(OPT) $(INCLUDES) $(DEFINES) \ + -DNEED_ATHENA -DNEED_LUCID \ + -D_WINDOWS -DMENUBARS_LUCID -DSCROLLBARS_LUCID -DDIALOGS_ATHENA \ + -Fo$@ -c LWLIB_OBJS= \ - $(OUTDIR)\lwlib-config.obj \ - $(OUTDIR)\lwlib-utils.obj \ - $(OUTDIR)\lwlib-Xaw.obj \ - $(OUTDIR)\lwlib-Xlw.obj \ - $(OUTDIR)\lwlib.obj \ - $(OUTDIR)\xlwmenu.obj \ - $(OUTDIR)\xlwscrollbar.obj + $(OUTDIR)\lwlib-config.obj \ + $(OUTDIR)\lwlib-utils.obj \ + $(OUTDIR)\lwlib-Xaw.obj \ + $(OUTDIR)\lwlib-Xlw.obj \ + $(OUTDIR)\lwlib.obj \ + $(OUTDIR)\xlwmenu.obj \ + $(OUTDIR)\xlwscrollbar.obj $(LWLIB): $(XEMACS_INCLUDES) $(LWLIB_OBJS) - link.exe -lib -nologo -debug -debugtype:both -out:$@ $(LWLIB_OBJS) + link.exe -lib -nologo -debugtype:both -out:$@ $(LWLIB_OBJS) $(OUTDIR)\lwlib-config.obj: $(LWLIB_SRC)\lwlib-config.c $(CC) $(LWLIB_FLAGS) $** @@ -94,16 +120,15 @@ $(OUTDIR)\xlwscrollbar.obj: $(LWLIB_SRC)\xlwscrollbar.c $(CC) $(LWLIB_FLAGS) $** +!endif #------------------------------------------------------------------------------ # lib-src programs LIB_SRC=$(XEMACS)\lib-src -LIB_SRC_FLAGS=$(INCLUDES) -D_DEBUG -DWIN32 -D_WIN32 -DWIN32_LEAN_AND_MEAN \ - -D_NTSDK -D_M_IX86 -ML -D_X86_ -Demacs -DHAVE_CONFIG_H -D_MSC_VER=999 +LIB_SRC_FLAGS=$(INCLUDES) $(DEFINES) -ML LIB_SRC_LIBS= kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ - advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib \ - odbccp32.lib libc.lib + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib libc.lib LIB_SRC_LFLAGS=-nologo $(LIB_SRC_LIBS) -base:0x1000000\ -subsystem:console -pdb:none -debugtype:both -machine:I386\ -nodefaultlib -out:$@ -debug:full @@ -124,15 +149,12 @@ $(XEMACS)\src\cmdloop.c \ $(XEMACS)\src\cmds.c \ $(XEMACS)\src\console-stream.c \ - $(XEMACS)\src\console-x.c \ $(XEMACS)\src\console.c \ $(XEMACS)\src\data.c \ $(XEMACS)\src\debug.c \ - $(XEMACS)\src\device-x.c + $(XEMACS)\src\device.c \ + $(XEMACS)\src\dgif_lib.c DOC_SRC2=\ - $(XEMACS)\src\device.c \ - $(XEMACS)\src\dgif_lib.c \ - $(XEMACS)\src\dialog-x.c \ $(XEMACS)\src\dialog.c \ $(XEMACS)\src\dired.c \ $(XEMACS)\src\doc.c \ @@ -141,16 +163,9 @@ $(XEMACS)\src\editfns.c \ $(XEMACS)\src\elhash.c \ $(XEMACS)\src\emacs.c \ - $(XEMACS)\src\EmacsFrame.c \ - $(XEMACS)\src\EmacsManager.c \ - $(XEMACS)\src\EmacsShell-sub.c\ - $(XEMACS)\src\EmacsShell.c \ - $(XEMACS)\src\energize.c \ $(XEMACS)\src\eval.c \ $(XEMACS)\src\event-stream.c \ $(XEMACS)\src\event-unixoid.c \ - $(XEMACS)\src\event-Xt.c -DOC_SRC3=\ $(XEMACS)\src\events.c \ $(XEMACS)\src\extents.c \ $(XEMACS)\src\faces.c \ @@ -158,78 +173,106 @@ $(XEMACS)\src\filelock.c \ $(XEMACS)\src\filemode.c \ $(XEMACS)\src\floatfns.c \ - $(XEMACS)\src\fns.c \ + $(XEMACS)\src\fns.c +DOC_SRC3=\ $(XEMACS)\src\font-lock.c \ - $(XEMACS)\src\frame-x.c \ $(XEMACS)\src\frame.c \ $(XEMACS)\src\free-hook.c \ $(XEMACS)\src\general.c \ $(XEMACS)\src\gif_err.c \ $(XEMACS)\src\gifalloc.c \ - $(XEMACS)\src\glyphs-x.c \ $(XEMACS)\src\glyphs.c \ $(XEMACS)\src\gmalloc.c \ - $(XEMACS)\src\gui-x.c \ - $(XEMACS)\src\gui.c -DOC_SRC4=\ + $(XEMACS)\src\gui.c \ $(XEMACS)\src\hash.c \ $(XEMACS)\src\indent.c \ $(XEMACS)\src\inline.c \ $(XEMACS)\src\insdel.c \ $(XEMACS)\src\intl.c \ $(XEMACS)\src\keymap.c \ + $(XEMACS)\src\line-number.c \ $(XEMACS)\src\lread.c \ $(XEMACS)\src\lstream.c \ $(XEMACS)\src\macros.c \ - $(XEMACS)\src\marker.c \ + $(XEMACS)\src\marker.c +DOC_SRC4=\ $(XEMACS)\src\md5.c \ - $(XEMACS)\src\menubar-x.c \ - $(XEMACS)\src\menubar.c \ $(XEMACS)\src\minibuf.c \ $(XEMACS)\src\nt.c \ $(XEMACS)\src\ntheap.c \ $(XEMACS)\src\ntproc.c \ - $(XEMACS)\src\objects-x.c \ $(XEMACS)\src\objects.c \ - $(XEMACS)\src\opaque.c -DOC_SRC5=\ + $(XEMACS)\src\opaque.c \ $(XEMACS)\src\print.c \ $(XEMACS)\src\process.c \ $(XEMACS)\src\pure.c \ $(XEMACS)\src\rangetab.c \ $(XEMACS)\src\realpath.c \ $(XEMACS)\src\redisplay-output.c \ - $(XEMACS)\src\redisplay-x.c \ $(XEMACS)\src\redisplay.c \ $(XEMACS)\src\regex.c \ - $(XEMACS)\src\scrollbar-x.c \ $(XEMACS)\src\scrollbar.c \ $(XEMACS)\src\search.c \ $(XEMACS)\src\signal.c \ - $(XEMACS)\src\sound.c \ + $(XEMACS)\src\sound.c +DOC_SRC5=\ $(XEMACS)\src\specifier.c \ $(XEMACS)\src\strftime.c \ $(XEMACS)\src\symbols.c \ $(XEMACS)\src\syntax.c \ $(XEMACS)\src\sysdep.c \ - $(XEMACS)\src\termcap.c -DOC_SRC6=\ + $(XEMACS)\src\termcap.c \ $(XEMACS)\src\tparam.c \ $(XEMACS)\src\undo.c \ $(XEMACS)\src\unexnt.c \ $(XEMACS)\src\vm-limit.c \ $(XEMACS)\src\window.c \ + $(XEMACS)\src\widget.c + +!if $(HAVE_X) +DOC_SRC6=\ + $(XEMACS)\src\balloon_help.c \ + $(XEMACS)\src\console-x.c \ + $(XEMACS)\src\device-x.c \ + $(XEMACS)\src\dialog-x.c \ + $(XEMACS)\src\EmacsFrame.c \ + $(XEMACS)\src\EmacsManager.c \ + $(XEMACS)\src\EmacsShell-sub.c\ + $(XEMACS)\src\EmacsShell.c \ + $(XEMACS)\src\event-Xt.c \ + $(XEMACS)\src\frame-x.c \ + $(XEMACS)\src\glyphs-x.c \ + $(XEMACS)\src\gui-x.c \ + $(XEMACS)\src\menubar.c \ + $(XEMACS)\src\menubar-x.c \ + $(XEMACS)\src\objects-x.c \ + $(XEMACS)\src\redisplay-x.c \ + $(XEMACS)\src\scrollbar-x.c \ + $(XEMACS)\src\balloon-x.c \ $(XEMACS)\src\xgccache.c \ $(XEMACS)\src\xmu.c \ - $(XEMACS)\src\xselect.c \ - $(XEMACS)\src\balloon-x.c \ - $(XEMACS)\src\balloon_help.c \ + $(XEMACS)\src\xselect.c +!endif + +!if $(HAVE_MSW) +DOC_SRCS_7=\ + $(XEMACS)\src\console-msw.c \ + $(XEMACS)\src\device-msw.c \ + $(XEMACS)\src\event-msw.c \ + $(XEMACS)\src\frame-msw.c \ + $(XEMACS)\src\objects-msw.c \ + $(XEMACS)\src\redisplay-msw.c \ + $(XEMACS)\src\msw-proc.c +!endif + +!if $(HAVE_MULE) +DOC_SRCS_8=\ $(XEMACS)\src\input-method-xlib.c \ $(XEMACS)\src\mule.c \ $(XEMACS)\src\mule-charset.c \ $(XEMACS)\src\mule-ccl.c \ - $(XEMACS)\src\mule-coding.c \ - $(XEMACS)\src\widget.c + $(XEMACS)\src\mule-coding.c +!endif MAKE_DOCFILE=$(LIB_SRC)\make-docfile.exe @@ -245,13 +288,12 @@ link.exe -out:$@ -subsystem:windows -entry:WinMainCRTStartup \ -pdb:none -release -incremental:no $** \ kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib \ - advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib \ - odbccp32.lib libc.lib + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib libc.lib $(OUTDIR)\runemacs.obj: $(XEMACS)\nt\runemacs.c $(CC) -nologo -ML -w $(OPT) -c \ -D_DEBUG -DWIN32 -D_WIN32 -DWIN32_LEAN_AND_MEAN \ - -D_NTSDK -D_M_IX86 -D_X86_ -Demacs -DHAVE_CONFIG_H -D_MSC_VER=999 \ + -D_M_IX86 -D_X86_ -Demacs -DHAVE_CONFIG_H -D_MSC_VER=999 \ $** -Fo$@ SUPPORT_PROGS=$(MAKE_DOCFILE) $(RUNEMACS) @@ -262,31 +304,77 @@ TEMACS_DIR=$(XEMACS)\src TEMACS=$(TEMACS_DIR)\temacs.exe +TEMACS_BROWSE=$(TEMACS_DIR)\temacs.bsc TEMACS_SRC=$(XEMACS)\src -TEMACS_LIBS=$(LASTFILE) $(LWLIB) Xaw.lib Xmu.lib Xt.lib SM.lib ICE.lib \ - Xext.lib X11.lib kernel32.lib user32.lib gdi32.lib \ +TEMACS_LIBS=$(LASTFILE) $(LWLIB) $(X_LIBS) kernel32.lib user32.lib gdi32.lib \ winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib \ - uuid.lib odbc32.lib odbccp32.lib wsock32.lib libc.lib + uuid.lib wsock32.lib libc.lib TEMACS_LFLAGS=-nologo $(LIBRARIES) -base:0x1000000\ - -stack:0x800000 -entry:_start -subsystem:console -pdb:none\ - -map:$(TEMACS_DIR)\temacs.map -debug:full -debugtype:both -machine:I386\ - -nodefaultlib -out:$@\ - -heap:0x00100000 + -stack:0x800000 -entry:_start -subsystem:console\ + -pdb:$(TEMACS_DIR)\temacs.pdb -map:$(TEMACS_DIR)\temacs.map -debug:full\ + -heap:0x00100000 -out:$@\ -TEMACS_CPP_FLAGS= $(INCLUDES) -D_DEBUG -DWIN32 -D_WIN32 -DWIN32_LEAN_AND_MEAN \ - -D_NTSDK -D_M_IX86 -D_X86_ -Demacs -DHAVE_CONFIG_H -D_MSC_VER=999 \ +TEMACS_CPP_FLAGS= $(INCLUDES) $(DEFINES) \ -DEMACS_MAJOR_VERSION=$(emacs_major_version) \ -DEMACS_MINOR_VERSION=$(emacs_minor_version) \ -DXEMACS_CODENAME=\"$(xemacs_codename)\" \ -DPATH_PREFIX=\"$(XEMACS)\" TEMACS_FLAGS=-nologo -ML -w $(OPT) -c $(TEMACS_CPP_FLAGS) +!if $(HAVE_X) +TEMACS_X_OBJS=\ + $(OUTDIR)\balloon-x.obj \ + $(OUTDIR)\balloon_help.obj \ + $(OUTDIR)\console-x.obj \ + $(OUTDIR)\device-x.obj \ + $(OUTDIR)\dialog-x.obj \ + $(OUTDIR)\EmacsFrame.obj \ + $(OUTDIR)\EmacsManager.obj \ + $(OUTDIR)\EmacsShell.obj \ + $(OUTDIR)\TopLevelEmacsShell.obj\ + $(OUTDIR)\TransientEmacsShell.obj\ + $(OUTDIR)\event-Xt.obj \ + $(OUTDIR)\frame-x.obj \ + $(OUTDIR)\glyphs-x.obj \ + $(OUTDIR)\gui-x.obj \ + $(OUTDIR)\menubar.obj \ + $(OUTDIR)\menubar-x.obj \ + $(OUTDIR)\objects-x.obj \ + $(OUTDIR)\redisplay-x.obj \ + $(OUTDIR)\scrollbar.obj \ + $(OUTDIR)\scrollbar-x.obj \ + $(OUTDIR)\xgccache.obj \ + $(OUTDIR)\xmu.obj \ + $(OUTDIR)\xselect.obj +!endif + +!if $(HAVE_MSW) +TEMACS_MSW_OBJS=\ + $(OUTDIR)\console-msw.obj \ + $(OUTDIR)\device-msw.obj \ + $(OUTDIR)\event-msw.obj \ + $(OUTDIR)\frame-msw.obj \ + $(OUTDIR)\objects-msw.obj \ + $(OUTDIR)\redisplay-msw.obj \ + $(OUTDIR)\msw-proc.obj +!endif + +!if $(HAVE_MULE) +TEMACS_MULE_OBJS=\ + $(OUTDIR)\input-method-xlib.obj \ + $(OUTDIR)\mule.obj \ + $(OUTDIR)\mule-charset.obj \ + $(OUTDIR)\mule-ccl.obj \ + $(OUTDIR)\mule-coding.obj \ +!endif + TEMACS_OBJS= \ + $(TEMACS_X_OBJS)\ + $(TEMACS_MSW_OBJS)\ + $(TEMACS_MULE_OBJS)\ $(OUTDIR)\abbrev.obj \ $(OUTDIR)\alloc.obj \ $(OUTDIR)\alloca.obj \ - $(OUTDIR)\balloon-x.obj \ - $(OUTDIR)\balloon_help.obj \ $(OUTDIR)\blocktype.obj \ $(OUTDIR)\buffer.obj \ $(OUTDIR)\bytecode.obj \ @@ -298,14 +386,11 @@ $(OUTDIR)\cmdloop.obj \ $(OUTDIR)\cmds.obj \ $(OUTDIR)\console-stream.obj \ - $(OUTDIR)\console-x.obj \ $(OUTDIR)\console.obj \ $(OUTDIR)\data.obj \ $(OUTDIR)\debug.obj \ - $(OUTDIR)\device-x.obj \ $(OUTDIR)\device.obj \ $(OUTDIR)\dgif_lib.obj \ - $(OUTDIR)\dialog-x.obj \ $(OUTDIR)\dialog.obj \ $(OUTDIR)\dired.obj \ $(OUTDIR)\doc.obj \ @@ -314,16 +399,9 @@ $(OUTDIR)\editfns.obj \ $(OUTDIR)\elhash.obj \ $(OUTDIR)\emacs.obj \ - $(OUTDIR)\EmacsFrame.obj \ - $(OUTDIR)\EmacsManager.obj \ - $(OUTDIR)\TopLevelEmacsShell.obj\ - $(OUTDIR)\TransientEmacsShell.obj\ - $(OUTDIR)\EmacsShell.obj \ - $(OUTDIR)\energize.obj \ $(OUTDIR)\eval.obj \ $(OUTDIR)\event-stream.obj \ $(OUTDIR)\event-unixoid.obj \ - $(OUTDIR)\event-Xt.obj \ $(OUTDIR)\events.obj \ $(OUTDIR)\extents.obj \ $(OUTDIR)\faces.obj \ @@ -333,16 +411,13 @@ $(OUTDIR)\floatfns.obj \ $(OUTDIR)\fns.obj \ $(OUTDIR)\font-lock.obj \ - $(OUTDIR)\frame-x.obj \ $(OUTDIR)\frame.obj \ $(OUTDIR)\free-hook.obj \ $(OUTDIR)\general.obj \ $(OUTDIR)\gif_err.obj \ $(OUTDIR)\gifalloc.obj \ - $(OUTDIR)\glyphs-x.obj \ $(OUTDIR)\glyphs.obj \ $(OUTDIR)\gmalloc.obj \ - $(OUTDIR)\gui-x.obj \ $(OUTDIR)\gui.obj \ $(OUTDIR)\hash.obj \ $(OUTDIR)\indent.obj \ @@ -350,23 +425,16 @@ $(OUTDIR)\insdel.obj \ $(OUTDIR)\intl.obj \ $(OUTDIR)\keymap.obj \ + $(OUTDIR)\line-number.obj \ $(OUTDIR)\lread.obj \ $(OUTDIR)\lstream.obj \ $(OUTDIR)\macros.obj \ $(OUTDIR)\marker.obj \ $(OUTDIR)\md5.obj \ - $(OUTDIR)\menubar-x.obj \ - $(OUTDIR)\menubar.obj \ $(OUTDIR)\minibuf.obj \ - $(OUTDIR)\input-method-xlib.obj \ - $(OUTDIR)\mule.obj \ - $(OUTDIR)\mule-charset.obj \ - $(OUTDIR)\mule-ccl.obj \ - $(OUTDIR)\mule-coding.obj \ $(OUTDIR)\nt.obj \ $(OUTDIR)\ntheap.obj \ $(OUTDIR)\ntproc.obj \ - $(OUTDIR)\objects-x.obj \ $(OUTDIR)\objects.obj \ $(OUTDIR)\opaque.obj \ $(OUTDIR)\print.obj \ @@ -375,11 +443,8 @@ $(OUTDIR)\rangetab.obj \ $(OUTDIR)\realpath.obj \ $(OUTDIR)\redisplay-output.obj \ - $(OUTDIR)\redisplay-x.obj \ $(OUTDIR)\redisplay.obj \ $(OUTDIR)\regex.obj \ - $(OUTDIR)\scrollbar-x.obj \ - $(OUTDIR)\scrollbar.obj \ $(OUTDIR)\search.obj \ $(OUTDIR)\signal.obj \ $(OUTDIR)\sound.obj \ @@ -388,123 +453,21 @@ $(OUTDIR)\symbols.obj \ $(OUTDIR)\syntax.obj \ $(OUTDIR)\sysdep.obj \ - $(OUTDIR)\termcap.obj \ $(OUTDIR)\tparam.obj \ $(OUTDIR)\undo.obj \ $(OUTDIR)\unexnt.obj \ $(OUTDIR)\vm-limit.obj \ $(OUTDIR)\widget.obj \ - $(OUTDIR)\window.obj \ - $(OUTDIR)\xgccache.obj \ - $(OUTDIR)\xmu.obj \ - $(OUTDIR)\xselect.obj - -$(TEMACS): $(TEMACS_INCLUDES) $(TEMACS_OBJS) - link.exe @<< - $(TEMACS_LFLAGS) $(TEMACS_OBJS) $(TEMACS_LIBS) -<< - -$(OUTDIR)\abbrev.obj: $(TEMACS_SRC)\abbrev.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\alloc.obj: $(TEMACS_SRC)\alloc.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\alloca.obj: $(TEMACS_SRC)\alloca.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\balloon-x.obj: $(TEMACS_SRC)\balloon-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\balloon_help.obj: $(TEMACS_SRC)\balloon_help.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ + $(OUTDIR)\window.obj -$(OUTDIR)\blocktype.obj: $(TEMACS_SRC)\blocktype.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\buffer.obj: $(TEMACS_SRC)\buffer.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\bytecode.obj: $(TEMACS_SRC)\bytecode.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\callint.obj: $(TEMACS_SRC)\callint.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\callproc.obj: $(TEMACS_SRC)\callproc.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\casefiddle.obj: $(TEMACS_SRC)\casefiddle.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\casetab.obj: $(TEMACS_SRC)\casetab.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\chartab.obj: $(TEMACS_SRC)\chartab.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\cmdloop.obj: $(TEMACS_SRC)\cmdloop.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\cmds.obj: $(TEMACS_SRC)\cmds.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ +# Rules -$(OUTDIR)\console-stream.obj: $(TEMACS_SRC)\console-stream.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\console-x.obj: $(TEMACS_SRC)\console-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\console.obj: $(TEMACS_SRC)\console.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\data.obj: $(TEMACS_SRC)\data.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\debug.obj: $(TEMACS_SRC)\debug.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\device-x.obj: $(TEMACS_SRC)\device-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\device.obj: $(TEMACS_SRC)\device.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\dgif_lib.obj: $(TEMACS_SRC)\dgif_lib.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\dialog-x.obj: $(TEMACS_SRC)\dialog-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ +.SUFFIXES: +.SUFFIXES: .c -$(OUTDIR)\dialog.obj: $(TEMACS_SRC)\dialog.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\dired.obj: $(TEMACS_SRC)\dired.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\doc.obj: $(TEMACS_SRC)\doc.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\doprnt.obj: $(TEMACS_SRC)\doprnt.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\dynarr.obj: $(TEMACS_SRC)\dynarr.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\editfns.obj: $(TEMACS_SRC)\editfns.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\elhash.obj: $(TEMACS_SRC)\elhash.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\emacs.obj: $(TEMACS_SRC)\emacs.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\EmacsFrame.obj: $(TEMACS_SRC)\EmacsFrame.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\EmacsManager.obj: $(TEMACS_SRC)\EmacsManager.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ +# nmake rule +{$(TEMACS_SRC)}.c{$(OUTDIR)}.obj: + $(CC) $(TEMACS_FLAGS) $< -Fo$@ -Fr$*.sbr $(OUTDIR)\TopLevelEmacsShell.obj: $(TEMACS_SRC)\EmacsShell-sub.c $(CC) $(TEMACS_FLAGS) -DDEFINE_TOP_LEVEL_EMACS_SHELL $** -Fo$@ @@ -512,279 +475,92 @@ $(OUTDIR)\TransientEmacsShell.obj: $(TEMACS_SRC)\EmacsShell-sub.c $(CC) $(TEMACS_FLAGS) -DDEFINE_TRANSIENT_EMACS_SHELL $** -Fo$@ -$(OUTDIR)\EmacsShell.obj: $(TEMACS_SRC)\EmacsShell.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\energize.obj: $(TEMACS_SRC)\energize.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\eval.obj: $(TEMACS_SRC)\eval.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\event-stream.obj: $(TEMACS_SRC)\event-stream.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\event-unixoid.obj: $(TEMACS_SRC)\event-unixoid.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\event-Xt.obj: $(TEMACS_SRC)\event-Xt.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\events.obj: $(TEMACS_SRC)\events.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\extents.obj: $(TEMACS_SRC)\extents.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\faces.obj: $(TEMACS_SRC)\faces.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\fileio.obj: $(TEMACS_SRC)\fileio.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\filelock.obj: $(TEMACS_SRC)\filelock.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\filemode.obj: $(TEMACS_SRC)\filemode.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\floatfns.obj: $(TEMACS_SRC)\floatfns.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\fns.obj: $(TEMACS_SRC)\fns.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\font-lock.obj: $(TEMACS_SRC)\font-lock.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\frame-x.obj: $(TEMACS_SRC)\frame-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\frame.obj: $(TEMACS_SRC)\frame.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\free-hook.obj: $(TEMACS_SRC)\free-hook.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\general.obj: $(TEMACS_SRC)\general.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\gif_err.obj: $(TEMACS_SRC)\gif_err.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\gifalloc.obj: $(TEMACS_SRC)\gifalloc.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\glyphs-x.obj: $(TEMACS_SRC)\glyphs-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\glyphs.obj: $(TEMACS_SRC)\glyphs.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\gmalloc.obj: $(TEMACS_SRC)\gmalloc.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\gui-x.obj: $(TEMACS_SRC)\gui-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\gui.obj: $(TEMACS_SRC)\gui.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\hash.obj: $(TEMACS_SRC)\hash.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\indent.obj: $(TEMACS_SRC)\indent.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\inline.obj: $(TEMACS_SRC)\inline.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\insdel.obj: $(TEMACS_SRC)\insdel.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\intl.obj: $(TEMACS_SRC)\intl.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\keymap.obj: $(TEMACS_SRC)\keymap.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\lread.obj: $(TEMACS_SRC)\lread.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\lstream.obj: $(TEMACS_SRC)\lstream.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\macros.obj: $(TEMACS_SRC)\macros.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\marker.obj: $(TEMACS_SRC)\marker.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\md5.obj: $(TEMACS_SRC)\md5.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\menubar-x.obj: $(TEMACS_SRC)\menubar-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\menubar.obj: $(TEMACS_SRC)\menubar.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\minibuf.obj: $(TEMACS_SRC)\minibuf.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\msdos.obj: $(TEMACS_SRC)\msdos.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\input-method-xlib.obj: $(TEMACS_SRC)\input-method-xlib.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\mule.obj: $(TEMACS_SRC)\mule.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\mule-charset.obj: $(TEMACS_SRC)\mule-charset.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\mule-ccl.obj: $(TEMACS_SRC)\mule-ccl.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\mule-coding.obj: $(TEMACS_SRC)\mule-coding.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\nt.obj: $(TEMACS_SRC)\nt.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\ntheap.obj: $(TEMACS_SRC)\ntheap.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\ntproc.obj: $(TEMACS_SRC)\ntproc.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\objects-x.obj: $(TEMACS_SRC)\objects-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\objects.obj: $(TEMACS_SRC)\objects.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\opaque.obj: $(TEMACS_SRC)\opaque.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\print.obj: $(TEMACS_SRC)\print.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\process.obj: $(TEMACS_SRC)\process.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\pure.obj: $(TEMACS_SRC)\pure.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\rangetab.obj: $(TEMACS_SRC)\rangetab.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\realpath.obj: $(TEMACS_SRC)\realpath.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\redisplay-output.obj: $(TEMACS_SRC)\redisplay-output.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\redisplay-x.obj: $(TEMACS_SRC)\redisplay-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\redisplay.obj: $(TEMACS_SRC)\redisplay.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\regex.obj: $(TEMACS_SRC)\regex.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\scrollbar-x.obj: $(TEMACS_SRC)\scrollbar-x.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\scrollbar.obj: $(TEMACS_SRC)\scrollbar.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\search.obj: $(TEMACS_SRC)\search.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\signal.obj: $(TEMACS_SRC)\signal.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\sound.obj: $(TEMACS_SRC)\sound.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\specifier.obj: $(TEMACS_SRC)\specifier.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\strftime.obj: $(TEMACS_SRC)\strftime.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\symbols.obj: $(TEMACS_SRC)\symbols.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\syntax.obj: $(TEMACS_SRC)\syntax.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\sysdep.obj: $(TEMACS_SRC)\sysdep.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\termcap.obj: $(TEMACS_SRC)\termcap.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\tparam.obj: $(TEMACS_SRC)\tparam.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\undo.obj: $(TEMACS_SRC)\undo.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\unexnt.obj: $(TEMACS_SRC)\unexnt.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\vm-limit.obj: $(TEMACS_SRC)\vm-limit.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\widget.obj: $(TEMACS_SRC)\widget.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\window.obj: $(TEMACS_SRC)\window.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\xgccache.obj: $(TEMACS_SRC)\xgccache.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\xmu.obj: $(TEMACS_SRC)\xmu.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - -$(OUTDIR)\xselect.obj: $(TEMACS_SRC)\xselect.c - $(CC) $(TEMACS_FLAGS) $** -Fo$@ - #$(TEMACS_SRC)\Emacs.ad.h: $(XEMACS)\etc\Emacs.ad # !"sed -f ad2c.sed < $(XEMACS)\etc\Emacs.ad > $(TEMACS_SRC)\Emacs.ad.h" #$(TEMACS_SRC)\paths.h: $(TEMACS_SRC)\paths.h.in # !"cd $(TEMACS_SRC); cp paths.h.in paths.h" +$(TEMACS): $(TEMACS_INCLUDES) $(TEMACS_OBJS) + link.exe @<< + $(TEMACS_LFLAGS) $(TEMACS_OBJS) $(TEMACS_LIBS) +<< + +# MSDEV Source Broswer file. "*.sbr" is too inclusive but this is harmless +$(TEMACS_BROWSE): $(TEMACS_OBJS) + dir /b/s $(OUTDIR)\*.sbr > bscmake.tmp + bscmake -o$@ @bscmake.tmp + del bscmake.tmp + #------------------------------------------------------------------------------ # LISP bits 'n bobs -$(DOC): $(LIB_SRC)\make-docfile.exe +LOADPATH=$(LISP) + +$(DOC): $(LOADPATH)\startup.elc $(LIB_SRC)\make-docfile.exe + del $(DOC) !$(TEMACS) -batch -l make-docfile.el -- -o $(DOC) -i $(XEMACS)\site-packages !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC1) !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC2) !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC3) !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC4) - !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC4) !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC5) + !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC6) + !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC7) + !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC8) -LOADPATH=$(LISP)\prim -dump-elcs: - !"$(TEMACS) -batch -l update-elc.el" +$(LOADPATH)\startup.elc: $(LOADPATH)\startup.el + !$(TEMACS) -batch -l update-elc.el + +update-elc: $(LOADPATH)\startup.el + !$(TEMACS) -batch -l update-elc.el dump-xemacs: - !"$(TEMACS) -batch -l loadup.el dump" + cd $(TEMACS_DIR) + !$(TEMACS) -batch -l loadup.el dump #------------------------------------------------------------------------------ # use this rule to build the complete system -all: $(LASTFILE) $(LWLIB) $(TEMACS) $(SUPPORT_PROGS) $(DOC) +all: $(LASTFILE) $(LWLIB) $(SUPPORT_PROGS) $(TEMACS) $(TEMACS_BROWSE) $(DOC) dump-xemacs # use this rule to install the system install: + +# The last line demands that you have a semi-decent shell +distclean: + -mkdepend -f xemacs.mak + del *.bak + del *.orig + del *.rej + del *.pdb + del *.tmp + del puresize-adjust.h + cd $(OUTDIR) + del *.obj + del *.sbr + del *.lib + cd ..\$(TEMACS_DIR) + del config.h + del paths.h + del *.bak + del *.orig + del *.rej + del *.exe + del *.map + del *.bsc + del *.pdb + cd $(LIB_SRC) + del DOC + del *.bak + del *.orig + del *.rej + del *.exe + cd $(LISP) + -del /s /q *.bak *.elc *.orig *.rej + +depend: + mkdepend -f xemacs.mak -p$(OUTDIR)\ -o.obj -w9999 -- $(TEMACS_CPP_FLAGS) -- $(DOC_SRC1) $(DOC_SRC2) $(DOC_SRC3) $(DOC_SRC4) $(DOC_SRC5) $(DOC_SRC6) $(DOC_SRC7) $(DOC_SRC8) $(LASTFILE_SRC)\lastfile.c $(LIB_SRC)\make-docfile.c .\runemacs.c + +# DO NOT DELETE THIS LINE -- make depend depends on it. diff -r d8688acf4c5b -r 78f53ef88e17 packages/README.Debian --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/packages/README.Debian Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,22 @@ +The `install-info' supplied with Debian Linux 1.3, and installed as +`/usr/sbin/install-info' is not compatible with the official +`install-info' from the Texinfo distribution. XEmacs package +installation requires GNU `install-info'. + +We hope this issue will be made moot in the next release of Debian +Linux. For now, Debian users need to get the Texinfo distribution +(version 3.11 or above), then build and install GNU `install-info' +where it will not conflict with the Debian version. When installing +XEmacs packages, check the Makefile to make sure it refers to the GNU +version of `install-info'. + +>>>>> sb == "Steve Baur" writes: + + >> I still can't find an install-info for Debian Linux that isn't + >> theirs. + + sb> ftp://prep.ai.mit.edu/pub/gnu/texinfo-3.11.tar.gz + + sb> Accept no substitutes. + +Mirrors are OK. :-) \ No newline at end of file diff -r d8688acf4c5b -r 78f53ef88e17 src/ChangeLog --- a/src/ChangeLog Mon Aug 13 10:05:53 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 10:06:47 2007 +0200 @@ -1,3 +1,110 @@ +1997-11-15 Jonathan Harris + + * console.h + mswindows is now a window-system according to + CONSOLE_TYPESYM_WIN_P + + * device.msw.c + Now calls init_baud_rate & init_one_device + + * msw-proc.c + Fixed C-key so key is returned unshifted + + * redisplay-msw.c + Modeline and vertical divider appearance tweaks + + +1997-11-14 SL Baur + + * console.c (Fsuspend_emacs): Fix docstring. Evaluating + `suspend-hook' cannot stop suspension. + +1997-11-14 Marc Paquette + + * callproc.c (Fcall_process_internal): Do CRLF -> LF + conversion when reading process output. + +1997-11-14 Hrvoje Niksic + + * redisplay.c (init_redisplay): Handle not having DISPLAY and not + having TTY support. + +1997-11-14 Hrvoje Niksic + + * events.c (Fmake_event): Support DND events. + +1997-11-10 Hrvoje Niksic + + * events.c (Fmake_event): Reenable the event creation code. + (Fmake_event): Canonicalize the plist. + +1997-11-13 SL Baur + + * mule-charset.c (Fcharset_id): Typecast result to Lisp_Object. + + * mule-ccl.c (CCL_WRITE_STRING): Reorder parens to avoid compiler + barf on Lisp_Object. + (Fregister_ccl_program): Remove unused variable idx. + + * mule-canna.c: Fix declaration of mule_strlen(). + + * mule-coding.h (ENCODE_SJIS): Parenthesize first two params to + avoid compilation problems. + +1997-11-13 Olivier Galibert + + * mule-charset.h: Added preliminary support for charset Ids. + + * mule-charset.c: Added preliminary support for charset Ids. + + * redisplay-msw.c (separate_textual_runs): Synched with FSF 20.2 + ccl API. + + * redisplay-x.c (separate_textual_runs): Synched with FSF 20.2 ccl + API. + + * mule-coding.c: Synched with FSF 20.2 ccl API. + + * mule-coding.h: Moved ccl part to mule-ccl.h. + + * mule-ccl.c: Synched with FSF 20.2. + + * mule-ccl.h: New file. + +Thu Nov 13 21:34:13 1997 Marc Paquette + + * nt.c (REG_ROOT): Use a registry key different that the one for + NTEmacs. + +1997-11-12 SL Baur + + * lrecord.h: Fix typo in set_lheader_implementation. + From: Robert Pluim + +1997-11-13 Olivier Galibert + + * configure.in: Remove HAVE_TIMEZONE_DECL test. + +1997-11-13 Olivier Galibert + + * s/freebsd.h: Remove HAVE_TIMEZONE_DECL forced value. + + * config.h.in: Remove HAVE_TIMEZONE_DECL reference. + + * systime.h: Remove timezone conditional declaration. + +1997-11-12 Kyle Jones + + * console.c: Use symbol_value_forward_lheader_initializer + in various DEFVAR* macros. Forgot this in previous + related patch. + + * lisp-disunion.h: Provide a no-op XUNMARK macro for + the GC error checking code even if GCMARKBITS is not + greater than 0. + + * lisp-union.h: Ditto. + 1997-11-10 Hrvoje Niksic * event-stream.c: Make echo_keystrokes a Lisp_Object. @@ -215,15 +322,6 @@ * events.c (Fevent_modeline_position): Return nil if event is not over modeline, as the docstring says. - * utils/facemenu.el (facemenu-insert-menu-entry): Check for - menubar availability. - - * utils/easymenu.el (easy-menu-change): Check for menubar - availability. - - * custom/wid-edit.el (widget-echo-help): Use `help-echo' as label - for help-echo messages. - 1997-11-05 Martin Buchholz > * s/aix3-1.h: Remove ^L character wich confuses AIX make. diff -r d8688acf4c5b -r 78f53ef88e17 src/callproc.c --- a/src/callproc.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/callproc.c Mon Aug 13 10:06:47 2007 +0200 @@ -584,6 +584,18 @@ if (nread == 0) break; +#ifdef DOS_NT + /* Until we pull out of MULE things like + make_decoding_input_stream(), we do the following which is + less elegant. --marcpa */ + { + int lf_count; + if (NILP (Vbinary_process_output)) { + nread = nread - crlf_to_lf(nread, bufptr, &lf_count); + } + } +#endif + total_read += nread; if (!NILP (buffer)) diff -r d8688acf4c5b -r 78f53ef88e17 src/config.h.in --- a/src/config.h.in Mon Aug 13 10:05:53 2007 +0200 +++ b/src/config.h.in Mon Aug 13 10:06:47 2007 +0200 @@ -207,9 +207,6 @@ /* Can `gettimeofday' accept two arguments? */ #undef GETTIMEOFDAY_ONE_ARGUMENT -/* Is the timezone variable already declared in system headers? */ -#undef HAVE_TIMEZONE_DECL - #undef HAVE_MMAP #undef HAVE_STRCOLL #undef HAVE_GETPGRP diff -r d8688acf4c5b -r 78f53ef88e17 src/console-msw.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/console-msw.c Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,75 @@ +/* Console functions for mswindows. + Copyright (C) 1996 Ben Wing. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs 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 General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Ben Wing: January 1996, for 19.14. + Rewritten for mswindows by Jonathan Harris, November 1997 for 20.4. + */ + +#include +#include "lisp.h" + +#include "console-msw.h" + +DEFINE_CONSOLE_TYPE (mswindows); + + +static int +mswindows_initially_selected_for_input (struct console *con) +{ + return 1; +} + + + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_console_mswindows (void) +{ +} + +void +console_type_create_mswindows (void) +{ + INITIALIZE_CONSOLE_TYPE (mswindows, "mswindows", "console-mswindows-p"); + + /* console methods */ +/* CONSOLE_HAS_METHOD (mswindows, init_console); */ +/* CONSOLE_HAS_METHOD (mswindows, mark_console); */ + CONSOLE_HAS_METHOD (mswindows, initially_selected_for_input); +/* CONSOLE_HAS_METHOD (mswindows, delete_console); */ +/* CONSOLE_HAS_METHOD (mswindows, canonicalize_console_connection); */ +/* CONSOLE_HAS_METHOD (mswindows, canonicalize_device_connection); */ +/* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_console_connection); */ +/* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_device_connection); */ +} + +void +vars_of_console_mswindows (void) +{ + Fprovide (Qmswindows); +} diff -r d8688acf4c5b -r 78f53ef88e17 src/console-msw.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/console-msw.h Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,87 @@ +/* Define mswindowsindows-specific console, device, and frame object for XEmacs. + Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. + Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs 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 General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + + +/* Authorship: + + Ultimately based on FSF, then later on JWZ work for Lemacs. + Rewritten over time by Ben Wing and Chuck Thompson. + Rewritten for mswindows by Jonathan Harris, November 1997 for 20.4. + */ + +#ifndef _XEMACS_CONSOLE_MSW_H_ +#define _XEMACS_CONSOLE_MSW_H_ + +#include "console.h" + +#include "windows.h" + +DECLARE_CONSOLE_TYPE (mswindows); + +struct mswindows_console +{ + int infd, outfd; +}; + + +struct mswindows_device +{ + int logpixelsx, logpixelsy; + int planes, cells; + int horzres, vertres; /* Size in pixels */ + int horzsize, vertsize; /* Size in mm */ +}; + +#define DEVICE_MSWINDOWS_DATA(d) DEVICE_TYPE_DATA (d, mswindows) +#define DEVICE_MSWINDOWS_LOGPIXELSX(d) (DEVICE_MSWINDOWS_DATA (d)->logpixelsx) +#define DEVICE_MSWINDOWS_LOGPIXELSY(d) (DEVICE_MSWINDOWS_DATA (d)->logpixelsy) +#define DEVICE_MSWINDOWS_PLANES(d) (DEVICE_MSWINDOWS_DATA (d)->planes) +#define DEVICE_MSWINDOWS_CELLS(d) (DEVICE_MSWINDOWS_DATA (d)->cells) +#define DEVICE_MSWINDOWS_HORZRES(d) (DEVICE_MSWINDOWS_DATA (d)->horzres) +#define DEVICE_MSWINDOWS_VERTRES(d) (DEVICE_MSWINDOWS_DATA (d)->vertres) +#define DEVICE_MSWINDOWS_HORZSIZE(d) (DEVICE_MSWINDOWS_DATA (d)->horzsize) +#define DEVICE_MSWINDOWS_VERTSIZE(d) (DEVICE_MSWINDOWS_DATA (d)->vertsize) + + +struct mswindows_frame +{ + /* win32 window handle */ + HWND hwnd; + + /* DC for this win32 window */ + HDC hdc; +}; + +#define FRAME_MSWINDOWS_DATA(f) FRAME_TYPE_DATA (f, mswindows) + +#define FRAME_MSWINDOWS_HANDLE(f) (FRAME_MSWINDOWS_DATA (f)->hwnd) +#define FRAME_MSWINDOWS_DC(f) (FRAME_MSWINDOWS_DATA (f)->hdc) + + +/* + * Redisplay functions + */ +void mswindows_redraw_exposed_area (struct frame *f, int x, int y, + int width, int height); + +#endif /* _XEMACS_CONSOLE_MSW_H_ */ diff -r d8688acf4c5b -r 78f53ef88e17 src/console-w32.c --- a/src/console-w32.c Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,75 +0,0 @@ -/* Console functions for win32. - Copyright (C) 1996 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Ben Wing: January 1996, for 19.14. - Rewritten for win32 by Jonathan Harris, November 1997 for 20.4. - */ - -#include -#include "lisp.h" - -#include "console-w32.h" - -DEFINE_CONSOLE_TYPE (w32); - - -static int -w32_initially_selected_for_input (struct console *con) -{ - return 1; -} - - - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_console_w32 (void) -{ -} - -void -console_type_create_w32 (void) -{ - INITIALIZE_CONSOLE_TYPE (w32, "w32", "console-w32-p"); - - /* console methods */ -/* CONSOLE_HAS_METHOD (w32, init_console); */ -/* CONSOLE_HAS_METHOD (w32, mark_console); */ - CONSOLE_HAS_METHOD (w32, initially_selected_for_input); -/* CONSOLE_HAS_METHOD (w32, delete_console); */ -/* CONSOLE_HAS_METHOD (w32, canonicalize_console_connection); */ -/* CONSOLE_HAS_METHOD (w32, canonicalize_device_connection); */ -/* CONSOLE_HAS_METHOD (w32, semi_canonicalize_console_connection); */ -/* CONSOLE_HAS_METHOD (w32, semi_canonicalize_device_connection); */ -} - -void -vars_of_console_w32 (void) -{ - Fprovide (Qw32); -} diff -r d8688acf4c5b -r 78f53ef88e17 src/console-w32.h --- a/src/console-w32.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ -/* Define win32 specific console, device, and frame object for XEmacs. - Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - - -/* Authorship: - - Ultimately based on FSF, then later on JWZ work for Lemacs. - Rewritten over time by Ben Wing and Chuck Thompson. - Rewritten for win32 by Jonathan Harris, November 1997 for 20.4. - */ - -#ifndef _XEMACS_CONSOLE_W32_H_ -#define _XEMACS_CONSOLE_W32_H_ - -#include "console.h" - -#include "windows.h" - -DECLARE_CONSOLE_TYPE (w32); - -struct w32_console -{ - int infd, outfd; -}; - - -struct w32_device -{ - int logpixelsx, logpixelsy; - int planes, cells; - int horzres, vertres; /* Size in pixels */ - int horzsize, vertsize; /* Size in mm */ -}; - -#define DEVICE_W32_DATA(d) DEVICE_TYPE_DATA (d, w32) -#define DEVICE_W32_LOGPIXELSX(d) (DEVICE_W32_DATA (d)->logpixelsx) -#define DEVICE_W32_LOGPIXELSY(d) (DEVICE_W32_DATA (d)->logpixelsy) -#define DEVICE_W32_PLANES(d) (DEVICE_W32_DATA (d)->planes) -#define DEVICE_W32_CELLS(d) (DEVICE_W32_DATA (d)->cells) -#define DEVICE_W32_HORZRES(d) (DEVICE_W32_DATA (d)->horzres) -#define DEVICE_W32_VERTRES(d) (DEVICE_W32_DATA (d)->vertres) -#define DEVICE_W32_HORZSIZE(d) (DEVICE_W32_DATA (d)->horzsize) -#define DEVICE_W32_VERTSIZE(d) (DEVICE_W32_DATA (d)->vertsize) - - -struct w32_frame -{ - /* win32 window handle */ - HWND hwnd; - - /* DC for this win32 window */ - HDC hdc; -}; - -#define FRAME_W32_DATA(f) FRAME_TYPE_DATA (f, w32) - -#define FRAME_W32_HANDLE(f) (FRAME_W32_DATA (f)->hwnd) -#define FRAME_W32_DC(f) (FRAME_W32_DATA (f)->hdc) - - -/* - * Redisplay functions - */ -void w32_redraw_exposed_area (struct frame *f, int x, int y, - int width, int height); - -#endif /* _XEMACS_CONSOLE_W32_H_ */ diff -r d8688acf4c5b -r 78f53ef88e17 src/console.c --- a/src/console.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/console.c Mon Aug 13 10:06:47 2007 +0200 @@ -320,8 +320,7 @@ Return the type of the specified console (e.g. `x' or `tty'). Value is `tty' for a tty console (a character-only terminal), `x' for a console that is an X display, -`win32' for a console that is a Windows or Windows NT connection (not yet - implemented), +`mswindows' for a console that is a Windows NT/95/97 connection, `pc' for a console that is a direct-write MS-DOS connection (not yet implemented), `stream' for a stream console (which acts like a stdio stream), and @@ -824,10 +823,9 @@ If optional arg STUFFSTRING is non-nil, its characters are stuffed to be read as terminal input by Emacs's superior shell. -Before suspending, if `suspend-hook' is bound and value is non-nil -call the value as a function of no args. Don't suspend if it returns non-nil. -Otherwise, suspend normally and after resumption call -`suspend-resume-hook' if that is bound and non-nil. + +Before suspending, run the normal hook `suspend-hook'. +After resumption run the normal hook `suspend-resume-hook'. Some operating systems cannot stop the Emacs process and resume it later. On such systems, Emacs will start a subshell and wait for it to exit. @@ -1169,7 +1167,7 @@ makes debugging unbelievably more bearable) */ #define DEFVAR_CONSOLE_LOCAL(lname, field_name) do { \ static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ + = { { { symbol_value_forward_lheader_initializer, \ (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ SYMVAL_SELECTED_CONSOLE_FORWARD }, 0 }; \ defvar_console_local ((lname), &I_hate_C); \ @@ -1177,7 +1175,7 @@ #define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) do { \ static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ + = { { { symbol_value_forward_lheader_initializer, \ (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ SYMVAL_SELECTED_CONSOLE_FORWARD }, magicfun }; \ defvar_console_local ((lname), &I_hate_C); \ @@ -1185,7 +1183,7 @@ #define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name) do { \ static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ + = { { { symbol_value_forward_lheader_initializer, \ (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, 0 }; \ defvar_console_local ((lname), &I_hate_C); \ @@ -1193,7 +1191,7 @@ #define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) do { \ static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ + = { { { symbol_value_forward_lheader_initializer, \ (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, magicfun }; \ defvar_console_local ((lname), &I_hate_C); \ @@ -1201,7 +1199,7 @@ #define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) do { \ static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ + = { { { symbol_value_forward_lheader_initializer, \ (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ SYMVAL_DEFAULT_CONSOLE_FORWARD }, 0 }; \ defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \ @@ -1209,7 +1207,7 @@ #define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun) do { \ static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { { lrecord_symbol_value_forward }, \ + = { { { symbol_value_forward_lheader_initializer, \ (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ SYMVAL_DEFAULT_CONSOLE_FORWARD }, magicfun }; \ defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \ diff -r d8688acf4c5b -r 78f53ef88e17 src/console.h --- a/src/console.h Mon Aug 13 10:05:53 2007 +0200 +++ b/src/console.h Mon Aug 13 10:06:47 2007 +0200 @@ -439,15 +439,15 @@ #else #define CONSOLE_TYPESYM_TTY_P(typesym) 0 #endif -#ifdef HAVE_W32GUI -#define CONSOLE_TYPESYM_W32_P(typesym) EQ (typesym, Qw32) +#ifdef HAVE_MS_WINDOWS +#define CONSOLE_TYPESYM_MSWINDOWS_P(typesym) EQ (typesym, Qmswindows) #else -#define CONSOLE_TYPESYM_W32_P(typesym) 0 +#define CONSOLE_TYPESYM_MSWINDOWS_P(typesym) 0 #endif #define CONSOLE_TYPESYM_STREAM_P(typesym) EQ (typesym, Qstream) #define CONSOLE_TYPESYM_WIN_P(typesym) \ - (CONSOLE_TYPESYM_X_P (typesym)) + (CONSOLE_TYPESYM_X_P (typesym) || CONSOLE_TYPESYM_MSWINDOWS_P (typesym)) #define CONSOLE_X_P(con) CONSOLE_TYPESYM_X_P (CONSOLE_TYPE (con)) #define CHECK_X_CONSOLE(z) CHECK_CONSOLE_TYPE (z, x) @@ -457,9 +457,9 @@ #define CHECK_TTY_CONSOLE(z) CHECK_CONSOLE_TYPE (z, tty) #define CONCHECK_TTY_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, tty) -#define CONSOLE_W32_P(con) CONSOLE_TYPESYM_W32_P (CONSOLE_TYPE (con)) -#define CHECK_W32_CONSOLE(z) CHECK_CONSOLE_TYPE (z, w32) -#define CONCHECK_W32_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, w32) +#define CONSOLE_MSWINDOWS_P(con) CONSOLE_TYPESYM_MSWINDOWS_P (CONSOLE_TYPE (con)) +#define CHECK_MSWINDOWS_CONSOLE(z) CHECK_CONSOLE_TYPE (z, mswindows) +#define CONCHECK_MSWINDOWS_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, mswindows) #define CONSOLE_STREAM_P(con) CONSOLE_TYPESYM_STREAM_P (CONSOLE_TYPE (con)) #define CHECK_STREAM_CONSOLE(z) CHECK_CONSOLE_TYPE (z, stream) @@ -501,9 +501,9 @@ #ifdef HAVE_X_WINDOWS extern Lisp_Object Qx; #endif /* HAVE_X_WINDOWS */ -#ifdef HAVE_W32GUI -extern Lisp_Object Qw32; -#endif /* HAVE_W32GUI */ +#ifdef HAVE_MS_WINDOWS +extern Lisp_Object Qmswindows; +#endif /* HAVE_MS_WINDOWS */ int valid_console_type_p (Lisp_Object type); diff -r d8688acf4c5b -r 78f53ef88e17 src/device-msw.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/device-msw.c Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,159 @@ +/* Device functions for mswindows. + Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. + Copyright (C) 1994, 1995 Free Software Foundation, Inc. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs 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 General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Original authors: Jamie Zawinski and the FSF + Rewritten by Ben Wing and Chuck Thompson. + Rewritten for mswindows by Jonathan Harris, November 1997 for 20.4. +*/ + + +#include +#include "lisp.h" + +#include "console-msw.h" +#include "console-stream.h" +#include "events.h" +#include "event-msw.h" +#include "faces.h" +#include "frame.h" + +Lisp_Object Qinit_pre_mswindows_win, Qinit_post_mswindows_win; + +DWORD mswindows_main_thread_id; +DWORD mswindows_win_thread_id; + +static void +mswindows_init_device (struct device *d, Lisp_Object props) +{ + struct console *con = XCONSOLE (DEVICE_CONSOLE (d)); + HWND desktop; + HDC hdc; + MSG msg; + HANDLE handle; + + DEVICE_INFD (d) = DEVICE_OUTFD (d) = -1; + init_baud_rate (d); + init_one_device (d); + + /* Ensure our message queue is created */ + PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE); + + mswindows_main_thread_id = GetCurrentThreadId (); +#if 0 + DuplicateHandle (GetCurrentProcess (), GetCurrentThread (), + GetCurrentProcess (), &hMainThread, 0, TRUE, DUPLICATE_SAME_ACCESS); +#endif + handle = CreateThread (NULL, 0, + (LPTHREAD_START_ROUTINE) mswindows_win_thread, + 0, 0, &mswindows_win_thread_id); + AttachThreadInput (mswindows_main_thread_id, mswindows_win_thread_id, TRUE); + + d->device_data = xnew_and_zero (struct mswindows_device); + + desktop = GetDesktopWindow(); + hdc = GetDC(desktop); + DEVICE_MSWINDOWS_LOGPIXELSX(d) = GetDeviceCaps(hdc, LOGPIXELSX); + DEVICE_MSWINDOWS_LOGPIXELSY(d) = GetDeviceCaps(hdc, LOGPIXELSY); + DEVICE_MSWINDOWS_PLANES(d) = GetDeviceCaps(hdc, PLANES); + /* FIXME: Only valid if RC_PALETTE bit set in RASTERCAPS, + what should we return for a non-palette-based device? */ + DEVICE_MSWINDOWS_CELLS(d) = GetDeviceCaps(hdc, SIZEPALETTE); + DEVICE_MSWINDOWS_HORZRES(d) = GetDeviceCaps(hdc, HORZRES); + DEVICE_MSWINDOWS_VERTRES(d) = GetDeviceCaps(hdc, VERTRES); + DEVICE_MSWINDOWS_HORZSIZE(d) = GetDeviceCaps(hdc, HORZSIZE); + DEVICE_MSWINDOWS_VERTSIZE(d) = GetDeviceCaps(hdc, VERTSIZE); + ReleaseDC(desktop, hdc); + + /* Wait for windows thread to be ready */ + GetMessage (&msg, NULL, WM_XEMACS_ACK, WM_XEMACS_ACK); +} + +static int +mswindows_device_pixel_width (struct device *d) +{ + return(DEVICE_MSWINDOWS_HORZRES(d)); +} + +static int +mswindows_device_pixel_height (struct device *d) +{ + return(DEVICE_MSWINDOWS_VERTRES(d)); +} + +static int +mswindows_device_mm_width (struct device *d) +{ + return(DEVICE_MSWINDOWS_HORZSIZE(d)); +} + +static int +mswindows_device_mm_height (struct device *d) +{ + return(DEVICE_MSWINDOWS_VERTSIZE(d)); +} + +static int +mswindows_device_bitplanes (struct device *d) +{ + return(DEVICE_MSWINDOWS_PLANES(d)); +} + +static int +mswindows_device_color_cells (struct device *d) +{ + return(DEVICE_MSWINDOWS_CELLS(d)); +} + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_device_mswindows (void) +{ + defsymbol (&Qinit_pre_mswindows_win, "init-pre-mswindows-win"); + defsymbol (&Qinit_post_mswindows_win, "init-post-mswindows-win"); +} + +void +console_type_create_device_mswindows (void) +{ + CONSOLE_HAS_METHOD (mswindows, init_device); +/* CONSOLE_HAS_METHOD (mswindows, finish_init_device); */ +/* CONSOLE_HAS_METHOD (mswindows, mark_device); */ +/* CONSOLE_HAS_METHOD (mswindows, delete_device); */ + CONSOLE_HAS_METHOD (mswindows, device_pixel_width); + CONSOLE_HAS_METHOD (mswindows, device_pixel_height); + CONSOLE_HAS_METHOD (mswindows, device_mm_width); + CONSOLE_HAS_METHOD (mswindows, device_mm_height); + CONSOLE_HAS_METHOD (mswindows, device_bitplanes); + CONSOLE_HAS_METHOD (mswindows, device_color_cells); +} + +void +vars_of_device_mswindows (void) +{ +} diff -r d8688acf4c5b -r 78f53ef88e17 src/device-w32.c --- a/src/device-w32.c Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,155 +0,0 @@ -/* Device functions for win32. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1994, 1995 Free Software Foundation, Inc. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Original authors: Jamie Zawinski and the FSF - Rewritten by Ben Wing and Chuck Thompson. - Rewritten for win32 by Jonathan Harris, November 1997 for 20.4. -*/ - - -#include -#include "lisp.h" - -#include "console-w32.h" -#include "console-stream.h" -#include "events.h" -#include "event-w32.h" -#include "faces.h" -#include "frame.h" - -Lisp_Object Qinit_pre_w32_win, Qinit_post_w32_win; - -DWORD w32_main_thread_id; -DWORD w32_win_thread_id; - -static void -w32_init_device (struct device *d, Lisp_Object props) -{ - struct console *con = XCONSOLE (DEVICE_CONSOLE (d)); - HWND desktop; - HDC hdc; - MSG msg; - HANDLE handle; - - /* Ensure our message queue is created */ - PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE); - - w32_main_thread_id = GetCurrentThreadId (); -#if 0 - DuplicateHandle (GetCurrentProcess (), GetCurrentThread (), - GetCurrentProcess (), &hMainThread, 0, TRUE, DUPLICATE_SAME_ACCESS); -#endif - handle = CreateThread (NULL, 0, - (LPTHREAD_START_ROUTINE) w32_win_thread, - 0, 0, &w32_win_thread_id); - AttachThreadInput (w32_main_thread_id, w32_win_thread_id, TRUE); - - d->device_data = xnew_and_zero (struct w32_device); - - desktop = GetDesktopWindow(); - hdc = GetDC(desktop); - DEVICE_W32_LOGPIXELSX(d) = GetDeviceCaps(hdc, LOGPIXELSX); - DEVICE_W32_LOGPIXELSY(d) = GetDeviceCaps(hdc, LOGPIXELSY); - DEVICE_W32_PLANES(d) = GetDeviceCaps(hdc, PLANES); - /* FIXME: Only valid if RC_PALETTE bit set in RASTERCAPS, - what should we return for a non-palette-based device? */ - DEVICE_W32_CELLS(d) = GetDeviceCaps(hdc, SIZEPALETTE); - DEVICE_W32_HORZRES(d) = GetDeviceCaps(hdc, HORZRES); - DEVICE_W32_VERTRES(d) = GetDeviceCaps(hdc, VERTRES); - DEVICE_W32_HORZSIZE(d) = GetDeviceCaps(hdc, HORZSIZE); - DEVICE_W32_VERTSIZE(d) = GetDeviceCaps(hdc, VERTSIZE); - ReleaseDC(desktop, hdc); - - /* Wait for windows thread to be ready */ - GetMessage (&msg, NULL, WM_XEMACS_ACK, WM_XEMACS_ACK); -} - -static int -w32_device_pixel_width (struct device *d) -{ - return(DEVICE_W32_HORZRES(d)); -} - -static int -w32_device_pixel_height (struct device *d) -{ - return(DEVICE_W32_VERTRES(d)); -} - -static int -w32_device_mm_width (struct device *d) -{ - return(DEVICE_W32_HORZSIZE(d)); -} - -static int -w32_device_mm_height (struct device *d) -{ - return(DEVICE_W32_VERTSIZE(d)); -} - -static int -w32_device_bitplanes (struct device *d) -{ - return(DEVICE_W32_PLANES(d)); -} - -static int -w32_device_color_cells (struct device *d) -{ - return(DEVICE_W32_CELLS(d)); -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_device_w32 (void) -{ - defsymbol (&Qinit_pre_w32_win, "init-pre-w32-win"); - defsymbol (&Qinit_post_w32_win, "init-post-w32-win"); -} - -void -console_type_create_device_w32 (void) -{ - CONSOLE_HAS_METHOD (w32, init_device); -/* CONSOLE_HAS_METHOD (w32, finish_init_device); */ -/* CONSOLE_HAS_METHOD (w32, mark_device); */ -/* CONSOLE_HAS_METHOD (w32, delete_device); */ - CONSOLE_HAS_METHOD (w32, device_pixel_width); - CONSOLE_HAS_METHOD (w32, device_pixel_height); - CONSOLE_HAS_METHOD (w32, device_mm_width); - CONSOLE_HAS_METHOD (w32, device_mm_height); - CONSOLE_HAS_METHOD (w32, device_bitplanes); - CONSOLE_HAS_METHOD (w32, device_color_cells); -} - -void -vars_of_device_w32 (void) -{ -} diff -r d8688acf4c5b -r 78f53ef88e17 src/emacs.c --- a/src/emacs.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/emacs.c Mon Aug 13 10:06:47 2007 +0200 @@ -697,10 +697,10 @@ display_use = "x"; #endif /* HAVE_X_WINDOWS */ -#ifdef HAVE_W32GUI +#ifdef HAVE_MS_WINDOWS if (!noninteractive) - display_use = "w32"; -#endif /* HAVE_W32GUI */ + display_use = "mswindows"; +#endif /* HAVE_MS_WINDOWS */ } #endif /* HAVE_WINDOW_SYSTEM */ @@ -879,12 +879,12 @@ #endif #endif /* HAVE_X_WINDOWS */ -#ifdef HAVE_W32GUI - syms_of_console_w32 (); - syms_of_device_w32 (); - syms_of_event_w32 (); - syms_of_frame_w32 (); - syms_of_objects_w32 (); +#ifdef HAVE_MS_WINDOWS + syms_of_console_mswindows (); + syms_of_device_mswindows (); + syms_of_event_mswindows (); + syms_of_frame_mswindows (); + syms_of_objects_mswindows (); #endif #ifdef MULE @@ -974,12 +974,12 @@ #endif #endif /* HAVE_X_WINDOWS */ -#ifdef HAVE_W32GUI - console_type_create_w32 (); - console_type_create_device_w32 (); - console_type_create_frame_w32 (); - console_type_create_objects_w32 (); - console_type_create_redisplay_w32 (); +#ifdef HAVE_MS_WINDOWS + console_type_create_mswindows (); + console_type_create_device_mswindows (); + console_type_create_frame_mswindows (); + console_type_create_objects_mswindows (); + console_type_create_redisplay_mswindows (); #endif /* Now initialize the specifier types and associated symbols. @@ -1210,12 +1210,12 @@ #endif #endif -#ifdef HAVE_W32GUI - vars_of_device_w32 (); - vars_of_console_w32 (); - vars_of_event_w32 (); - vars_of_frame_w32 (); - vars_of_objects_w32 (); +#ifdef HAVE_MS_WINDOWS + vars_of_device_mswindows (); + vars_of_console_mswindows (); + vars_of_event_mswindows (); + vars_of_frame_mswindows (); + vars_of_objects_mswindows (); #endif #ifdef MULE diff -r d8688acf4c5b -r 78f53ef88e17 src/event-msw.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/event-msw.c Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,423 @@ +/* The mswindows event_stream interface. + Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. + Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 1996 Ben Wing. + Copyright (C) 1997 Jonathan Harris. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs 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 General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Ultimately based on FSF. + Rewritten by Ben Wing. + Rewritten for mswindows by Jonathan Harris, November 1997 for 20.4. + */ + +#include +#include "lisp.h" + +#include "device.h" +#include "console-msw.h" +#include "events.h" +#include "frame.h" +#include "process.h" + +#include "sysproc.h" +#include "syswait.h" +#include "systime.h" + +#include "event-msw.h" + +static struct event_stream *mswindows_event_stream; +static Lisp_Object mswindows_dispatch_event_queue, mswindows_dispatch_event_queue_tail; +static mswindows_waitable_count=0; +CRITICAL_SECTION mswindows_dispatch_crit; + +static Lisp_Object mswindows_dequeue_dispatch_event (void); + +/* + * List of mswindows waitable handles. + * Apart from the dispatch queue semaphore, all of these handles may be waited + * on multiple times in emacs_mswindows_next_event before being processed and so must + * be manual-reset events. + */ +static HANDLE mswindows_waitable[MAX_WAITABLE]; + +/* random emacs info associated with each of the wait handles */ +static mswindows_waitable_info_type mswindows_waitable_info[MAX_WAITABLE]; + +void +mswindows_enqueue_dispatch_event (Lisp_Object event) +{ + assert(mswindows_waitable_count); +// EnterCriticalSection (&mswindows_dispatch_crit); + enqueue_event (event, &mswindows_dispatch_event_queue, &mswindows_dispatch_event_queue_tail); + ReleaseSemaphore(mswindows_waitable[0], 1, NULL); +// LeaveCriticalSection (&mswindows_dispatch_crit); +} + +static Lisp_Object +mswindows_dequeue_dispatch_event (void) +{ + Lisp_Object event; + assert(mswindows_waitable_count); +// EnterCriticalSection (&mswindows_dispatch_crit); + event = dequeue_event (&mswindows_dispatch_event_queue, &mswindows_dispatch_event_queue_tail); +// LeaveCriticalSection (&mswindows_dispatch_crit); + return event; +} + +/* + * Find a free waitable slot + */ +static int +mswindows_find_free_waitable(void) +{ + int i; + for (i=0; itype) + { + case mswindows_waitable_type_dispatch: + /* Can only have one waitable for the dispatch queue, and it's the first one */ + assert (mswindows_waitable_count++ == 0); + waitable=0; + InitializeCriticalSection(&mswindows_dispatch_crit); + assert (mswindows_waitable[0] = CreateSemaphore (NULL, 0, 0x7fffffff, NULL)); + return mswindows_waitable_info+0; + +#if 0 /* Windows95 doesn't support WaitableTimers */ + case mswindows_waitable_type_timeout: + { + LARGE_INTEGER due; + due.QuadPart = 10000 * (LONGLONG) info->data.timeout.milliseconds; + waitable = mswindows_find_free_waitable(); + mswindows_waitable[waitable] = CreateWaitableTimer(NULL, TRUE, NULL); + SetWaitableTimer(mswindows_waitable[waitable], &due, 0, NULL, NULL, FALSE); + mswindows_waitable_info[waitable].data.timeout.id = waitable; + } + break; +#endif + + default: + assert(0); + } + mswindows_waitable_info[waitable].type = info->type; + return mswindows_waitable_info+waitable; +} + +/* + * Remove a waitable using the type and data passed in by the info structure. + */ +void +mswindows_remove_waitable(mswindows_waitable_info_type *info) +{ + int waitable; + + switch (info->type) + { +#if 0 + case mswindows_waitable_type_timeout: + waitable = info->data.timeout.id; + CancelWaitableTimeout(mswindows_waitable[waitable]); + break; +#endif + + default: + assert(0); + } + + CloseHandle(mswindows_waitable[waitable]); + mswindows_waitable[waitable] = 0; + mswindows_waitable_info[waitable].type = mswindows_waitable_type_none; + if (waitable == mswindows_waitable_count-1) + --mswindows_waitable_count; +} + + +/************************************************************************/ +/* methods */ +/************************************************************************/ + +static int +emacs_mswindows_add_timeout (EMACS_TIME thyme) +{ + EMACS_TIME current_time; + int milliseconds; + int id; + mswindows_request_type request; + + EMACS_GET_TIME (current_time); + EMACS_SUB_TIME (thyme, thyme, current_time); + milliseconds = EMACS_SECS (thyme) * 1000 + EMACS_USECS (thyme) / 1000; + if (milliseconds < 1) + milliseconds = 1; + request.thing1 = (void *) milliseconds; + id = mswindows_make_request(WM_XEMACS_SETTIMER, 0, &request); + assert(id); /* XXX */ + return id; +} + +static void +emacs_mswindows_remove_timeout (int id) +{ + mswindows_request_type request = { (void *) id }; + mswindows_make_request(WM_XEMACS_KILLTIMER, 0, &request); +} + +static int +emacs_mswindows_event_pending_p (int user_p) +{ + return 0; +} + +static struct console * +find_console_from_fd (int fd) +{ + return 0; +} + +/* + * Return the next event + * We return windows events off the dispatch event queue in preference to other events + */ +static void +emacs_mswindows_next_event (struct Lisp_Event *emacs_event) +{ + DWORD active; + active = WaitForMultipleObjects (mswindows_waitable_count, mswindows_waitable, + FALSE, INFINITE); + assert(active >= WAIT_OBJECT_0 && active <= WAIT_OBJECT_0 + mswindows_waitable_count - 1); + + /* Windows events on the dispatch event queue */ + if (active == WAIT_OBJECT_0) + { + /* XXX Copied from event-Xt.c */ + Lisp_Object event, event2; + + EnterCriticalSection (&mswindows_dispatch_crit); + XSETEVENT (event2, emacs_event); + event = mswindows_dequeue_dispatch_event (); + Fcopy_event (event, event2); + Fdeallocate_event (event); + LeaveCriticalSection (&mswindows_dispatch_crit); + } + else + { + /* XXX FIXME: We should do some kind of round-robin scheme to ensure fairness */ + int waitable = active - WAIT_OBJECT_0; + mswindows_waitable_info_type *info = mswindows_waitable_info + waitable; + + switch (info->type) + { + case mswindows_waitable_type_timeout: + emacs_event->channel = Qnil; + emacs_event->event_type = timeout_event; + emacs_event->event.timeout.interval_id = info->data.timeout.id; + mswindows_remove_waitable(info); + break; + + default: + assert(0); + } + } +} + +/* + * Handle a magic event off the dispatch queue. + * XXX split into seperate functions for clarity. + */ +static void +emacs_mswindows_handle_magic_event (struct Lisp_Event *emacs_event) +{ + RECT *rect = &EVENT_MSWINDOWS_MAGIC_DATA(emacs_event); + struct frame *f = XFRAME (EVENT_CHANNEL (emacs_event)); + Lisp_Object frame = Qnil; + XSETFRAME (frame, f); +#if 0 + stderr_out("magic %x, (%d,%d), (%d,%d)\n", + EVENT_MSWINDOWS_MAGIC_TYPE(emacs_event), + rect->left, rect->top, rect->right, rect->bottom); +#endif + switch (EVENT_MSWINDOWS_MAGIC_TYPE(emacs_event)) + { + case WM_SETFOCUS: + case WM_KILLFOCUS: + { + int in_p = (EVENT_MSWINDOWS_MAGIC_TYPE(emacs_event) == WM_SETFOCUS); + Lisp_Object conser; + /* struct gcpro gcpro1; */ + + /* Clear sticky modifiers here (if we had any) */ + + conser = Fcons (frame, Fcons (FRAME_DEVICE (f), in_p ? Qt : Qnil)); + /* GCPRO1 (conser); XXX Not necessary? */ + emacs_handle_focus_change_preliminary (conser); + /* Under X the stuff up to here is done in the X event handler. + I Don't know why */ + emacs_handle_focus_change_final (conser); + /* UNGCPRO; */ + } + break; + + /* XXX What about Enter & Leave */ +#if 0 + va_run_hook_with_args (in_p ? Qmouse_enter_frame_hook : + Qmouse_leave_frame_hook, 1, frame); + break; +#endif + + case WM_SIZE: + if ((rect->left & rect->top & rect->right & rect->bottom) == -1) + { + /* Iconified */ + FRAME_VISIBLE_P (f) = 0; + va_run_hook_with_args (Qunmap_frame_hook, 1, frame); + Fframe_iconified_p (frame); + } + else + { + /* If we're uniconified, our size may or may not have changed */ + int columns, rows; + int was_visible = FRAME_VISIBLE_P (f); + pixel_to_char_size (f, rect->right, rect->bottom, &columns, &rows); + + FRAME_VISIBLE_P (f) = 1; + if (f->height!=rows || f->width!=columns || f->size_change_pending) + { + /* Size changed */ + f->pixwidth = rect->right; + f->pixheight = rect->bottom; + change_frame_size (f, rows, columns, 0); +/* MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); /* XXX Too extreme? */ + } + + if (!was_visible) + va_run_hook_with_args (Qmap_frame_hook, 1, frame); + + } + break; + + case WM_PAINT: + mswindows_redraw_exposed_area(f, rect->left, rect->top, + rect->right, rect->bottom); + break; + + default: + assert(0); + } +} + +static void +emacs_mswindows_select_process (struct Lisp_Process *process) +{ +} + +static void +emacs_mswindows_unselect_process (struct Lisp_Process *process) +{ +} + +static void +emacs_mswindows_select_console (struct console *con) +{ +} + +static void +emacs_mswindows_unselect_console (struct console *con) +{ +} + +static void +emacs_mswindows_quit_p (void) +{ +} + +/* This is called from GC when a process object is about to be freed. + If we've still got pointers to it in this file, we're gonna lose hard. + */ +void +debug_process_finalization (struct Lisp_Process *p) +{ +#if 0 /* #### */ + int i; + int infd, outfd; + get_process_file_descriptors (p, &infd, &outfd); + /* if it still has fds, then it hasn't been killed yet. */ + assert (infd < 0); + assert (outfd < 0); + /* Better not still be in the "with input" table; we know it's got no fds. */ + for (i = 0; i < MAXDESC; i++) + { + Lisp_Object process = filedesc_fds_with_input [i]; + assert (!PROCESSP (process) || XPROCESS (process) != p); + } +#endif +} + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +vars_of_event_mswindows (void) +{ + mswindows_dispatch_event_queue = Qnil; + staticpro (&mswindows_dispatch_event_queue); + mswindows_dispatch_event_queue_tail = Qnil; + + mswindows_event_stream = xnew (struct event_stream); + + mswindows_event_stream->event_pending_p = emacs_mswindows_event_pending_p; + mswindows_event_stream->next_event_cb = emacs_mswindows_next_event; + mswindows_event_stream->handle_magic_event_cb = emacs_mswindows_handle_magic_event; + mswindows_event_stream->add_timeout_cb = emacs_mswindows_add_timeout; + mswindows_event_stream->remove_timeout_cb = emacs_mswindows_remove_timeout; + mswindows_event_stream->select_console_cb = emacs_mswindows_select_console; + mswindows_event_stream->unselect_console_cb = emacs_mswindows_unselect_console; + mswindows_event_stream->select_process_cb = emacs_mswindows_select_process; + mswindows_event_stream->unselect_process_cb = emacs_mswindows_unselect_process; + mswindows_event_stream->quit_p_cb = emacs_mswindows_quit_p; +} + +void +syms_of_event_mswindows (void) +{ +} + +void +init_event_mswindows_late (void) +{ + event_stream = mswindows_event_stream; +} diff -r d8688acf4c5b -r 78f53ef88e17 src/event-msw.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/event-msw.h Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,130 @@ +/* mswindows-specific defines for event-handling. + Copyright (C) 1997 Jonathan Harris. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs 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 General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Jonathan Harris, November 1997 for 20.4. + */ + +#ifndef _XEMACS_EVENT_MSW_H_ +#define _XEMACS_EVENT_MSW_H_ + +#include + +/* + * XXX FIXME: The following X modifier defs in events-mod.h clash with win32 + * hotkey defs in winuser.h. For the moment lose the win32 versions. + * Maybe we should rename all of MOD_* to something that doesn't clash. + */ +#ifdef MOD_CONTROL +# undef MOD_CONTROL +#endif +#ifdef MOD_ALT +# undef MOD_ALT +#endif +#ifdef MOD_SHIFT +# undef MOD_SHIFT +#endif +#include "events-mod.h" + +/* The name of the main window class */ +#define XEMACS_CLASS "XEmacs" + +/* Random globals shared between main and message-processing thread */ +extern DWORD mswindows_main_thread_id; +extern DWORD mswindows_win_thread_id; +extern CRITICAL_SECTION mswindows_dispatch_crit; + + +/* + * Communication between main and windows thread + */ +#define WM_XEMACS_BASE (WM_APP + 0) +#define WM_XEMACS_ACK (WM_XEMACS_BASE + 0x00) +#define WM_XEMACS_CREATEWINDOW (WM_XEMACS_BASE + 0x01) +#define WM_XEMACS_SETTIMER (WM_XEMACS_BASE + 0x02) +#define WM_XEMACS_KILLTIMER (WM_XEMACS_BASE + 0x03) +#define WM_XEMACS_END (WM_XEMACS_BASE + 0x10) + +typedef struct mswindows_request_type +{ + void *thing1; + void *thing2; +} mswindows_request_type; + +LPARAM mswindows_make_request(UINT message, WPARAM wParam, mswindows_request_type *request); +void mswindows_handle_request(MSG *msg); + + +/* + * Event generating stuff + */ + +/* The number of things we can wait on */ +#define MAX_WAITABLE 256 + +typedef enum mswindows_waitable_type +{ + mswindows_waitable_type_none, + mswindows_waitable_type_dispatch, + mswindows_waitable_type_timeout, + mswindows_waitable_type_process, + mswindows_waitable_type_socket +} mswindows_waitable_type; + +typedef struct mswindows_timeout_data +{ + int milliseconds; + int id; +} mswindows_timeout_data; + +typedef struct mswindows_waitable_info_type +{ + mswindows_waitable_type type; + union + { + mswindows_timeout_data timeout; + } data; +} mswindows_waitable_info_type; + +mswindows_waitable_info_type *mswindows_add_waitable(mswindows_waitable_info_type *info); +void mswindows_remove_waitable(mswindows_waitable_info_type *info); + +/* + * Some random function declarations in mswindows-proc.c + */ +DWORD mswindows_win_thread(); +extern void mswindows_enqeue_dispatch_event (Lisp_Object event); + + +/* + * Inside mswindows magic events + */ +#define EVENT_MSWINDOWS_MAGIC_EVENT(e) \ + ((e)->event.magic.underlying_mswindows_event) +#define EVENT_MSWINDOWS_MAGIC_TYPE(e) \ + (EVENT_MSWINDOWS_MAGIC_EVENT(e).message) +#define EVENT_MSWINDOWS_MAGIC_DATA(e) \ + (*((RECT *) (&(EVENT_MSWINDOWS_MAGIC_EVENT(e).data)))) + + +#endif /* _XEMACS_EVENT_MSW_H_ */ diff -r d8688acf4c5b -r 78f53ef88e17 src/event-stream.c --- a/src/event-stream.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 10:06:47 2007 +0200 @@ -4894,8 +4894,8 @@ #if defined(HAVE_TTY) && (defined (DEBUG_TTY_EVENT_STREAM) || !defined (HAVE_X_WINDOWS)) vars_of_event_tty (); #endif -#ifdef HAVE_W32GUI - vars_of_event_w32 (); +#ifdef HAVE_MS_WINDOWS + vars_of_event_mswindows (); #endif recent_keys_ring_index = 0; @@ -5310,9 +5310,9 @@ if (!strcmp (display_use, "x")) init_event_Xt_late (); else -#elif defined(HAVE_W32GUI) - if (!strcmp (display_use, "w32")) - init_event_w32_late (); +#elif defined(HAVE_MS_WINDOWS) + if (!strcmp (display_use, "mswindows")) + init_event_mswindows_late (); else #endif { @@ -5322,8 +5322,8 @@ init_event_Xt_late (); #elif defined (HAVE_TTY) init_event_tty_late (); -#elif defined(HAVE_W32GUI) - init_event_w32_late (); +#elif defined(HAVE_MS_WINDOWS) + init_event_mswindows_late (); #endif } init_interrupts_late (); diff -r d8688acf4c5b -r 78f53ef88e17 src/event-w32.c --- a/src/event-w32.c Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,423 +0,0 @@ -/* The event_stream interface win32. - Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996 Ben Wing. - Copyright (C) 1997 Jonathan Harris. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Ultimately based on FSF. - Rewritten by Ben Wing. - Rewritten for win32 by Jonathan Harris, November 1997 for 20.4. - */ - -#include -#include "lisp.h" - -#include "device.h" -#include "console-w32.h" -#include "events.h" -#include "frame.h" -#include "process.h" - -#include "sysproc.h" -#include "syswait.h" -#include "systime.h" - -#include "event-w32.h" - -static struct event_stream *w32_event_stream; -static Lisp_Object w32_dispatch_event_queue, w32_dispatch_event_queue_tail; -static w32_waitable_count=0; -CRITICAL_SECTION w32_dispatch_crit; - -static Lisp_Object w32_dequeue_dispatch_event (void); - -/* - * List of win32 waitable handles. - * Apart from the dispatch queue semaphore, all of these handles may be waited - * on multiple times in emacs_w32_next_event before being processed and so must - * be manual-reset events. - */ -static HANDLE w32_waitable[MAX_WAITABLE]; - -/* random emacs info associated with each of the wait handles */ -static w32_waitable_info_type w32_waitable_info[MAX_WAITABLE]; - -void -w32_enqueue_dispatch_event (Lisp_Object event) -{ - assert(w32_waitable_count); -// EnterCriticalSection (&w32_dispatch_crit); - enqueue_event (event, &w32_dispatch_event_queue, &w32_dispatch_event_queue_tail); - ReleaseSemaphore(w32_waitable[0], 1, NULL); -// LeaveCriticalSection (&w32_dispatch_crit); -} - -static Lisp_Object -w32_dequeue_dispatch_event (void) -{ - Lisp_Object event; - assert(w32_waitable_count); -// EnterCriticalSection (&w32_dispatch_crit); - event = dequeue_event (&w32_dispatch_event_queue, &w32_dispatch_event_queue_tail); -// LeaveCriticalSection (&w32_dispatch_crit); - return event; -} - -/* - * Find a free waitable slot - */ -static int -w32_find_free_waitable(void) -{ - int i; - for (i=0; itype) - { - case w32_waitable_type_dispatch: - /* Can only have one waitable for the dispatch queue, and it's the first one */ - assert (w32_waitable_count++ == 0); - waitable=0; - InitializeCriticalSection(&w32_dispatch_crit); - assert (w32_waitable[0] = CreateSemaphore (NULL, 0, 0x7fffffff, NULL)); - return w32_waitable_info+0; - -#if 0 /* Windows95 doesn't support WaitableTimers */ - case w32_waitable_type_timeout: - { - LARGE_INTEGER due; - due.QuadPart = 10000 * (LONGLONG) info->data.timeout.milliseconds; - waitable = w32_find_free_waitable(); - w32_waitable[waitable] = CreateWaitableTimer(NULL, TRUE, NULL); - SetWaitableTimer(w32_waitable[waitable], &due, 0, NULL, NULL, FALSE); - w32_waitable_info[waitable].data.timeout.id = waitable; - } - break; -#endif - - default: - assert(0); - } - w32_waitable_info[waitable].type = info->type; - return w32_waitable_info+waitable; -} - -/* - * Remove a waitable using the type and data passed in by the info structure. - */ -void -w32_remove_waitable(w32_waitable_info_type *info) -{ - int waitable; - - switch (info->type) - { -#if 0 - case w32_waitable_type_timeout: - waitable = info->data.timeout.id; - CancelWaitableTimeout(w32_waitable[waitable]); - break; -#endif - - default: - assert(0); - } - - CloseHandle(w32_waitable[waitable]); - w32_waitable[waitable] = 0; - w32_waitable_info[waitable].type = w32_waitable_type_none; - if (waitable == w32_waitable_count-1) - --w32_waitable_count; -} - - -/************************************************************************/ -/* methods */ -/************************************************************************/ - -static int -emacs_w32_add_timeout (EMACS_TIME thyme) -{ - EMACS_TIME current_time; - int milliseconds; - int id; - w32_request_type request; - - EMACS_GET_TIME (current_time); - EMACS_SUB_TIME (thyme, thyme, current_time); - milliseconds = EMACS_SECS (thyme) * 1000 + EMACS_USECS (thyme) / 1000; - if (milliseconds < 1) - milliseconds = 1; - request.thing1 = (void *) milliseconds; - id = w32_make_request(WM_XEMACS_SETTIMER, 0, &request); - assert(id); /* XXX */ - return id; -} - -static void -emacs_w32_remove_timeout (int id) -{ - w32_request_type request = { (void *) id }; - w32_make_request(WM_XEMACS_KILLTIMER, 0, &request); -} - -static int -emacs_w32_event_pending_p (int user_p) -{ - return 0; -} - -static struct console * -find_console_from_fd (int fd) -{ - return 0; -} - -/* - * Return the next event - * We return windows events off the dispatch event queue in preference to other events - */ -static void -emacs_w32_next_event (struct Lisp_Event *emacs_event) -{ - DWORD active; - active = WaitForMultipleObjects (w32_waitable_count, w32_waitable, - FALSE, INFINITE); - assert(active >= WAIT_OBJECT_0 && active <= WAIT_OBJECT_0 + w32_waitable_count - 1); - - /* Windows events on the dispatch event queue */ - if (active == WAIT_OBJECT_0) - { - /* XXX Copied from event-Xt.c */ - Lisp_Object event, event2; - - EnterCriticalSection (&w32_dispatch_crit); - XSETEVENT (event2, emacs_event); - event = w32_dequeue_dispatch_event (); - Fcopy_event (event, event2); - Fdeallocate_event (event); - LeaveCriticalSection (&w32_dispatch_crit); - } - else - { - /* XXX FIXME: We should do some kind of round-robin scheme to ensure fairness */ - int waitable = active - WAIT_OBJECT_0; - w32_waitable_info_type *info = w32_waitable_info + waitable; - - switch (info->type) - { - case w32_waitable_type_timeout: - emacs_event->channel = Qnil; - emacs_event->event_type = timeout_event; - emacs_event->event.timeout.interval_id = info->data.timeout.id; - w32_remove_waitable(info); - break; - - default: - assert(0); - } - } -} - -/* - * Handle a magic event off the dispatch queue. - * XXX split into seperate functions for clarity. - */ -static void -emacs_w32_handle_magic_event (struct Lisp_Event *emacs_event) -{ - RECT *rect = &EVENT_W32_MAGIC_DATA(emacs_event); - struct frame *f = XFRAME (EVENT_CHANNEL (emacs_event)); - Lisp_Object frame = Qnil; - XSETFRAME (frame, f); -#if 0 - stderr_out("magic %x, (%d,%d), (%d,%d)\n", - EVENT_W32_MAGIC_TYPE(emacs_event), - rect->left, rect->top, rect->right, rect->bottom); -#endif - switch (EVENT_W32_MAGIC_TYPE(emacs_event)) - { - case WM_SETFOCUS: - case WM_KILLFOCUS: - { - int in_p = (EVENT_W32_MAGIC_TYPE(emacs_event) == WM_SETFOCUS); - Lisp_Object conser; - /* struct gcpro gcpro1; */ - - /* Clear sticky modifiers here (if we had any) */ - - conser = Fcons (frame, Fcons (FRAME_DEVICE (f), in_p ? Qt : Qnil)); - /* GCPRO1 (conser); XXX Not necessary? */ - emacs_handle_focus_change_preliminary (conser); - /* Under X the stuff up to here is done in the X event handler. - I Don't know why */ - emacs_handle_focus_change_final (conser); - /* UNGCPRO; */ - } - break; - - /* XXX What about Enter & Leave */ -#if 0 - va_run_hook_with_args (in_p ? Qmouse_enter_frame_hook : - Qmouse_leave_frame_hook, 1, frame); - break; -#endif - - case WM_SIZE: - if ((rect->left & rect->top & rect->right & rect->bottom) == -1) - { - /* Iconified */ - FRAME_VISIBLE_P (f) = 0; - va_run_hook_with_args (Qunmap_frame_hook, 1, frame); - Fframe_iconified_p (frame); - } - else - { - /* If we're uniconified, our size may or may not have changed */ - int columns, rows; - int was_visible = FRAME_VISIBLE_P (f); - pixel_to_char_size (f, rect->right, rect->bottom, &columns, &rows); - - FRAME_VISIBLE_P (f) = 1; - if (f->height!=rows || f->width!=columns || f->size_change_pending) - { - /* Size changed */ - f->pixwidth = rect->right; - f->pixheight = rect->bottom; - change_frame_size (f, rows, columns, 0); -/* MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); /* XXX Too extreme? */ - } - - if (!was_visible) - va_run_hook_with_args (Qmap_frame_hook, 1, frame); - - } - break; - - case WM_PAINT: - w32_redraw_exposed_area(f, rect->left, rect->top, - rect->right, rect->bottom); - break; - - default: - assert(0); - } -} - -static void -emacs_w32_select_process (struct Lisp_Process *process) -{ -} - -static void -emacs_w32_unselect_process (struct Lisp_Process *process) -{ -} - -static void -emacs_w32_select_console (struct console *con) -{ -} - -static void -emacs_w32_unselect_console (struct console *con) -{ -} - -static void -emacs_w32_quit_p (void) -{ -} - -/* This is called from GC when a process object is about to be freed. - If we've still got pointers to it in this file, we're gonna lose hard. - */ -void -debug_process_finalization (struct Lisp_Process *p) -{ -#if 0 /* #### */ - int i; - int infd, outfd; - get_process_file_descriptors (p, &infd, &outfd); - /* if it still has fds, then it hasn't been killed yet. */ - assert (infd < 0); - assert (outfd < 0); - /* Better not still be in the "with input" table; we know it's got no fds. */ - for (i = 0; i < MAXDESC; i++) - { - Lisp_Object process = filedesc_fds_with_input [i]; - assert (!PROCESSP (process) || XPROCESS (process) != p); - } -#endif -} - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -vars_of_event_w32 (void) -{ - w32_dispatch_event_queue = Qnil; - staticpro (&w32_dispatch_event_queue); - w32_dispatch_event_queue_tail = Qnil; - - w32_event_stream = xnew (struct event_stream); - - w32_event_stream->event_pending_p = emacs_w32_event_pending_p; - w32_event_stream->next_event_cb = emacs_w32_next_event; - w32_event_stream->handle_magic_event_cb = emacs_w32_handle_magic_event; - w32_event_stream->add_timeout_cb = emacs_w32_add_timeout; - w32_event_stream->remove_timeout_cb = emacs_w32_remove_timeout; - w32_event_stream->select_console_cb = emacs_w32_select_console; - w32_event_stream->unselect_console_cb = emacs_w32_unselect_console; - w32_event_stream->select_process_cb = emacs_w32_select_process; - w32_event_stream->unselect_process_cb = emacs_w32_unselect_process; - w32_event_stream->quit_p_cb = emacs_w32_quit_p; -} - -void -syms_of_event_w32 (void) -{ -} - -void -init_event_w32_late (void) -{ - event_stream = w32_event_stream; -} diff -r d8688acf4c5b -r 78f53ef88e17 src/event-w32.h --- a/src/event-w32.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,123 +0,0 @@ -/* Win32 specific defines for event-handling. - Copyright (C) 1997 Jonathan Harris. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Jonathan Harris, November 1997 for 20.4. - */ - -#include - -/* - * XXX FIXME: The following X modifier defs in events-mod.h clash with win32 - * hotkey defs in winuser.h. For the moment lose the win32 versions. - * Maybe we should rename all of MOD_* to something that doesn't clash. - */ -#ifdef MOD_CONTROL -# undef MOD_CONTROL -#endif -#ifdef MOD_ALT -# undef MOD_ALT -#endif -#ifdef MOD_SHIFT -# undef MOD_SHIFT -#endif -#include "events-mod.h" - -/* The name of the main window class */ -#define XEMACS_CLASS "XEmacs" - -/* Random globals shared between main and message-processing thread */ -extern DWORD w32_main_thread_id; -extern DWORD w32_win_thread_id; -extern CRITICAL_SECTION w32_dispatch_crit; - - -/* - * Communication between main and windows thread - */ -#define WM_XEMACS_BASE (WM_APP + 0) -#define WM_XEMACS_ACK (WM_XEMACS_BASE + 0x00) -#define WM_XEMACS_CREATEWINDOW (WM_XEMACS_BASE + 0x01) -#define WM_XEMACS_SETTIMER (WM_XEMACS_BASE + 0x02) -#define WM_XEMACS_KILLTIMER (WM_XEMACS_BASE + 0x03) -#define WM_XEMACS_END (WM_XEMACS_BASE + 0x10) - -typedef struct w32_request_type -{ - void *thing1; - void *thing2; -} w32_request_type; - -LPARAM w32_make_request(UINT message, WPARAM wParam, w32_request_type *request); -void w32_handle_request(MSG *msg); - - -/* - * Event generating stuff - */ - -/* The number of things we can wait on */ -#define MAX_WAITABLE 256 - -typedef enum w32_waitable_type -{ - w32_waitable_type_none, - w32_waitable_type_dispatch, - w32_waitable_type_timeout, - w32_waitable_type_process, - w32_waitable_type_socket -} w32_waitable_type; - -typedef struct w32_timeout_data -{ - int milliseconds; - int id; -} w32_timeout_data; - -typedef struct w32_waitable_info_type -{ - w32_waitable_type type; - union - { - w32_timeout_data timeout; - } data; -} w32_waitable_info_type; - -w32_waitable_info_type *w32_add_waitable(w32_waitable_info_type *info); -void w32_remove_waitable(w32_waitable_info_type *info); - -/* - * Some random function declarations in w32-proc.c - */ -DWORD w32_win_thread(); -extern void w32_enqeue_dispatch_event (Lisp_Object event); - - -/* - * Inside w32 magic events - */ -#define EVENT_W32_MAGIC_EVENT(e) ((e)->event.magic.underlying_w32_event) -#define EVENT_W32_MAGIC_TYPE(e) (EVENT_W32_MAGIC_EVENT(e).message) -#define EVENT_W32_MAGIC_DATA(e) \ - (*((RECT *) (&(EVENT_W32_MAGIC_EVENT(e).data)))) - diff -r d8688acf4c5b -r 78f53ef88e17 src/events.c --- a/src/events.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/events.c Mon Aug 13 10:06:47 2007 +0200 @@ -186,7 +186,7 @@ break; case pointer_motion_event: { - char buf[100]; + char buf[64]; sprintf (buf, "#event.motion.x, XEVENT (obj)->event.motion.y); write_c_string (buf, printcharfun); @@ -298,10 +298,10 @@ return (e1->event.magic.underlying_tty_event == e2->event.magic.underlying_tty_event); #endif -#ifdef HAVE_W32GUI - if (CONSOLE_W32_P (con)) - return (!memcmp(&e1->event.magic.underlying_w32_event, - &e2->event.magic.underlying_w32_event, +#ifdef HAVE_MS_WINDOWS + if (CONSOLE_MSWINDOWS_P (con)) + return (!memcmp(&e1->event.magic.underlying_mswindows_event, + &e2->event.magic.underlying_mswindows_event, sizeof(union magic_data))); #endif return 1; /* not reached */ @@ -371,14 +371,14 @@ if (CONSOLE_TTY_P (con)) return HASH2 (hash, e->event.magic.underlying_tty_event); #endif -#ifdef HAVE_W32GUI - if (CONSOLE_W32_P (con)) - return HASH6 (hash, e->event.magic.underlying_w32_event.message, - e->event.magic.underlying_w32_event.data[0], - e->event.magic.underlying_w32_event.data[1], - e->event.magic.underlying_w32_event.data[2], - e->event.magic.underlying_w32_event.data[3], - ); +#ifdef HAVE_MS_WINDOWS + if (CONSOLE_MSWINDOWS_P (con)) + return HASH6 (hash, e->event.magic.underlying_mswindows_event.message, + e->event.magic.underlying_mswindows_event.data[0], + e->event.magic.underlying_mswindows_event.data[1], + e->event.magic.underlying_mswindows_event.data[2], + e->event.magic.underlying_mswindows_event.data[3], + ); #endif } @@ -395,21 +395,60 @@ DEFUN ("make-event", Fmake_event, 0, 2, 0, /* -Create a new event of type TYPE, with properties stored in PLIST. +Create a new event of type TYPE, with properties described by PLIST. + TYPE is a symbol, either `empty', `key-press', `button-press', + `button-release', `motion' or `dnd-drop'. If TYPE is nil, it + defaults to `empty'. + +PLIST is a property list, the properties being compatible to those + returned by `event-properties'. The following properties are + allowed: + + channel -- The event channel, a frame or a console. For + button-press, button-release and motion events, this + must be a frame. For key-press events, it must be a + console. If channel is unspecified, it will be set to + the selected frame or selected console, as appropriate. + key -- The event key, a symbol or character. Allowed only for + keypress events. + button -- The event button, integer 1, 2 or 3. Allowed only for + button-press and button-release events. + modifiers -- The event modifiers, a list of modifier symbols. Allowed + for key-press, button-press, button-release and motion + events. + x -- The event X coordinate, an integer. This is relative + to the left of CHANNEL's root window. Allowed for + motion, button-press and button-release events. + y -- The event Y coordinate, an integer. This is relative + to the top of CHANNEL's root window. Allowed for + motion, button-press and button-release events. + dnd-data -- The event DND data, a list of (INTEGER DATA). Allowed + for dnd-drop events, if support for DND has been + compiled into XEmacs. + timestamp -- The event timestamp, a non-negative integer. Allowed for + all types of events. + +For event type `empty', PLIST must be nil. `button-release', or `motion'. If TYPE is left out, it defaults to `empty'. PLIST is a list of properties, as returned by `event-properties'. Not all properties are allowed for all kinds of events, and some are required. -WARNING, the event object returned may be a reused one; see the function +WARNING: the event object returned may be a reused one; see the function `deallocate-event'. */ (type, plist)) { - Lisp_Object event, prop, val; + Lisp_Object tail, keyword, value; + Lisp_Object event = Qnil; + Lisp_Object dnd_data = Qnil; struct Lisp_Event *e; + EMACS_INT coord_x = 0, coord_y = 0; + struct gcpro gcpro1, gcpro2; + + GCPRO2 (event, dnd_data); if (NILP (type)) type = Qempty; @@ -426,7 +465,19 @@ e = XEVENT (event); zero_event (e); - if (EQ (type, Qkey_press)) + if (EQ (type, Qempty)) + { + /* For empty event, we return immediately, without processing + PLIST. In fact, processing PLIST would be wrong, because the + sanitizing process would fill in the properties + (e.g. CHANNEL), which we don't want in empty events. */ + e->event_type = empty_event; + if (!NILP (plist)) + error ("Cannot set properties of empty event"); + UNGCPRO; + return event; + } + else if (EQ (type, Qkey_press)) e->event_type = key_press_event; else if (EQ (type, Qbutton_press)) e->event_type = button_press_event; @@ -434,58 +485,75 @@ e->event_type = button_release_event; else if (EQ (type, Qmotion)) e->event_type = pointer_motion_event; - else if (EQ (type, Qempty)) - e->event_type = empty_event; +#ifdef HAVE_OFFIX_DND + else if (EQ (type, Qdnd_drop)) + { + e->event_type = dnd_drop_event; + e->event.dnd_drop.data = Qnil; + } +#endif else - /* not allowed: Qmisc_user, Qprocess, Qtimeout, Qmagic, Qmagic_eval */ - /* dnd_drop is also not allowed */ - signal_simple_error ("Invalid event type", type); + { + /* Not allowed: Qmisc_user, Qprocess, Qtimeout, Qmagic, Qeval, + Qmagic_eval. */ + /* #### Should we allow misc-user events? */ + signal_simple_error ("Invalid event type", type); + } + + plist = Fcopy_sequence (plist); + Fcanonicalize_plist (plist, Qnil); /* Process the plist. */ - while (!NILP (plist)) + EXTERNAL_PROPERTY_LIST_LOOP (tail, keyword, value, plist) { - prop = Fcar (plist); - plist = Fcdr (plist); - val = Fcar (plist); - plist = Fcdr (plist); - if (EQ (prop, Qchannel)) + if (EQ (keyword, Qchannel)) { - if (!FRAMEP (val) && !NILP (val)) - signal_simple_error ("Invalid event channel", val); - EVENT_CHANNEL (e) = val; + if (e->event_type == key_press_event) + { + if (!CONSOLEP (value)) + wrong_type_argument (Qconsolep, value); + } + else + { + if (!FRAMEP (value)) + wrong_type_argument (Qframep, value); + } + EVENT_CHANNEL (e) = value; } - else if (EQ (prop, Qkey)) + else if (EQ (keyword, Qkey)) { if (e->event_type != key_press_event) - wrong_type_argument (Qkey_press_event_p, event); - if (!SYMBOLP (val) && !CHARP (val)) - signal_simple_error ("Invalid event key", val); - e->event.key.keysym = val; + signal_simple_error ("Invalid event type for `key' property", + type); + if (!SYMBOLP (value) && !CHARP (value)) + signal_simple_error ("Invalid event key", value); + e->event.key.keysym = value; } - else if (EQ (prop, Qbutton)) + else if (EQ (keyword, Qbutton)) { - CHECK_NATNUM (val); - check_int_range (XINT(val), 1, 3); + CHECK_NATNUM (value); + check_int_range (XINT(value), 1, 3); if (e->event_type != button_press_event && e->event_type != button_release_event) signal_simple_error ("Invalid event type for `button' property", type); - e->event.button.button = XINT (val); + e->event.button.button = XINT (value); } - else if (EQ (prop, Qmodifiers)) + else if (EQ (keyword, Qmodifiers)) { - Lisp_Object tail, sym; + Lisp_Object modtail, sym; int modifiers = 0; if (e->event_type != key_press_event && e->event_type != button_press_event && e->event_type != button_release_event && e->event_type != pointer_motion_event) + /* Currently unreached. */ signal_simple_error ("Invalid event type for modifiers", type); - for (tail = val; !NILP (tail); tail = Fcdr (tail)) + EXTERNAL_LIST_LOOP (modtail, value) { - sym = Fcar (tail); + sym = XCAR (modtail); if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL; else if (EQ (sym, Qmeta)) modifiers |= MOD_META; else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER; @@ -494,7 +562,7 @@ else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT; else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT; else - signal_simple_error ("Invalid key modifier", Fcar (tail)); + signal_simple_error ("Invalid key modifier", XCAR (modtail)); } if (e->event_type == key_press_event) e->event.key.modifiers = modifiers; @@ -504,34 +572,103 @@ else /* pointer_motion_event */ e->event.motion.modifiers = modifiers; } - else if (EQ (prop, Qx)) + else if (EQ (keyword, Qx)) { - CHECK_NATNUM (val); - if (e->event_type == pointer_motion_event) - e->event.motion.x = XINT (val); - else if (e->event_type == button_press_event - || e->event_type == button_release_event) - e->event.button.x = XINT (val); + /* Allow negative values, so we can specify toolbar + positions. */ + CHECK_INT (value); + if (e->event_type != pointer_motion_event + && e->event_type != button_press_event + && e->event_type != button_release_event) + { + signal_simple_error ("Cannot assign `x' property to event", + type); + } + coord_x = XINT (value); } - else if (EQ (prop, Qy)) + else if (EQ (keyword, Qy)) { - CHECK_NATNUM (val); - if (e->event_type == pointer_motion_event) - e->event.motion.y = XINT (val); - else if (e->event_type == button_press_event - || e->event_type == button_release_event) - e->event.button.y = XINT (val); + /* Allow negative values; see above. */ + CHECK_INT (value); + if (e->event_type != pointer_motion_event + && e->event_type != button_press_event + && e->event_type != button_release_event) + { + signal_simple_error ("Cannot assign `y' property to event", + type); + } + coord_y = XINT (value); + } + else if (EQ (keyword, Qtimestamp)) + { + CHECK_NATNUM (value); + e->timestamp = XINT (value); } - else if (EQ (prop, Qtimestamp)) +#ifdef HAVE_OFFIX_DND + else if (EQ (keyword, Qdnd_data)) { - CHECK_NATNUM (val); - e->timestamp = XINT (val); + Lisp_Object dnd_tail; + /* Value is a list of (INT DATA). Data is a list. */ + CHECK_CONS (value); + /* Oliver, change this to accept symbols, when the time is + ripe! */ + CHECK_NATNUM (XCAR (value)); + CHECK_CONS (XCDR (value)); + if (!NILP (XCDR (XCDR (value)))) + wrong_type_argument (Qlistp, XCDR (value)); + /* Check the list validity. */ + EXTERNAL_LIST_LOOP (dnd_tail, XCAR (XCDR (value))) + ; + /* And now, copy it all. */ + e->event.dnd_drop.data = Fcopy_tree (value, Qnil); } +#endif /* HAVE_OFFIX_DND */ else - signal_simple_error ("Invalid property", prop); + signal_simple_error ("Invalid property", keyword); } /* while */ - /* Now, let's validate what we got. */ + /* Insert the channel, if missing. */ + if (NILP (EVENT_CHANNEL (e))) + { + if (e->event_type == key_press_event) + EVENT_CHANNEL (e) = Vselected_console; + else + EVENT_CHANNEL (e) = Fselected_frame (Qnil); + } + + /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative + to the frame, so we must adjust accordingly. */ + if (e->event_type == pointer_motion_event + || e->event_type == button_press_event + || e->event_type == button_release_event +#ifdef HAVE_OFFIX_DND + || e->event_type == dnd_drop_event +#endif + ) + { + struct frame *f = XFRAME (EVENT_CHANNEL (e)); + + coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (f); + coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (f); + + if (e->event_type == pointer_motion_event) + { + e->event.motion.x = coord_x; + e->event.motion.y = coord_y; + } + else if (e->event_type == button_press_event + || e->event_type == button_release_event +#ifdef HAVE_OFFIX_DND + || e->event_type == dnd_drop_event +#endif + ) + { + e->event.button.x = coord_x; + e->event.button.y = coord_y; + } + } + + /* Finally, do some more validation. */ switch (e->event_type) { case key_press_event: @@ -540,14 +677,31 @@ break; case button_press_event: case button_release_event: +#ifdef HAVE_OFFIX_DND + case dnd_drop_event: +#endif if (!e->event.button.button) - error ("Undefined button for button-press or button-release event"); - if (NILP (EVENT_CHANNEL (e))) - error ("Undefined channel for button-press or button-release event"); + error ("Undefined button for %s event", + e->event_type == button_press_event + ? "buton-press" : +#ifdef HAVE_OFFIX_DND + e->event_type == button_release_event + ? "button-release" : "dnd-drop" +#else + "button-release" +#endif + ); +#ifdef HAVE_OFFIX_DND + if ((e->event_type == dnd_drop_event) && + NILP (e->event.dnd_drop.data)) + error ("Unspecified data for dnd-drop event"); break; +#endif default: break; } + + UNGCPRO; return event; } diff -r d8688acf4c5b -r 78f53ef88e17 src/events.h --- a/src/events.h Mon Aug 13 10:05:53 2007 +0200 +++ b/src/events.h Mon Aug 13 10:06:47 2007 +0200 @@ -377,12 +377,12 @@ #ifdef HAVE_X_WINDOWS XEvent underlying_x_event; #endif -#ifdef HAVE_W32GUI /* XXX FIXME */ +#ifdef HAVE_MS_WINDOWS struct { int message; unsigned long data[4]; /* XXX Big enough for biggest thing? */ - } underlying_w32_event; + } underlying_mswindows_event; #endif }; diff -r d8688acf4c5b -r 78f53ef88e17 src/faces.c --- a/src/faces.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/faces.c Mon Aug 13 10:06:47 2007 +0200 @@ -1916,10 +1916,10 @@ bg_inst_list = Fcons (Fcons (list1 (Qtty), Fvector (0, 0)), bg_inst_list); #endif -#ifdef HAVE_W32GUI - fg_inst_list = Fcons (Fcons (list1 (Qw32), build_string ("black")), +#ifdef HAVE_MS_WINDOWS + fg_inst_list = Fcons (Fcons (list1 (Qmswindows), build_string ("black")), fg_inst_list); - bg_inst_list = Fcons (Fcons (list1 (Qw32), build_string ("white")), + bg_inst_list = Fcons (Fcons (list1 (Qmswindows), build_string ("white")), bg_inst_list); #endif set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), @@ -1966,10 +1966,10 @@ inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")), inst_list); #endif /* HAVE_TTY */ -#ifdef HAVE_W32GUI - inst_list = Fcons (Fcons (list1 (Qw32), build_string ("Courier New")), +#ifdef HAVE_MS_WINDOWS + inst_list = Fcons (Fcons (list1 (Qmswindows), build_string ("Courier New")), inst_list); -#endif /* HAVE_W32GUI */ +#endif /* HAVE_MS_WINDOWS */ set_specifier_fallback (Fget (Vdefault_face, Qfont, Qnil), inst_list); } diff -r d8688acf4c5b -r 78f53ef88e17 src/fileio.c --- a/src/fileio.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/fileio.c Mon Aug 13 10:06:47 2007 +0200 @@ -562,6 +562,9 @@ out[size + 1] = DIRECTORY_SEP; out[size + 2] = '\0'; } +#ifdef DOS_NT + CORRECT_DIR_SEPS (out); +#endif return out; } @@ -768,7 +771,7 @@ /* Detect MSDOS file names with drive specifiers. */ && (IS_DRIVE (XSTRING_BYTE (default_, 0)) && (IS_DEVICE_SEP (XSTRING_BYTE (default_, 1)) - IS_DIRECTORY_SEP (XSTRING_BYTE (default_, 2))))) + && IS_DIRECTORY_SEP (XSTRING_BYTE (default_, 2))))) #ifdef WINDOWSNT /* Detect Windows file names in UNC format. */ && ! (XSTRING_LENGTH (default_) >= 2 @@ -2059,10 +2062,13 @@ INTP (ok_if_already_exists), 0); /* Syncing with FSF 19.34.6 note: FSF does not report a file error on NT here. --marcpa */ -#if 0 /* defined(WINDOWSNT) */ +/* But FSF #defines link as sys_link which is supplied in nt.c. We can't do + that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK. + Reverted to previous behaviour pending a working fix. (jhar) */ +#if defined(WINDOWSNT) /* Windows does not support this operation. */ report_file_error ("Adding new name", Flist (2, &filename)); -#else /* not 0 -- defined(WINDOWSNT) */ +#else /* not defined(WINDOWSNT) */ unlink ((char *) XSTRING_DATA (newname)); if (0 > link ((char *) XSTRING_DATA (filename), @@ -2071,7 +2077,7 @@ report_file_error ("Adding new name", list2 (filename, newname)); } -#endif /* 0 -- defined(WINDOWSNT) */ +#endif /* defined(WINDOWSNT) */ UNGCPRO; return Qnil; diff -r d8688acf4c5b -r 78f53ef88e17 src/frame-msw.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/frame-msw.c Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,283 @@ +/* Functions for the mswindows window system. + Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 1996 Ben Wing. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs 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 General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not synched with FSF. */ + +/* Authorship: + + Ultimately based on FSF. + Substantially rewritten for XEmacs by Ben Wing. + Rewritten for mswindows by Jonathan Harris, November 1997 for 20.4. + */ + +#include +#include "lisp.h" + +#include "console-msw.h" +#include "event-msw.h" + +#include "buffer.h" +#include "frame.h" +#include "events.h" + +/* Default properties to use when creating frames. */ +Lisp_Object Vdefault_mswindows_frame_plist; +/* Lisp_Object Qname, Qheight, Qwidth, Qinitially_unmapped, Qpopup, Qtop, Qleft; */ +Lisp_Object Qinitially_unmapped, Qpopup; + +static void +mswindows_init_frame_1 (struct frame *f, Lisp_Object props) +{ + mswindows_request_type request = { f, &props }; + Lisp_Object device = FRAME_DEVICE (f); + struct device *d = XDEVICE (device); + Lisp_Object lisp_window_id, initially_unmapped; + initially_unmapped = Fplist_get (props, Qinitially_unmapped, Qnil); + +#if 0 + if (NILP (DEVICE_SELECTED_FRAME (d)) && /* first frame on the device */ + NILP (initially_unmapped)) + f->visible = 1; +#endif + + f->frame_data = xnew_and_zero (struct mswindows_frame); + FRAME_MSWINDOWS_HANDLE(f) = (HWND)mswindows_make_request(WM_XEMACS_CREATEWINDOW, + 0, &request); + FRAME_MSWINDOWS_DC(f) = GetDC(FRAME_MSWINDOWS_HANDLE(f)); + SetTextAlign(FRAME_MSWINDOWS_DC(f), TA_BASELINE|TA_LEFT|TA_NOUPDATECP); + + /* XXX FIXME: This function should be made to do something */ + update_frame_face_values (f); +} + +/* Called just before frame's properties are set */ +static void +mswindows_init_frame_2 (struct frame *f, Lisp_Object props) +{ +} + +/* Called after frame's properties are set */ +static void +mswindows_init_frame_3 (struct frame *f) +{ + /* Don't do this earlier or we get a WM_PAINT before the frame is ready*/ + ShowWindow(FRAME_MSWINDOWS_HANDLE(f), SW_SHOWNORMAL); +} + +static void +mswindows_delete_frame (struct frame *f) +{ + if (f->frame_data) + { + ReleaseDC(FRAME_MSWINDOWS_HANDLE(f), FRAME_MSWINDOWS_DC(f)); + DestroyWindow(FRAME_MSWINDOWS_HANDLE(f)); + } +} + +static void +mswindows_set_frame_size (struct frame *f, int cols, int rows) +{ +} + + +static void +mswindows_set_frame_position (struct frame *f, int xoff, int yoff) +{ +} + +static void +mswindows_set_frame_properties (struct frame *f, Lisp_Object plist) +{ + int x, y; + int width = 0, height = 0; + BOOL width_specified_p = FALSE; + BOOL height_specified_p = FALSE; + BOOL x_specified_p = FALSE; + BOOL y_specified_p = FALSE; + Lisp_Object tail; + + /* Extract the properties from plist */ + for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail))) + { + Lisp_Object prop = Fcar (tail); + Lisp_Object val = Fcar (Fcdr (tail)); + + if (SYMBOLP (prop)) + { + /* Kludge to handle the font property. */ + if (EQ (prop, Qfont)) + { + /* If the value is not a string we silently ignore it. */ + if (STRINGP (val)) + { + Lisp_Object frm, font_spec; + + XSETFRAME (frm, f); + font_spec = Fget (Fget_face (Qdefault), Qfont, Qnil); + + Fadd_spec_to_specifier (font_spec, val, frm, Qnil, Qnil); + update_frame_face_values (f); + } + } + else if (EQ (prop, Qwidth)) + { + CHECK_INT (val); + width = XINT (val); + width_specified_p = TRUE; + } + else if (EQ (prop, Qheight)) + { + CHECK_INT (val); + height = XINT (val); + height_specified_p = TRUE; + } + else if (EQ (prop, Qleft)) + { + CHECK_INT (val); + x = XINT (val); + x_specified_p = TRUE; + } + else if (EQ (prop, Qtop)) + { + CHECK_INT (val); + y = XINT (val); + y_specified_p = TRUE; + } + } + } + + /* Now we've extracted the properties, apply them */ + if (width_specified_p || height_specified_p || x_specified_p || y_specified_p) + { + Lisp_Object frame; + RECT rect; + int pixel_width, pixel_height; + XSETFRAME (frame, f); + + if (!width_specified_p) + width = FRAME_WIDTH (f); + if (!height_specified_p) + height = FRAME_HEIGHT (f); + char_to_pixel_size (f, width, height, &pixel_width, &pixel_height); + + GetWindowRect (FRAME_MSWINDOWS_HANDLE(f), &rect); + if (!x_specified_p) + x = rect.left; + if (!y_specified_p) + y = rect.top; + /* XXX FIXME: Should do AdjustWindowRect here like in mswindows_handle_request */ + MoveWindow (FRAME_MSWINDOWS_HANDLE(f), x, y, pixel_width, pixel_height, + (width_specified_p || height_specified_p)); + } +} + + +void +console_type_create_frame_mswindows (void) +{ + /* frame methods */ + CONSOLE_HAS_METHOD (mswindows, init_frame_1); + CONSOLE_HAS_METHOD (mswindows, init_frame_2); + CONSOLE_HAS_METHOD (mswindows, init_frame_3); +/* CONSOLE_HAS_METHOD (mswindows, mark_frame); */ +/* CONSOLE_HAS_METHOD (mswindows, focus_on_frame); */ + CONSOLE_HAS_METHOD (mswindows, delete_frame); +/* CONSOLE_HAS_METHOD (mswindows, get_mouse_position); */ +/* CONSOLE_HAS_METHOD (mswindows, set_mouse_position); */ +/* CONSOLE_HAS_METHOD (mswindows, raise_frame); */ +/* CONSOLE_HAS_METHOD (mswindows, lower_frame); */ +/* CONSOLE_HAS_METHOD (mswindows, make_frame_visible); */ +/* CONSOLE_HAS_METHOD (mswindows, make_frame_invisible); */ +/* CONSOLE_HAS_METHOD (mswindows, iconify_frame); */ + CONSOLE_HAS_METHOD (mswindows, set_frame_size); + CONSOLE_HAS_METHOD (mswindows, set_frame_position); +/* CONSOLE_HAS_METHOD (mswindows, frame_property); */ +/* CONSOLE_HAS_METHOD (mswindows, internal_frame_property_p); */ +/* CONSOLE_HAS_METHOD (mswindows, frame_properties); */ + CONSOLE_HAS_METHOD (mswindows, set_frame_properties); +/* CONSOLE_HAS_METHOD (mswindows, set_title_from_bufbyte); */ +/* CONSOLE_HAS_METHOD (mswindows, set_icon_name_from_bufbyte); */ +/* CONSOLE_HAS_METHOD (mswindows, frame_visible_p); */ +/* CONSOLE_HAS_METHOD (mswindows, frame_totally_visible_p); */ +/* CONSOLE_HAS_METHOD (mswindows, frame_iconified_p); */ +/* CONSOLE_HAS_METHOD (mswindows, set_frame_pointer); */ +/* CONSOLE_HAS_METHOD (mswindows, set_frame_icon); */ +/* CONSOLE_HAS_METHOD (mswindows, get_frame_parent); */ +} + +void +syms_of_frame_mswindows (void) +{ +#if 0 /* XXX these are in general.c */ + defsymbol (&Qname, "name"); + defsymbol (&Qheight, "height"); + defsymbol (&Qwidth, "width"); + defsymbol (&Qtop, "top"); + defsymbol (&Qleft, "left"); +#endif + defsymbol (&Qinitially_unmapped, "initially-unmapped"); + defsymbol (&Qpopup, "popup"); +} + +void +vars_of_frame_mswindows (void) +{ + DEFVAR_LISP ("default-mswindows-frame-plist", &Vdefault_mswindows_frame_plist /* +Plist of default frame-creation properties for mswindows frames. +These override what is specified in `default-frame-plist', but are +overridden by the arguments to the particular call to `make-frame'. + +Note: In many cases, properties of a frame are available as specifiers +instead of through the frame-properties mechanism. + +Here is a list of recognized frame properties, other than those +documented in `set-frame-properties' (they can be queried and +set at any time, except as otherwise noted): + + initially-unmapped If non-nil, the frame will not be visible + when it is created. In this case, you + need to call `make-frame-visible' to make + the frame appear. + popup If non-nil, it should be a frame, and this + frame will be created as a "popup" frame + whose parent is the given frame. This + will make the window manager treat the + frame as a dialog box, which may entail + doing different things (e.g. not asking + for positioning, and not iconifying + separate from its parent). + top Y position (in pixels) of the upper-left + outermost corner of the frame (i.e. the + upper-left of the window-manager + decorations). + left X position (in pixels) of the upper-left + outermost corner of the frame (i.e. the + upper-left of the window-manager + decorations). + +See also `default-frame-plist', which specifies properties which apply +to all frames, not just mswindows frames. +*/ ); + Vdefault_mswindows_frame_plist = Qnil; + + mswindows_console_methods->device_specific_frame_props = + &Vdefault_mswindows_frame_plist; +} diff -r d8688acf4c5b -r 78f53ef88e17 src/frame-w32.c --- a/src/frame-w32.c Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,283 +0,0 @@ -/* Functions for the win32 window system. - Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not synched with FSF. */ - -/* Authorship: - - Ultimately based on FSF. - Substantially rewritten for XEmacs by Ben Wing. - Rewritten for win32 by Jonathan Harris, November 1997 for 20.4. - */ - -#include -#include "lisp.h" - -#include "console-w32.h" -#include "event-w32.h" - -#include "buffer.h" -#include "frame.h" -#include "events.h" - -/* Default properties to use when creating frames. */ -Lisp_Object Vdefault_w32_frame_plist; -/* Lisp_Object Qname, Qheight, Qwidth, Qinitially_unmapped, Qpopup, Qtop, Qleft; */ -Lisp_Object Qinitially_unmapped, Qpopup; - -static void -w32_init_frame_1 (struct frame *f, Lisp_Object props) -{ - w32_request_type request = { f, &props }; - Lisp_Object device = FRAME_DEVICE (f); - struct device *d = XDEVICE (device); - Lisp_Object lisp_window_id, initially_unmapped; - initially_unmapped = Fplist_get (props, Qinitially_unmapped, Qnil); - -#if 0 - if (NILP (DEVICE_SELECTED_FRAME (d)) && /* first frame on the device */ - NILP (initially_unmapped)) - f->visible = 1; -#endif - - f->frame_data = xnew_and_zero (struct w32_frame); - FRAME_W32_HANDLE(f) = (HWND)w32_make_request(WM_XEMACS_CREATEWINDOW, - 0, &request); - FRAME_W32_DC(f) = GetDC(FRAME_W32_HANDLE(f)); - SetTextAlign(FRAME_W32_DC(f), TA_BASELINE|TA_LEFT|TA_NOUPDATECP); - - /* XXX FIXME: This function should be made to do something */ - update_frame_face_values (f); -} - -/* Called just before frame's properties are set */ -static void -w32_init_frame_2 (struct frame *f, Lisp_Object props) -{ -} - -/* Called after frame's properties are set */ -static void -w32_init_frame_3 (struct frame *f) -{ - /* Don't do this earlier or we get a WM_PAINT before the frame is ready*/ - ShowWindow(FRAME_W32_HANDLE(f), SW_SHOWNORMAL); -} - -static void -w32_delete_frame (struct frame *f) -{ - if (f->frame_data) - { - ReleaseDC(FRAME_W32_HANDLE(f), FRAME_W32_DC(f)); - DestroyWindow(FRAME_W32_HANDLE(f)); - } -} - -static void -w32_set_frame_size (struct frame *f, int cols, int rows) -{ -} - - -static void -w32_set_frame_position (struct frame *f, int xoff, int yoff) -{ -} - -static void -w32_set_frame_properties (struct frame *f, Lisp_Object plist) -{ - int x, y; - int width = 0, height = 0; - BOOL width_specified_p = FALSE; - BOOL height_specified_p = FALSE; - BOOL x_specified_p = FALSE; - BOOL y_specified_p = FALSE; - Lisp_Object tail; - - /* Extract the properties from plist */ - for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail))) - { - Lisp_Object prop = Fcar (tail); - Lisp_Object val = Fcar (Fcdr (tail)); - - if (SYMBOLP (prop)) - { - /* Kludge to handle the font property. */ - if (EQ (prop, Qfont)) - { - /* If the value is not a string we silently ignore it. */ - if (STRINGP (val)) - { - Lisp_Object frm, font_spec; - - XSETFRAME (frm, f); - font_spec = Fget (Fget_face (Qdefault), Qfont, Qnil); - - Fadd_spec_to_specifier (font_spec, val, frm, Qnil, Qnil); - update_frame_face_values (f); - } - } - else if (EQ (prop, Qwidth)) - { - CHECK_INT (val); - width = XINT (val); - width_specified_p = TRUE; - } - else if (EQ (prop, Qheight)) - { - CHECK_INT (val); - height = XINT (val); - height_specified_p = TRUE; - } - else if (EQ (prop, Qleft)) - { - CHECK_INT (val); - x = XINT (val); - x_specified_p = TRUE; - } - else if (EQ (prop, Qtop)) - { - CHECK_INT (val); - y = XINT (val); - y_specified_p = TRUE; - } - } - } - - /* Now we've extracted the properties, apply them */ - if (width_specified_p || height_specified_p || x_specified_p || y_specified_p) - { - Lisp_Object frame; - RECT rect; - int pixel_width, pixel_height; - XSETFRAME (frame, f); - - if (!width_specified_p) - width = FRAME_WIDTH (f); - if (!height_specified_p) - height = FRAME_HEIGHT (f); - char_to_pixel_size (f, width, height, &pixel_width, &pixel_height); - - GetWindowRect (FRAME_W32_HANDLE(f), &rect); - if (!x_specified_p) - x = rect.left; - if (!y_specified_p) - y = rect.top; - /* XXX FIXME: Should do AdjustWindowRect here like in w32_handle_request */ - MoveWindow (FRAME_W32_HANDLE(f), x, y, pixel_width, pixel_height, - (width_specified_p || height_specified_p)); - } -} - - -void -console_type_create_frame_w32 (void) -{ - /* frame methods */ - CONSOLE_HAS_METHOD (w32, init_frame_1); - CONSOLE_HAS_METHOD (w32, init_frame_2); - CONSOLE_HAS_METHOD (w32, init_frame_3); -/* CONSOLE_HAS_METHOD (w32, mark_frame); */ -/* CONSOLE_HAS_METHOD (w32, focus_on_frame); */ - CONSOLE_HAS_METHOD (w32, delete_frame); -/* CONSOLE_HAS_METHOD (w32, get_mouse_position); */ -/* CONSOLE_HAS_METHOD (w32, set_mouse_position); */ -/* CONSOLE_HAS_METHOD (w32, raise_frame); */ -/* CONSOLE_HAS_METHOD (w32, lower_frame); */ -/* CONSOLE_HAS_METHOD (w32, make_frame_visible); */ -/* CONSOLE_HAS_METHOD (w32, make_frame_invisible); */ -/* CONSOLE_HAS_METHOD (w32, iconify_frame); */ - CONSOLE_HAS_METHOD (w32, set_frame_size); - CONSOLE_HAS_METHOD (w32, set_frame_position); -/* CONSOLE_HAS_METHOD (w32, frame_property); */ -/* CONSOLE_HAS_METHOD (w32, internal_frame_property_p); */ -/* CONSOLE_HAS_METHOD (w32, frame_properties); */ - CONSOLE_HAS_METHOD (w32, set_frame_properties); -/* CONSOLE_HAS_METHOD (w32, set_title_from_bufbyte); */ -/* CONSOLE_HAS_METHOD (w32, set_icon_name_from_bufbyte); */ -/* CONSOLE_HAS_METHOD (w32, frame_visible_p); */ -/* CONSOLE_HAS_METHOD (w32, frame_totally_visible_p); */ -/* CONSOLE_HAS_METHOD (w32, frame_iconified_p); */ -/* CONSOLE_HAS_METHOD (w32, set_frame_pointer); */ -/* CONSOLE_HAS_METHOD (w32, set_frame_icon); */ -/* CONSOLE_HAS_METHOD (w32, get_frame_parent); */ -} - -void -syms_of_frame_w32 (void) -{ -#if 0 /* XXX these are in general.c */ - defsymbol (&Qname, "name"); - defsymbol (&Qheight, "height"); - defsymbol (&Qwidth, "width"); - defsymbol (&Qtop, "top"); - defsymbol (&Qleft, "left"); -#endif - defsymbol (&Qinitially_unmapped, "initially-unmapped"); - defsymbol (&Qpopup, "popup"); -} - -void -vars_of_frame_w32 (void) -{ - DEFVAR_LISP ("default-w32-frame-plist", &Vdefault_w32_frame_plist /* -Plist of default frame-creation properties for w32 frames. -These override what is specified in `default-frame-plist', but are -overridden by the arguments to the particular call to `make-frame'. - -Note: In many cases, properties of a frame are available as specifiers -instead of through the frame-properties mechanism. - -Here is a list of recognized frame properties, other than those -documented in `set-frame-properties' (they can be queried and -set at any time, except as otherwise noted): - - initially-unmapped If non-nil, the frame will not be visible - when it is created. In this case, you - need to call `make-frame-visible' to make - the frame appear. - popup If non-nil, it should be a frame, and this - frame will be created as a "popup" frame - whose parent is the given frame. This - will make the window manager treat the - frame as a dialog box, which may entail - doing different things (e.g. not asking - for positioning, and not iconifying - separate from its parent). - top Y position (in pixels) of the upper-left - outermost corner of the frame (i.e. the - upper-left of the window-manager - decorations). - left X position (in pixels) of the upper-left - outermost corner of the frame (i.e. the - upper-left of the window-manager - decorations). - -See also `default-frame-plist', which specifies properties which apply -to all frames, not just w32 frames. -*/ ); - Vdefault_w32_frame_plist = Qnil; - - w32_console_methods->device_specific_frame_props = - &Vdefault_w32_frame_plist; -} diff -r d8688acf4c5b -r 78f53ef88e17 src/frame.c --- a/src/frame.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/frame.c Mon Aug 13 10:06:47 2007 +0200 @@ -2200,7 +2200,7 @@ frame property name to another. See the variables `default-x-frame-plist', `default-tty-frame-plist' -and `default-w32-frame-plist' for a description of the properties +and `default-mswindows-frame-plist' for a description of the properties recognized for particular types of frames. */ (frame, plist)) diff -r d8688acf4c5b -r 78f53ef88e17 src/general.c --- a/src/general.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/general.c Mon Aug 13 10:06:47 2007 +0200 @@ -155,7 +155,7 @@ Lisp_Object Qvalue_assoc; Lisp_Object Qvector; Lisp_Object Qwarning; -Lisp_Object Qw32; +Lisp_Object Qmswindows; Lisp_Object Qwhite; Lisp_Object Qwidth; Lisp_Object Qwindow; @@ -292,7 +292,7 @@ defsymbol (&Qwarning, "warning"); defsymbol (&Qwhite, "white"); defsymbol (&Qwidth, "width"); - defsymbol (&Qw32, "w32"); + defsymbol (&Qmswindows, "mswindows"); defsymbol (&Qwindow, "window"); defsymbol (&Qwindow_system, "window-system"); defsymbol (&Qx, "x"); diff -r d8688acf4c5b -r 78f53ef88e17 src/lisp-disunion.h --- a/src/lisp-disunion.h Mon Aug 13 10:05:53 2007 +0200 +++ b/src/lisp-disunion.h Mon Aug 13 10:06:47 2007 +0200 @@ -102,6 +102,8 @@ # define XMARK(a) ((void) ((a) |= (MARKBIT))) # define XUNMARK(a) ((void) ((a) &= (~(MARKBIT)))) +#else +# define XUNMARK(a) DO_NOTHING #endif /* diff -r d8688acf4c5b -r 78f53ef88e17 src/lisp-union.h --- a/src/lisp-union.h Mon Aug 13 10:05:53 2007 +0200 +++ b/src/lisp-union.h Mon Aug 13 10:06:47 2007 +0200 @@ -201,6 +201,8 @@ # define XMARKBIT(a) ((a).gu.markbit) # define XMARK(a) ((void) (XMARKBIT (a) = 1)) # define XUNMARK(a) ((void) (XMARKBIT (a) = 0)) +#else +# define XUNMARK(a) DO_NOTHING #endif /* Use this for turning a (void *) into a Lisp_Object, as when the diff -r d8688acf4c5b -r 78f53ef88e17 src/lrecord.h --- a/src/lrecord.h Mon Aug 13 10:05:53 2007 +0200 +++ b/src/lrecord.h Mon Aug 13 10:06:47 2007 +0200 @@ -102,7 +102,7 @@ #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION # define set_lheader_implementation(header,imp) \ - do { (header)->type = lrecord_type_index((imp)) \ + do { (header)->type = lrecord_type_index((imp)); \ (header)->mark = 0; \ (header)->pure = 0; \ } while (0) diff -r d8688acf4c5b -r 78f53ef88e17 src/msw-proc.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/msw-proc.c Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,602 @@ +/* mswindows specific event-handling. + Copyright (C) 1997 Jonathan Harris. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs 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 General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Jonathan Harris, November 1997 for 20.4. + */ + +/* + * Comment: + * + * Windows user-input type events are stored in a per-thread message queue + * and retrieved using GetMessage(). It is not possible to wait on this + * queue and on other events (eg process input) simultaneously. Also, the + * main event-handling code in windows (the "windows procedure") is called + * asynchronously when windows has certain other types of events ("nonqueued + * messages") to deliver. The documentation doesn't appear to specify the + * context in which the windows procedure is called, but I assume that the + * thread that created the window is temporarily highjacked for this purpose. + * + * We spawn off a single thread to deal with both kinds of messages. The + * thread turns the windows events into emacs_events and stuffs them in a + * queue which XEmacs reads at its leisure. This file contains the code for + * the thread. This scheme also helps to prevent weird synchronisation and + * deadlock problems that might occur if the windows procedure was called + * when XEmacs was already in the middle of processing an event. + * + * Unfortunately, only the thread that created a window can retrieve messages + * destined for that window ("GetMessage does not retrieve messages for + * windows that belong to other threads..."). This means that our message- + * processing thread also has to do all window creation. We handle this + * bogosity by getting the main XEmacs thread to send special user-defined + * messages to the message-processing thread to instruct it to create windows. + */ + + +#include +#include "lisp.h" + +#include "console-msw.h" +#include "device.h" +#include "frame.h" +#include "events.h" +#include "event-msw.h" + +#define MSWINDOWS_FRAME_STYLE WS_CLIPCHILDREN|WS_CLIPSIBLINGS|WS_TILEDWINDOW +#define MSWINDOWS_POPUP_STYLE WS_CLIPCHILDREN|WS_CLIPSIBLINGS|WS_CAPTION|WS_POPUP + +static LRESULT WINAPI mswindows_wnd_proc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam); +static Lisp_Object mswindows_find_console (HWND hwnd); +static Lisp_Object mswindows_find_frame (HWND hwnd); +static Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key); + +/* + * Entry point for the "windows" message-processing thread + */ +DWORD mswindows_win_thread() +{ + WNDCLASS wc; + MSG msg; + mswindows_waitable_info_type info; + + /* Register the main window class */ + wc.style = CS_OWNDC; /* One DC per window */ + wc.lpfnWndProc = (WNDPROC) mswindows_wnd_proc; + wc.cbClsExtra = 0; + wc.cbWndExtra = 0; /* ? */ + wc.hInstance = NULL; /* ? */ + wc.hIcon = LoadIcon (NULL, XEMACS_CLASS); + wc.hCursor = LoadCursor (NULL, IDC_ARROW); + wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */ + wc.lpszMenuName = NULL; /* XXX FIXME? Add a menu? */ + wc.lpszClassName = XEMACS_CLASS; + RegisterClass(&wc); /* XXX FIXME: Should use RegisterClassEx */ + + info.type = mswindows_waitable_type_dispatch; + mswindows_add_waitable(&info); + + /* Ensure our message queue is created XXX FIXME: Is this necessary? */ + PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE); + + /* Notify the main thread that we're ready */ + assert(PostThreadMessage (mswindows_main_thread_id, WM_XEMACS_ACK, 0, 0)); + + /* Main windows loop */ + while (1) + { + GetMessage (&msg, NULL, 0, 0); + + /* + * Process things that don't have an associated window, so wouldn't + * get sent to mswindows_wnd_proc + */ + + /* Request from main thread */ + if (msg.message>=WM_XEMACS_BASE && msg.message<=WM_XEMACS_END) + mswindows_handle_request(&msg); + + /* Timeout */ + else if (msg.message == WM_TIMER) + { + Lisp_Object emacs_event; + struct Lisp_Event *event; + + KillTimer(NULL, msg.wParam); + EnterCriticalSection (&mswindows_dispatch_crit); + emacs_event = Fmake_event (Qnil, Qnil); + event = XEVENT(emacs_event); + + event->channel = Qnil; + event->timestamp = msg.time; + event->event_type = timeout_event; + event->event.timeout.interval_id = msg.wParam; + mswindows_enqueue_dispatch_event (emacs_event); + LeaveCriticalSection (&mswindows_dispatch_crit); + } + else + /* Pass on to mswindows_wnd_proc */ + DispatchMessage (&msg); + } +} + +/* + * The windows procedure for the window class XEMACS_CLASS + * Stuffs messages in the mswindows event queue + */ +static LRESULT WINAPI mswindows_wnd_proc(HWND hwnd, UINT message, WPARAM wParam, + LPARAM lParam) +{ + /* Note: Remember to initialise these before use */ + Lisp_Object emacs_event; + struct Lisp_Event *event; + + static int mods = 0; + MSG msg = { hwnd, message, wParam, lParam, 0, {0,0} }; + msg.time = GetMessageTime(); + +#if 0 /* XXX */ + stderr_out("Message %04x, wParam=%04x, lParam=%08lx\n", message, wParam, lParam); +#endif + switch (message) + { + case WM_KEYDOWN: + case WM_SYSKEYDOWN: + switch(wParam) + { + case VK_SHIFT: + mods |= MOD_SHIFT; + break; + case VK_CONTROL: + mods |= MOD_CONTROL; + break; + case VK_MENU: + mods |= MOD_META; + break; + default: + /* Handle those keys that TranslateMessage won't generate a WM_CHAR for */ + { + Lisp_Object keysym; + if (!NILP (keysym = mswindows_key_to_emacs_keysym(wParam))) + { + EnterCriticalSection (&mswindows_dispatch_crit); + emacs_event = Fmake_event (Qnil, Qnil); + event = XEVENT(emacs_event); + + event->channel = mswindows_find_console(hwnd); + event->timestamp = msg.time; + event->event_type = key_press_event; + event->event.key.keysym = keysym; + event->event.key.modifiers = mods; + mswindows_enqueue_dispatch_event (emacs_event); + LeaveCriticalSection (&mswindows_dispatch_crit); + return (0); + } + } + } + TranslateMessage (&msg); /* Maybe generates WM_[SYS]CHAR in message queue */ + goto defproc; + + case WM_KEYUP: + case WM_SYSKEYUP: + switch(wParam) + { + case VK_SHIFT: + mods &= ~MOD_SHIFT; + break; + case VK_CONTROL: + mods &= ~MOD_CONTROL; + break; + case VK_MENU: + mods &= ~MOD_META; + break; + } + TranslateMessage (&msg); + goto defproc; + + case WM_CHAR: + case WM_SYSCHAR: + { + EnterCriticalSection (&mswindows_dispatch_crit); + emacs_event = Fmake_event (Qnil, Qnil); + event = XEVENT(emacs_event); + + event->channel = mswindows_find_console(hwnd); + event->timestamp = msg.time; + event->event_type = key_press_event; + event->event.key.modifiers = mods; + event->event.key.modifiers = lParam & 0x20000000 ? MOD_META : 0; /* redundant? */ + if (wParam<' ') /* Control char not handled under WM_KEYDOWN */ + { + event->event.key.keysym = make_char(wParam+'a'-1); + event->event.key.modifiers |= MOD_CONTROL; /* redundant? */ + } + else + { + /* Assumes that emacs keysym == ASCII code */ + event->event.key.keysym = make_char(wParam); + } + mswindows_enqueue_dispatch_event (emacs_event); + LeaveCriticalSection (&mswindows_dispatch_crit); + } + break; + + case WM_LBUTTONDOWN: + case WM_MBUTTONDOWN: + case WM_RBUTTONDOWN: + case WM_LBUTTONUP: + case WM_MBUTTONUP: + case WM_RBUTTONUP: + { + /* XXX FIXME: Do middle button emulation */ + EnterCriticalSection (&mswindows_dispatch_crit); + emacs_event = Fmake_event (Qnil, Qnil); + event = XEVENT(emacs_event); + + event->channel = mswindows_find_frame(hwnd); + event->timestamp = msg.time; + event->event_type = + (message==WM_LBUTTONDOWN || message==WM_MBUTTONDOWN || + message==WM_RBUTTONDOWN) ? + button_press_event : button_release_event; +#if 0 + ((wParam & MK_CONTROL) ? MOD_CONTROL : 0) | + ((wParam & MK_SHIFT) ? MOD_SHIFT : 0); +#endif + event->event.button.button = + (message==WM_LBUTTONDOWN || message==WM_LBUTTONUP) ? 1 : + ((message==WM_RBUTTONDOWN || message==WM_RBUTTONUP) ? 3 : 2); + event->event.button.x = LOWORD(lParam); + event->event.button.y = HIWORD(lParam); + event->event.button.modifiers = mods; + + mswindows_enqueue_dispatch_event (emacs_event); + LeaveCriticalSection (&mswindows_dispatch_crit); + } + break; + + case WM_MOUSEMOVE: + { + EnterCriticalSection (&mswindows_dispatch_crit); + emacs_event = Fmake_event (Qnil, Qnil); + event = XEVENT(emacs_event); + + event->channel = mswindows_find_frame(hwnd); + event->timestamp = msg.time; + event->event_type = pointer_motion_event; + event->event.motion.x = LOWORD(lParam); + event->event.motion.y = HIWORD(lParam); + event->event.motion.modifiers = mods; + + mswindows_enqueue_dispatch_event (emacs_event); + LeaveCriticalSection (&mswindows_dispatch_crit); + } + break; + + case WM_PAINT: + if (GetUpdateRect(hwnd, NULL, FALSE)) + { + PAINTSTRUCT paintStruct; + + EnterCriticalSection (&mswindows_dispatch_crit); + emacs_event = Fmake_event (Qnil, Qnil); + event = XEVENT(emacs_event); + + event->channel = mswindows_find_frame(hwnd); + event->timestamp = msg.time; + event->event_type = magic_event; + BeginPaint (hwnd, &paintStruct); + EVENT_MSWINDOWS_MAGIC_TYPE(event) = message; + EVENT_MSWINDOWS_MAGIC_DATA(event) = paintStruct.rcPaint; + EndPaint (hwnd, &paintStruct); + + mswindows_enqueue_dispatch_event (emacs_event); + LeaveCriticalSection (&mswindows_dispatch_crit); + } + break; + + case WM_SIZE: + /* We only care about this message if our size has really changed */ + if (wParam==SIZE_RESTORED || wParam==SIZE_MAXIMIZED || wParam==SIZE_MINIMIZED) + { + RECT rect; + EnterCriticalSection (&mswindows_dispatch_crit); + emacs_event = Fmake_event (Qnil, Qnil); + event = XEVENT(emacs_event); + + event->channel = mswindows_find_frame(hwnd); + event->timestamp = msg.time; + event->event_type = magic_event; + if (wParam==SIZE_MINIMIZED) + rect.left = rect.top = rect.right = rect.bottom = -1; + else + GetClientRect(hwnd, &rect); + EVENT_MSWINDOWS_MAGIC_TYPE(event) = message; + EVENT_MSWINDOWS_MAGIC_DATA(event) = rect; + + mswindows_enqueue_dispatch_event (emacs_event); + LeaveCriticalSection (&mswindows_dispatch_crit); + } + break; + + case WM_SETFOCUS: + case WM_KILLFOCUS: + { + EnterCriticalSection (&mswindows_dispatch_crit); + emacs_event = Fmake_event (Qnil, Qnil); + event = XEVENT(emacs_event); + + event->channel = mswindows_find_frame(hwnd); + event->timestamp = msg.time; + event->event_type = magic_event; + EVENT_MSWINDOWS_MAGIC_TYPE(event) = message; + + mswindows_enqueue_dispatch_event (emacs_event); + LeaveCriticalSection (&mswindows_dispatch_crit); + } + break; + + case WM_QUIT: + /* XXX FIXME: Should do something here! */ + defproc: + default: + return DefWindowProc (hwnd, message, wParam, lParam); + } + return (0); +} + + +/* + * Make a request to the message-processing thread to do things that + * can't be done in the main thread. + */ +LPARAM +mswindows_make_request(UINT message, WPARAM wParam, mswindows_request_type *request) +{ + MSG msg; + assert(PostThreadMessage (mswindows_win_thread_id, message, wParam, + (LPARAM) request)); + GetMessage (&msg, NULL, WM_XEMACS_ACK, WM_XEMACS_ACK); + return (msg.lParam); +} + + +/* + * Handle a request from the main thread to do things that have to be + * done in the message-processing thread. + */ +static void +mswindows_handle_request (MSG *msg) +{ + mswindows_request_type *request = (mswindows_request_type *) msg->lParam; + + switch (msg->message) + { + case WM_XEMACS_CREATEWINDOW: + { + struct frame *f = request->thing1; + Lisp_Object *props = request->thing2; + Lisp_Object name, height, width, popup, top, left; + RECT rect; + DWORD style; + HWND hwnd; + + name = Fplist_get (*props, Qname, Qnil); + height = Fplist_get (*props, Qheight, Qnil); + width = Fplist_get (*props, Qwidth, Qnil); + popup = Fplist_get (*props, Qpopup, Qnil); + top = Fplist_get (*props, Qtop, Qnil); + left = Fplist_get (*props, Qleft, Qnil); + + style = (NILP(popup)) ? MSWINDOWS_FRAME_STYLE : MSWINDOWS_POPUP_STYLE; + + rect.left = rect.top = 0; + rect.right = INTP(width) ? XINT(width) : 640; + rect.bottom = INTP(height) ? XINT(height) : 480; +#ifdef HAVE_MENUBARS + AdjustWindowRect(&rect, style, TRUE); +#else + AdjustWindowRect(&rect, style, FALSE); +#endif + + hwnd = CreateWindow (XEMACS_CLASS, + STRINGP(f->name) ? XSTRING_DATA(f->name) : + (STRINGP(name) ? XSTRING_DATA(name) : XEMACS_CLASS), + style, + INTP(left) ? XINT(left) : CW_USEDEFAULT, + INTP(top) ? XINT(top) : CW_USEDEFAULT, + rect.right-rect.left, rect.bottom-rect.top, + NULL, NULL, NULL, NULL); + assert(PostThreadMessage (mswindows_main_thread_id, WM_XEMACS_ACK, 0, (LPARAM) hwnd)); + } + return; + + case WM_XEMACS_SETTIMER: + { + UINT id; + id=SetTimer (NULL, 0, (UINT) request->thing1, NULL); + assert(PostThreadMessage (mswindows_main_thread_id, WM_XEMACS_ACK, 0, id)); + } + break; + + case WM_XEMACS_KILLTIMER: + { + KillTimer (NULL, (UINT) request->thing1); + assert(PostThreadMessage (mswindows_main_thread_id, WM_XEMACS_ACK, 0, 0)); + } + break; + + default: + assert(0); + } +} + + +/* + * Translate a mswindows virtual key to a keysym. + * Only returns non-Qnil for keys that don't generate WM_CHAR messages + * or whose ASCII codes (like space) xemacs doesn't like. + * Virtual key values are defined in winresrc.h + * XXX I'm not sure that KEYSYM("name") is the best thing to use here. + */ +Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key) +{ + switch (mswindows_key) + { + /* First the predefined ones */ + case VK_BACK: return QKbackspace; + case VK_TAB: return QKtab; + case '\n': return QKlinefeed; /* No VK_LINEFEED in winresrc.h */ + case VK_RETURN: return QKreturn; + case VK_ESCAPE: return QKescape; + case VK_SPACE: return QKspace; + case VK_DELETE: return QKdelete; + + /* The rest */ + case VK_PRIOR: return KEYSYM ("prior"); + case VK_NEXT: return KEYSYM ("next"); + case VK_END: return KEYSYM ("end"); + case VK_HOME: return KEYSYM ("home"); + case VK_LEFT: return KEYSYM ("left"); + case VK_UP: return KEYSYM ("up"); + case VK_RIGHT: return KEYSYM ("right"); + case VK_DOWN: return KEYSYM ("down"); + case VK_INSERT: return KEYSYM ("insert"); + case VK_HELP: return KEYSYM ("help"); + case VK_F1: return KEYSYM ("F1"); + case VK_F2: return KEYSYM ("F2"); + case VK_F3: return KEYSYM ("F3"); + case VK_F4: return KEYSYM ("F4"); + case VK_F5: return KEYSYM ("F5"); + case VK_F6: return KEYSYM ("F6"); + case VK_F7: return KEYSYM ("F7"); + case VK_F8: return KEYSYM ("F8"); + case VK_F9: return KEYSYM ("F9"); + case VK_F10: return KEYSYM ("F10"); + case VK_F11: return KEYSYM ("F11"); + case VK_F12: return KEYSYM ("F12"); + case VK_F13: return KEYSYM ("F13"); + case VK_F14: return KEYSYM ("F14"); + case VK_F15: return KEYSYM ("F15"); + case VK_F16: return KEYSYM ("F16"); + case VK_F17: return KEYSYM ("F17"); + case VK_F18: return KEYSYM ("F18"); + case VK_F19: return KEYSYM ("F19"); + case VK_F20: return KEYSYM ("F20"); + case VK_F21: return KEYSYM ("F21"); + case VK_F22: return KEYSYM ("F22"); + case VK_F23: return KEYSYM ("F23"); + case VK_F24: return KEYSYM ("F24"); + } + return Qnil; +} + + +/* + * Find the console that matches the supplied mswindows window handle + */ +static Lisp_Object +mswindows_find_console (HWND hwnd) +{ + Lisp_Object concons; + + CONSOLE_LOOP (concons) + { + Lisp_Object console = XCAR (concons); + /* We only support one console so this must be it */ + return console; + } + + return Qnil; +} + +/* + * Find the frame that matches the supplied mswindows window handle + */ +static Lisp_Object +mswindows_find_frame (HWND hwnd) +{ + Lisp_Object frmcons, devcons, concons; + + FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) + { + struct frame *f; + Lisp_Object frame = XCAR (frmcons); + f = XFRAME (frame); + if (FRAME_TYPE_P(f, mswindows)) /* Might be a stream-type frame */ + if (FRAME_MSWINDOWS_HANDLE(f)==hwnd) + return frame; + } + assert(0); /* XXX Can't happen! we only get messages for our windows */ + return Qnil; +} + +/* + * Random helper functions for debugging. + * Intended for use in the MSVC "Watch" window which doesn't like + * the aborts that the error_check_foo() functions can make. + */ +struct lrecord_header *DHEADER(Lisp_Object obj) +{ + return LRECORDP(obj) ? XRECORD_LHEADER(obj) : NULL; + /* (lrecord_header*)(obj & 0xfffffff) */ +} + +struct Lisp_Event *DEVENT(Lisp_Object obj) +{ + return (EVENTP (obj)) ? XEVENT(obj) : NULL; +} + +struct Lisp_Cons *DCONS(Lisp_Object obj) +{ + return (CONSP (obj)) ? XCONS(obj) : NULL; +} + +Lisp_Object DCAR(Lisp_Object obj) +{ + return (CONSP (obj)) ? XCAR(obj) : 0; +} + +Lisp_Object DCDR(Lisp_Object obj) +{ + return (CONSP (obj)) ? XCDR(obj) : 0; +} + +char *DSTRING(Lisp_Object obj) +{ + return (STRINGP (obj)) ? XSTRING_DATA(obj) : NULL; +} + +struct Lisp_Vector *DVECTOR(Lisp_Object obj) +{ + return (VECTORP (obj)) ? XVECTOR(obj) : NULL; +} + +struct Lisp_Symbol *DSYMBOL(Lisp_Object obj) +{ + return (SYMBOLP (obj)) ? XSYMBOL(obj) : NULL; +} + +char *DSYMNAME(Lisp_Object obj) +{ + return (SYMBOLP (obj)) ? XSYMBOL(obj)->name->_data : NULL; +} diff -r d8688acf4c5b -r 78f53ef88e17 src/mule-canna.c --- a/src/mule-canna.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/mule-canna.c Mon Aug 13 10:06:47 2007 +0200 @@ -194,7 +194,7 @@ #ifdef CANNA_MULE static void m2c (unsigned char *, int, unsigned char *); static Lisp_Object mule_make_string (unsigned char *, int); -static mule_strlen (unsigned char *, int); +static int mule_strlen (unsigned char *, int); static void count_char (unsigned char *,int, int, int, int *, int *, int *); #define make_string mule_make_string #endif diff -r d8688acf4c5b -r 78f53ef88e17 src/mule-ccl.c --- a/src/mule-ccl.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/mule-ccl.c Mon Aug 13 10:06:47 2007 +0200 @@ -1,639 +1,1120 @@ -/* CCL -- Code Conversion Language Interpreter - Copyright (C) 1992, 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. +/* CCL (Code Conversion Language) interpreter. + Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. + Licensed to the Free Software Foundation. This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. -XEmacs 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 General Public License -for more details. +GNU Emacs 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 General Public License for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to +along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -/* Synched up with: Mule 2.3. Not in FSF. */ +/* Synched up with : FSF Emacs 20.2 */ + +#include + +#ifdef emacs #include #include "lisp.h" - #include "buffer.h" +#include "mule-charset.h" +#include "mule-ccl.h" #include "mule-coding.h" -/* CCL operators */ -#define CCL_SetCS 0x00 -#define CCL_SetCL 0x01 -#define CCL_SetR 0x02 -#define CCL_SetA 0x03 -#define CCL_Jump 0x04 -#define CCL_JumpCond 0x05 -#define CCL_WriteJump 0x06 -#define CCL_WriteReadJump 0x07 -#define CCL_WriteCJump 0x08 -#define CCL_WriteCReadJump 0x09 -#define CCL_WriteSJump 0x0A -#define CCL_WriteSReadJump 0x0B -#define CCL_WriteAReadJump 0x0C -#define CCL_Branch 0x0D -#define CCL_Read1 0x0E -#define CCL_Read2 0x0F -#define CCL_ReadBranch 0x10 -#define CCL_Write1 0x11 -#define CCL_Write2 0x12 -#define CCL_WriteC 0x13 -#define CCL_WriteS 0x14 -#define CCL_WriteA 0x15 -#define CCL_End 0x16 -#define CCL_SetSelfCS 0x17 -#define CCL_SetSelfCL 0x18 -#define CCL_SetSelfR 0x19 -#define CCL_SetExprCL 0x1A -#define CCL_SetExprR 0x1B -#define CCL_JumpCondC 0x1C -#define CCL_JumpCondR 0x1D -#define CCL_ReadJumpCondC 0x1E -#define CCL_ReadJumpCondR 0x1F +#else /* not emacs */ + +#include "mulelib.h" + +#endif /* not emacs */ + +/* Alist of fontname patterns vs corresponding CCL program. */ +Lisp_Object Vfont_ccl_encoder_alist; -#define CCL_PLUS 0x00 -#define CCL_MINUS 0x01 -#define CCL_MUL 0x02 -#define CCL_DIV 0x03 -#define CCL_MOD 0x04 -#define CCL_AND 0x05 -#define CCL_OR 0x06 -#define CCL_XOR 0x07 -#define CCL_LSH 0x08 -#define CCL_RSH 0x09 -#define CCL_LSH8 0x0A -#define CCL_RSH8 0x0B -#define CCL_DIVMOD 0x0C -#define CCL_LS 0x10 -#define CCL_GT 0x11 -#define CCL_EQ 0x12 -#define CCL_LE 0x13 -#define CCL_GE 0x14 -#define CCL_NE 0x15 +/* Vector of CCL program names vs corresponding program data. */ +Lisp_Object Vccl_program_table; + +/* CCL (Code Conversion Language) is a simple language which has + operations on one input buffer, one output buffer, and 7 registers. + The syntax of CCL is described in `ccl.el'. Emacs Lisp function + `ccl-compile' compiles a CCL program and produces a CCL code which + is a vector of integers. The structure of this vector is as + follows: The 1st element: buffer-magnification, a factor for the + size of output buffer compared with the size of input buffer. The + 2nd element: address of CCL code to be executed when encountered + with end of input stream. The 3rd and the remaining elements: CCL + codes. */ /* Header of CCL compiled code */ -#define CCL_HEADER_EOF 0 -#define CCL_HEADER_MAIN 1 +#define CCL_HEADER_BUF_MAG 0 +#define CCL_HEADER_EOF 1 +#define CCL_HEADER_MAIN 2 -#define CCL_STAT_SUCCESS 0 -#define CCL_STAT_SUSPEND 1 -#define CCL_STAT_INVALID_CMD 2 +/* CCL code is a sequence of 28-bit non-negative integers (i.e. the + MSB is always 0), each contains CCL command and/or arguments in the + following format: -#define CCL_SUCCESS \ - ccl->status = CCL_STAT_SUCCESS; \ - goto ccl_finish -#define CCL_SUSPEND \ - ccl->ic = --ic; \ - ccl->status = CCL_STAT_SUSPEND; \ - goto ccl_finish -#define CCL_INVALID_CMD \ - ccl->status = CCL_STAT_INVALID_CMD; \ - goto ccl_error_handler + |----------------- integer (28-bit) ------------------| + |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -| + |--constant argument--|-register-|-register-|-command-| + ccccccccccccccccc RRR rrr XXXXX + or + |------- relative address -------|-register-|-command-| + cccccccccccccccccccc rrr XXXXX + or + |------------- constant or other args ----------------| + cccccccccccccccccccccccccccc + + where, `cc...c' is a non-negative integer indicating constant value + (the left most `c' is always 0) or an absolute jump address, `RRR' + and `rrr' are CCL register number, `XXXXX' is one of the following + CCL commands. */ + +/* CCL commands + + Each comment fields shows one or more lines for command syntax and + the following lines for semantics of the command. In semantics, IC + stands for Instruction Counter. */ + +#define CCL_SetRegister 0x00 /* Set register a register value: + 1:00000000000000000RRRrrrXXXXX + ------------------------------ + reg[rrr] = reg[RRR]; + */ -#define CCL_WRITE_CHAR(ch) do \ -{ \ - if (!src) \ - { \ - CCL_INVALID_CMD; \ - } \ - else \ - { \ - /* !!#### is this correct for both directions????? */ \ - Bufbyte __buf__[MAX_EMCHAR_LEN]; \ - int __len__; \ - __len__ = set_charptr_emchar (__buf__, ch); \ - Dynarr_add_many (dst, __buf__, __len__); \ - } \ -} while (0) +#define CCL_SetShortConst 0x01 /* Set register a short constant value: + 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX + ------------------------------ + reg[rrr] = CCCCCCCCCCCCCCCCCCC; + */ + +#define CCL_SetConst 0x02 /* Set register a constant value: + 1:00000000000000000000rrrXXXXX + 2:CONSTANT + ------------------------------ + reg[rrr] = CONSTANT; + IC++; + */ -#define CCL_WRITE_STRING(len) do \ -{ \ - if (!src) \ - { \ - CCL_INVALID_CMD; \ - } \ - else \ - { \ - for (j = 0; j < len; j++) \ - Dynarr_add (dst, XINT (prog[ic + 1 + j])); \ - } \ -} while (0) +#define CCL_SetArray 0x03 /* Set register an element of array: + 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX + 2:ELEMENT[0] + 3:ELEMENT[1] + ... + ------------------------------ + if (0 <= reg[RRR] < CC..C) + reg[rrr] = ELEMENT[reg[RRR]]; + IC += CC..C; + */ -#define CCL_READ_CHAR(r) do \ -{ \ - if (!src) \ - { \ - CCL_INVALID_CMD; \ - } \ - else if (s < s_end) \ - r = *s++; \ - else if (end_flag) \ - { \ - ic = XINT (prog[CCL_HEADER_EOF]); \ - continue; \ - } \ - else \ - { \ - CCL_SUSPEND; \ - } \ -} while (0) +#define CCL_Jump 0x04 /* Jump: + 1:A--D--D--R--E--S--S-000XXXXX + ------------------------------ + IC += ADDRESS; + */ + +/* Note: If CC..C is greater than 0, the second code is omitted. */ + +#define CCL_JumpCond 0x05 /* Jump conditional: + 1:A--D--D--R--E--S--S-rrrXXXXX + ------------------------------ + if (!reg[rrr]) + IC += ADDRESS; + */ -/* Run a CCL program. The initial state and program are contained in - CCL. SRC, if non-zero, specifies a source string (of size N) - to read bytes from, and DST, of non-zero, specifies a destination - Dynarr to write bytes to. If END_FLAG is set, it means that - the end section of the CCL program should be run rather than - the normal section. +#define CCL_WriteRegisterJump 0x06 /* Write register and jump: + 1:A--D--D--R--E--S--S-rrrXXXXX + ------------------------------ + write (reg[rrr]); + IC += ADDRESS; + */ + +#define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump: + 1:A--D--D--R--E--S--S-rrrXXXXX + 2:A--D--D--R--E--S--S-rrrYYYYY + ----------------------------- + write (reg[rrr]); + IC++; + read (reg[rrr]); + IC += ADDRESS; + */ +/* Note: If read is suspended, the resumed execution starts from the + second code (YYYYY == CCL_ReadJump). */ + +#define CCL_WriteConstJump 0x08 /* Write constant and jump: + 1:A--D--D--R--E--S--S-000XXXXX + 2:CONST + ------------------------------ + write (CONST); + IC += ADDRESS; + */ + +#define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump: + 1:A--D--D--R--E--S--S-rrrXXXXX + 2:CONST + 3:A--D--D--R--E--S--S-rrrYYYYY + ----------------------------- + write (CONST); + IC += 2; + read (reg[rrr]); + IC += ADDRESS; + */ +/* Note: If read is suspended, the resumed execution starts from the + second code (YYYYY == CCL_ReadJump). */ + +#define CCL_WriteStringJump 0x0A /* Write string and jump: + 1:A--D--D--R--E--S--S-000XXXXX + 2:LENGTH + 3:0000STRIN[0]STRIN[1]STRIN[2] + ... + ------------------------------ + write_string (STRING, LENGTH); + IC += ADDRESS; + */ + +#define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump: + 1:A--D--D--R--E--S--S-rrrXXXXX + 2:LENGTH + 3:ELEMENET[0] + 4:ELEMENET[1] + ... + N:A--D--D--R--E--S--S-rrrYYYYY + ------------------------------ + if (0 <= reg[rrr] < LENGTH) + write (ELEMENT[reg[rrr]]); + IC += LENGTH + 2; (... pointing at N+1) + read (reg[rrr]); + IC += ADDRESS; + */ +/* Note: If read is suspended, the resumed execution starts from the + Nth code (YYYYY == CCL_ReadJump). */ + +#define CCL_ReadJump 0x0C /* Read and jump: + 1:A--D--D--R--E--S--S-rrrYYYYY + ----------------------------- + read (reg[rrr]); + IC += ADDRESS; + */ + +#define CCL_Branch 0x0D /* Jump by branch table: + 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX + 2:A--D--D--R--E-S-S[0]000XXXXX + 3:A--D--D--R--E-S-S[1]000XXXXX + ... + ------------------------------ + if (0 <= reg[rrr] < CC..C) + IC += ADDRESS[reg[rrr]]; + else + IC += ADDRESS[CC..C]; + */ + +#define CCL_ReadRegister 0x0E /* Read bytes into registers: + 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX + 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX + ... + ------------------------------ + while (CCC--) + read (reg[rrr]); + */ + +#define CCL_WriteExprConst 0x0F /* write result of expression: + 1:00000OPERATION000RRR000XXXXX + 2:CONSTANT + ------------------------------ + write (reg[RRR] OPERATION CONSTANT); + IC++; + */ + +/* Note: If the Nth read is suspended, the resumed execution starts + from the Nth code. */ + +#define CCL_ReadBranch 0x10 /* Read one byte into a register, + and jump by branch table: + 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX + 2:A--D--D--R--E-S-S[0]000XXXXX + 3:A--D--D--R--E-S-S[1]000XXXXX + ... + ------------------------------ + read (read[rrr]); + if (0 <= reg[rrr] < CC..C) + IC += ADDRESS[reg[rrr]]; + else + IC += ADDRESS[CC..C]; + */ + +#define CCL_WriteRegister 0x11 /* Write registers: + 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX + 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX + ... + ------------------------------ + while (CCC--) + write (reg[rrr]); + ... + */ + +/* Note: If the Nth write is suspended, the resumed execution + starts from the Nth code. */ + +#define CCL_WriteExprRegister 0x12 /* Write result of expression + 1:00000OPERATIONRrrRRR000XXXXX + ------------------------------ + write (reg[RRR] OPERATION reg[Rrr]); + */ + +#define CCL_Call 0x13 /* Write a constant: + 1:CCCCCCCCCCCCCCCCCCCC000XXXXX + ------------------------------ + call (CC..C) + */ + +#define CCL_WriteConstString 0x14 /* Write a constant or a string: + 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX + [2:0000STRIN[0]STRIN[1]STRIN[2]] + [...] + ----------------------------- + if (!rrr) + write (CC..C) + else + write_string (STRING, CC..C); + IC += (CC..C + 2) / 3; + */ + +#define CCL_WriteArray 0x15 /* Write an element of array: + 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX + 2:ELEMENT[0] + 3:ELEMENT[1] + ... + ------------------------------ + if (0 <= reg[rrr] < CC..C) + write (ELEMENT[reg[rrr]]); + IC += CC..C; + */ + +#define CCL_End 0x16 /* Terminate: + 1:00000000000000000000000XXXXX + ------------------------------ + terminate (); + */ + +/* The following two codes execute an assignment arithmetic/logical + operation. The form of the operation is like REG OP= OPERAND. */ + +#define CCL_ExprSelfConst 0x17 /* REG OP= constant: + 1:00000OPERATION000000rrrXXXXX + 2:CONSTANT + ------------------------------ + reg[rrr] OPERATION= CONSTANT; + */ + +#define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2: + 1:00000OPERATION000RRRrrrXXXXX + ------------------------------ + reg[rrr] OPERATION= reg[RRR]; + */ + +/* The following codes execute an arithmetic/logical operation. The + form of the operation is like REG_X = REG_Y OP OPERAND2. */ - For CCL programs that do not involve code conversion (e.g. - converting a single character into a font index), all parameters - but the first will usually be 0. */ +#define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant: + 1:00000OPERATION000RRRrrrXXXXX + 2:CONSTANT + ------------------------------ + reg[rrr] = reg[RRR] OPERATION CONSTANT; + IC++; + */ + +#define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3: + 1:00000OPERATIONRrrRRRrrrXXXXX + ------------------------------ + reg[rrr] = reg[RRR] OPERATION reg[Rrr]; + */ + +#define CCL_JumpCondExprConst 0x1B /* Jump conditional according to + an operation on constant: + 1:A--D--D--R--E--S--S-rrrXXXXX + 2:OPERATION + 3:CONSTANT + ----------------------------- + reg[7] = reg[rrr] OPERATION CONSTANT; + if (!(reg[7])) + IC += ADDRESS; + else + IC += 2 + */ + +#define CCL_JumpCondExprReg 0x1C /* Jump conditional according to + an operation on register: + 1:A--D--D--R--E--S--S-rrrXXXXX + 2:OPERATION + 3:RRR + ----------------------------- + reg[7] = reg[rrr] OPERATION reg[RRR]; + if (!reg[7]) + IC += ADDRESS; + else + IC += 2; + */ + +#define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according + to an operation on constant: + 1:A--D--D--R--E--S--S-rrrXXXXX + 2:OPERATION + 3:CONSTANT + ----------------------------- + read (reg[rrr]); + reg[7] = reg[rrr] OPERATION CONSTANT; + if (!reg[7]) + IC += ADDRESS; + else + IC += 2; + */ + +#define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according + to an operation on register: + 1:A--D--D--R--E--S--S-rrrXXXXX + 2:OPERATION + 3:RRR + ----------------------------- + read (reg[rrr]); + reg[7] = reg[rrr] OPERATION reg[RRR]; + if (!reg[7]) + IC += ADDRESS; + else + IC += 2; + */ + +#define CCL_Extention 0x1F /* Extended CCL code + 1:ExtendedCOMMNDRrrRRRrrrXXXXX + 2:ARGUEMENT + 3:... + ------------------------------ + extended_command (rrr,RRR,Rrr,ARGS) + */ + + +/* CCL arithmetic/logical operators. */ +#define CCL_PLUS 0x00 /* X = Y + Z */ +#define CCL_MINUS 0x01 /* X = Y - Z */ +#define CCL_MUL 0x02 /* X = Y * Z */ +#define CCL_DIV 0x03 /* X = Y / Z */ +#define CCL_MOD 0x04 /* X = Y % Z */ +#define CCL_AND 0x05 /* X = Y & Z */ +#define CCL_OR 0x06 /* X = Y | Z */ +#define CCL_XOR 0x07 /* X = Y ^ Z */ +#define CCL_LSH 0x08 /* X = Y << Z */ +#define CCL_RSH 0x09 /* X = Y >> Z */ +#define CCL_LSH8 0x0A /* X = (Y << 8) | Z */ +#define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */ +#define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */ +#define CCL_LS 0x10 /* X = (X < Y) */ +#define CCL_GT 0x11 /* X = (X > Y) */ +#define CCL_EQ 0x12 /* X = (X == Y) */ +#define CCL_LE 0x13 /* X = (X <= Y) */ +#define CCL_GE 0x14 /* X = (X >= Y) */ +#define CCL_NE 0x15 /* X = (X != Y) */ + +#define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z)) + r[7] = LOWER_BYTE (SJIS (Y, Z) */ +#define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z)) + r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */ + +/* Macros for exit status of CCL program. */ +#define CCL_STAT_SUCCESS 0 /* Terminated successfully. */ +#define CCL_STAT_SUSPEND 1 /* Terminated because of empty input + buffer or full output buffer. */ +#define CCL_STAT_INVALID_CMD 2 /* Terminated because of invalid + command. */ +#define CCL_STAT_QUIT 3 /* Terminated because of quit. */ + +/* Terminate CCL program successfully. */ +#define CCL_SUCCESS \ + do { \ + ccl->status = CCL_STAT_SUCCESS; \ + ccl->ic = CCL_HEADER_MAIN; \ + goto ccl_finish; \ + } while (0) + +/* Suspend CCL program because of reading from empty input buffer or + writing to full output buffer. When this program is resumed, the + same I/O command is executed. */ +#define CCL_SUSPEND \ + do { \ + ic--; \ + ccl->status = CCL_STAT_SUSPEND; \ + goto ccl_finish; \ + } while (0) + +/* Terminate CCL program because of invalid command. Should not occur + in the normal case. */ +#define CCL_INVALID_CMD \ + do { \ + ccl->status = CCL_STAT_INVALID_CMD; \ + goto ccl_error_handler; \ + } while (0) + +/* Encode one character CH to multibyte form and write to the current + output buffer. If CH is less than 256, CH is written as is. */ +#define CCL_WRITE_CHAR(ch) \ + do { \ + if (!destination) \ + CCL_INVALID_CMD; \ + else \ + { \ + Bufbyte work[MAX_EMCHAR_LEN]; \ + int len = set_charptr_emchar (work, ch); \ + Dynarr_add_many (destination, work, len); \ + } \ + } while (0) + +/* Write a string at ccl_prog[IC] of length LEN to the current output + buffer. */ +#define CCL_WRITE_STRING(len) \ + do { \ + if (!destination) \ + CCL_INVALID_CMD; \ + else \ + for (i = 0; i < len; i++) \ + Dynarr_add(destination, (XINT (ccl_prog[ic + (i / 3)]) \ + >> ((2 - (i % 3)) * 8)) & 0xFF); \ + } while (0) + +/* Read one byte from the current input buffer into Rth register. */ +#define CCL_READ_CHAR(r) \ + do { \ + if (!src) \ + CCL_INVALID_CMD; \ + else if (src < src_end) \ + r = *src++; \ + else if (ccl->last_block) \ + { \ + ic = ccl->eof_ic; \ + goto ccl_finish; \ + } \ + else \ + CCL_SUSPEND; \ + } while (0) + + +/* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting + text goes to a place pointed by DESTINATION. The bytes actually + processed is returned as *CONSUMED. The return value is the length + of the resulting text. As a side effect, the contents of CCL registers + are updated. If SOURCE or DESTINATION is NULL, only operations on + registers are permitted. */ + +#ifdef CCL_DEBUG +#define CCL_DEBUG_BACKTRACE_LEN 256 +int ccl_backtrace_table[CCL_BACKTRACE_TABLE]; +int ccl_backtrace_idx; +#endif + +struct ccl_prog_stack + { + Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */ + int ic; /* Instruction Counter. */ + }; int -ccl_driver (struct ccl_program *ccl, CONST unsigned char *src, - unsigned_char_dynarr *dst, int n, int end_flag) +ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed) { - int code, op, rrr, cc, i, j; - CONST unsigned char *s = NULL, *s_end = NULL; - int ic = ccl->ic; int *reg = ccl->reg; - Lisp_Object *prog = ccl->prog; + int ic = ccl->ic; + int code, field1, field2; + Lisp_Object *ccl_prog = ccl->prog; + unsigned char *src = source, *src_end = src + src_bytes; + int jump_address; + int i, j, op; + int stack_idx = 0; + /* For the moment, we only support depth 256 of stack. */ + struct ccl_prog_stack ccl_prog_stack_struct[256]; - if (!ic) + if (ic >= ccl->eof_ic) ic = CCL_HEADER_MAIN; - if (src) - { - s = src; - s_end = s + n; - } +#ifdef CCL_DEBUG + ccl_backtrace_idx = 0; +#endif - while (1) + for (;;) { - code = XINT (prog[ic++]); - op = code & 0x1F; - rrr = (code >> 5) & 0x7; - cc = code >> 8; +#ifdef CCL_DEBUG + ccl_backtrace_table[ccl_backtrace_idx++] = ic; + if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN) + ccl_backtrace_idx = 0; + ccl_backtrace_table[ccl_backtrace_idx] = 0; +#endif - switch (op) + if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) { - case CCL_SetCS: - reg[rrr] = cc; continue; - case CCL_SetCL: - reg[rrr] = XINT (prog[ic++]); continue; - case CCL_SetR: - reg[rrr] = reg[cc]; continue; - case CCL_SetA: - cc = reg[cc]; - i = XINT (prog[ic++]); - if (cc >= 0 && cc < i) - reg[rrr] = XINT (prog[ic + cc]); - ic += i; - continue; - case CCL_Jump: - ic = cc; continue; - case CCL_JumpCond: + /* We can't just signal Qquit, instead break the loop as if + the whole data is processed. Don't reset Vquit_flag, it + must be handled later at a safer place. */ + if (consumed) + src = source + src_bytes; + ccl->status = CCL_STAT_QUIT; + break; + } + + code = XINT (ccl_prog[ic]); ic++; + field1 = code >> 8; + field2 = (code & 0xFF) >> 5; + +#define rrr field2 +#define RRR (field1 & 7) +#define Rrr ((field1 >> 3) & 7) +#define ADDR field1 + + switch (code & 0x1F) + { + case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */ + reg[rrr] = reg[RRR]; + break; + + case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ + reg[rrr] = field1; + break; + + case CCL_SetConst: /* 00000000000000000000rrrXXXXX */ + reg[rrr] = XINT (ccl_prog[ic]); + ic++; + break; + + case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */ + i = reg[RRR]; + j = field1 >> 3; + if ((unsigned int) i < j) + reg[rrr] = XINT (ccl_prog[ic + i]); + ic += j; + break; + + case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */ + ic += ADDR; + break; + + case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */ if (!reg[rrr]) - ic = cc; - continue; - case CCL_WriteJump: - CCL_WRITE_CHAR (reg[rrr]); - ic = cc; - continue; - case CCL_WriteReadJump: - if (ccl->status != CCL_STAT_SUSPEND) - { - CCL_WRITE_CHAR (reg[rrr]); - } - else - ccl->status = CCL_STAT_SUCCESS; + ic += ADDR; + break; + + case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */ + i = reg[rrr]; + CCL_WRITE_CHAR (i); + ic += ADDR; + break; + + case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */ + i = reg[rrr]; + CCL_WRITE_CHAR (i); + ic++; CCL_READ_CHAR (reg[rrr]); - ic = cc; - continue; - case CCL_WriteCJump: - CCL_WRITE_CHAR (XINT (prog[ic])); - ic = cc; - continue; - case CCL_WriteCReadJump: - if (ccl->status != CCL_STAT_SUSPEND) - { - CCL_WRITE_CHAR (XINT (prog[ic])); - } - else - ccl->status = CCL_STAT_SUCCESS; + ic += ADDR - 1; + break; + + case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */ + i = XINT (ccl_prog[ic]); + CCL_WRITE_CHAR (i); + ic += ADDR; + break; + + case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */ + i = XINT (ccl_prog[ic]); + CCL_WRITE_CHAR (i); + ic++; CCL_READ_CHAR (reg[rrr]); - ic = cc; - continue; - case CCL_WriteSJump: - i = XINT (prog[ic]); - CCL_WRITE_STRING (i); - ic = cc; - continue; - case CCL_WriteSReadJump: - if (ccl->status != CCL_STAT_SUSPEND) + ic += ADDR - 1; + break; + + case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */ + j = XINT (ccl_prog[ic]); + ic++; + CCL_WRITE_STRING (j); + ic += ADDR - 1; + break; + + case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */ + i = reg[rrr]; + j = XINT (ccl_prog[ic]); + if ((unsigned int) i < j) { - i = XINT (prog[ic]); - CCL_WRITE_STRING (i); - } - else - ccl->status = CCL_STAT_SUCCESS; - CCL_READ_CHAR (reg[rrr]); - ic = cc; - continue; - case CCL_WriteAReadJump: - if (ccl->status != CCL_STAT_SUSPEND) - { - i = XINT (prog[ic]); - if (reg[rrr] >= 0 && reg[rrr] < i) - CCL_WRITE_CHAR (XINT (prog[ic + 1 + reg[rrr]])); + i = XINT (ccl_prog[ic + 1 + i]); + CCL_WRITE_CHAR (i); } - else - ccl->status = CCL_STAT_SUCCESS; - CCL_READ_CHAR (reg[rrr]); - ic = cc; - continue; - case CCL_ReadBranch: + ic += j + 2; CCL_READ_CHAR (reg[rrr]); - case CCL_Branch: - ic = XINT (prog[ic + (((unsigned int) reg[rrr] < cc) - ? reg[rrr] : cc)]); - continue; - case CCL_Read1: + ic += ADDR - (j + 2); + break; + + case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */ CCL_READ_CHAR (reg[rrr]); - continue; - case CCL_Read2: + ic += ADDR; + break; + + case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ CCL_READ_CHAR (reg[rrr]); - CCL_READ_CHAR (reg[cc]); - continue; - case CCL_Write1: - CCL_WRITE_CHAR (reg[rrr]); - continue; - case CCL_Write2: - CCL_WRITE_CHAR (reg[rrr]); - CCL_WRITE_CHAR (reg[cc]); - continue; - case CCL_WriteC: - i = XINT (prog[ic++]); - CCL_WRITE_CHAR (i); - continue; - case CCL_WriteS: - cc = XINT (prog[ic]); - CCL_WRITE_STRING (cc); - ic += cc + 1; - continue; - case CCL_WriteA: - i = XINT (prog[ic++]); - cc = reg[rrr]; - if (cc >= 0 && cc < i) - CCL_WRITE_CHAR (XINT (prog[ic + cc])); - ic += i; - continue; - case CCL_End: + /* fall through ... */ + case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ + if ((unsigned int) reg[rrr] < field1) + ic += XINT (ccl_prog[ic + reg[rrr]]); + else + ic += XINT (ccl_prog[ic + field1]); + break; + + case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */ + while (1) + { + CCL_READ_CHAR (reg[rrr]); + if (!field1) break; + code = XINT (ccl_prog[ic]); ic++; + field1 = code >> 8; + field2 = (code & 0xFF) >> 5; + } + break; + + case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */ + rrr = 7; + i = reg[RRR]; + j = XINT (ccl_prog[ic]); + op = field1 >> 6; + ic++; + goto ccl_set_expr; + + case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */ + while (1) + { + i = reg[rrr]; + CCL_WRITE_CHAR (i); + if (!field1) break; + code = XINT (ccl_prog[ic]); ic++; + field1 = code >> 8; + field2 = (code & 0xFF) >> 5; + } + break; + + case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */ + rrr = 7; + i = reg[RRR]; + j = reg[Rrr]; + op = field1 >> 6; + goto ccl_set_expr; + + case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */ + { + Lisp_Object slot; + + if (stack_idx >= 256 + || field1 < 0 + || field1 >= XVECTOR_LENGTH (Vccl_program_table) + || (slot = XVECTOR_DATA (Vccl_program_table)[field1], + !CONSP (slot)) + || !VECTORP (XCDR (slot))) + { + if (stack_idx > 0) + { + ccl_prog = ccl_prog_stack_struct[0].ccl_prog; + ic = ccl_prog_stack_struct[0].ic; + } + CCL_INVALID_CMD; + } + + ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; + ccl_prog_stack_struct[stack_idx].ic = ic; + stack_idx++; + ccl_prog = XVECTOR_DATA (XCDR (slot)); + ic = CCL_HEADER_MAIN; + } + break; + + case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ + if (!rrr) + CCL_WRITE_CHAR (field1); + else + { + CCL_WRITE_STRING (field1); + ic += (field1 + 2) / 3; + } + break; + + case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ + i = reg[rrr]; + if ((unsigned int) i < field1) + { + j = XINT (ccl_prog[ic + i]); + CCL_WRITE_CHAR (j); + } + ic += field1; + break; + + case CCL_End: /* 0000000000000000000000XXXXX */ + if (stack_idx-- > 0) + { + ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog; + ic = ccl_prog_stack_struct[stack_idx].ic; + break; + } CCL_SUCCESS; - case CCL_SetSelfCS: - i = cc; - op = XINT (prog[ic++]); - goto ccl_set_self; - case CCL_SetSelfCL: - i = XINT (prog[ic++]); - op = XINT (prog[ic++]); - goto ccl_set_self; - case CCL_SetSelfR: - i = reg[cc]; - op = XINT (prog[ic++]); - ccl_set_self: + + case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */ + i = XINT (ccl_prog[ic]); + ic++; + op = field1 >> 6; + goto ccl_expr_self; + + case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */ + i = reg[RRR]; + op = field1 >> 6; + + ccl_expr_self: switch (op) { - case CCL_PLUS: reg[rrr] += i; break; - case CCL_MINUS: reg[rrr] -= i; break; - case CCL_MUL: reg[rrr] *= i; break; - case CCL_DIV: reg[rrr] /= i; break; - case CCL_MOD: reg[rrr] %= i; break; - case CCL_AND: reg[rrr] &= i; break; - case CCL_OR: reg[rrr] |= i; break; - case CCL_XOR: reg[rrr] ^= i; break; - case CCL_LSH: reg[rrr] <<= i; break; - case CCL_RSH: reg[rrr] >>= i; break; - case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break; - case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break; - case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break; - case CCL_LS: reg[rrr] = reg[rrr] < i; break; - case CCL_GT: reg[rrr] = reg[rrr] > i; break; - case CCL_EQ: reg[rrr] = reg[rrr] == i; break; - case CCL_LE: reg[rrr] = reg[rrr] <= i; break; - case CCL_GE: reg[rrr] = reg[rrr] >= i; break; - case CCL_NE: reg[rrr] = reg[rrr] != i; break; + case CCL_PLUS: reg[rrr] += i; break; + case CCL_MINUS: reg[rrr] -= i; break; + case CCL_MUL: reg[rrr] *= i; break; + case CCL_DIV: reg[rrr] /= i; break; + case CCL_MOD: reg[rrr] %= i; break; + case CCL_AND: reg[rrr] &= i; break; + case CCL_OR: reg[rrr] |= i; break; + case CCL_XOR: reg[rrr] ^= i; break; + case CCL_LSH: reg[rrr] <<= i; break; + case CCL_RSH: reg[rrr] >>= i; break; + case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break; + case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break; + case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break; + case CCL_LS: reg[rrr] = reg[rrr] < i; break; + case CCL_GT: reg[rrr] = reg[rrr] > i; break; + case CCL_EQ: reg[rrr] = reg[rrr] == i; break; + case CCL_LE: reg[rrr] = reg[rrr] <= i; break; + case CCL_GE: reg[rrr] = reg[rrr] >= i; break; + case CCL_NE: reg[rrr] = reg[rrr] != i; break; default: CCL_INVALID_CMD; } - continue; - case CCL_SetExprCL: - i = reg[cc]; - j = XINT (prog[ic++]); - op = XINT (prog[ic++]); - cc = 0; + break; + + case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */ + i = reg[RRR]; + j = XINT (ccl_prog[ic]); + op = field1 >> 6; + jump_address = ++ic; goto ccl_set_expr; - case CCL_SetExprR: - i = reg[cc]; - j = reg[XINT (prog[ic++])]; - op = XINT (prog[ic++]); - cc = 0; + + case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */ + i = reg[RRR]; + j = reg[Rrr]; + op = field1 >> 6; + jump_address = ic; goto ccl_set_expr; - case CCL_ReadJumpCondC: + + case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */ CCL_READ_CHAR (reg[rrr]); - case CCL_JumpCondC: + case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */ i = reg[rrr]; - j = XINT (prog[ic++]); + op = XINT (ccl_prog[ic]); + jump_address = ic++ + ADDR; + j = XINT (ccl_prog[ic]); + ic++; rrr = 7; - op = XINT (prog[ic++]); goto ccl_set_expr; - case CCL_ReadJumpCondR: + + case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */ CCL_READ_CHAR (reg[rrr]); - case CCL_JumpCondR: + case CCL_JumpCondExprReg: i = reg[rrr]; - j = reg[XINT (prog[ic++])]; + op = XINT (ccl_prog[ic]); + jump_address = ic++ + ADDR; + j = reg[XINT (ccl_prog[ic])]; + ic++; rrr = 7; - op = XINT (prog[ic++]); - ccl_set_expr: + + ccl_set_expr: switch (op) { - case CCL_PLUS: reg[rrr] = i + j; break; - case CCL_MINUS: reg[rrr] = i - j; break; - case CCL_MUL: reg[rrr] = i * j; break; - case CCL_DIV: reg[rrr] = i / j; break; - case CCL_MOD: reg[rrr] = i % j; break; - case CCL_AND: reg[rrr] = i & j; break; - case CCL_OR: reg[rrr] = i | j; break; - case CCL_XOR: reg[rrr] = i ^ j;; break; - case CCL_LSH: reg[rrr] = i << j; break; - case CCL_RSH: reg[rrr] = i >> j; break; - case CCL_LSH8: reg[rrr] = (i << 8) | j; break; - case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break; - case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break; - case CCL_LS: reg[rrr] = i < j; break; - case CCL_GT: reg[rrr] = i > j; break; - case CCL_EQ: reg[rrr] = i == j; break; - case CCL_LE: reg[rrr] = i <= j; break; - case CCL_GE: reg[rrr] = i >= j; break; - case CCL_NE: reg[rrr] = i != j; break; + case CCL_PLUS: reg[rrr] = i + j; break; + case CCL_MINUS: reg[rrr] = i - j; break; + case CCL_MUL: reg[rrr] = i * j; break; + case CCL_DIV: reg[rrr] = i / j; break; + case CCL_MOD: reg[rrr] = i % j; break; + case CCL_AND: reg[rrr] = i & j; break; + case CCL_OR: reg[rrr] = i | j; break; + case CCL_XOR: reg[rrr] = i ^ j;; break; + case CCL_LSH: reg[rrr] = i << j; break; + case CCL_RSH: reg[rrr] = i >> j; break; + case CCL_LSH8: reg[rrr] = (i << 8) | j; break; + case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break; + case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break; + case CCL_LS: reg[rrr] = i < j; break; + case CCL_GT: reg[rrr] = i > j; break; + case CCL_EQ: reg[rrr] = i == j; break; + case CCL_LE: reg[rrr] = i <= j; break; + case CCL_GE: reg[rrr] = i >= j; break; + case CCL_NE: reg[rrr] = i != j; break; + case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break; + case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break; default: CCL_INVALID_CMD; } - if (cc && !reg[rrr]) - ic = cc; - continue; + code &= 0x1F; + if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister) + { + i = reg[rrr]; + CCL_WRITE_CHAR (i); + } + else if (!reg[rrr]) + ic = jump_address; + break; + default: CCL_INVALID_CMD; } } - ccl_error_handler: - if (dst) + ccl_error_handler: + if (destination) { - char buf[200]; + /* We can insert an error message only if DESTINATION is + specified and we still have a room to store the message + there. */ + char msg[256]; + switch (ccl->status) { case CCL_STAT_INVALID_CMD: - sprintf (buf, "CCL: Invalid command (%x).\n", op); + sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.", + code & 0x1F, code, ic); +#ifdef CCL_DEBUG + { + int i = ccl_backtrace_idx - 1; + int j; + + Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); + + for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--) + { + if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1; + if (ccl_backtrace_table[i] == 0) + break; + sprintf(msg, " %d", ccl_backtrace_table[i]); + Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); + } + } +#endif + goto ccl_finish; + + case CCL_STAT_QUIT: + sprintf(msg, "\nCCL: Quited."); break; + default: - sprintf (buf, "CCL: Unknown error type (%d).\n", ccl->status); + sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status); } - Dynarr_add_many (dst, (unsigned char *) buf, strlen (buf)); + + Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); } - ccl_finish: + ccl_finish: ccl->ic = ic; - if (dst) - return Dynarr_length (dst); + if (consumed) *consumed = src - source; + if (destination) + return Dynarr_length (destination); else return 0; } -/* Set up CCL to execute CCL program VAL, with initial register values - coming from REGS (NUMREGS of them are specified) and initial - instruction counter coming from INITIAL_IC (a value of 0 means - start at the beginning of the program, wherever that is). - */ - +/* Setup fields of the structure pointed by CCL appropriately for the + execution of compiled CCL code in VEC (vector of integer). */ void -set_ccl_program (struct ccl_program *ccl, Lisp_Object val, int *regs, - int numregs, int initial_ic) +setup_ccl_program (ccl, vec) + struct ccl_program *ccl; + Lisp_Object vec; { int i; - ccl->saved_vector = val; - ccl->prog = XVECTOR_DATA (val); - ccl->size = XVECTOR_LENGTH (val); - if (initial_ic == 0) - ccl->ic = CCL_HEADER_MAIN; - else - ccl->ic = initial_ic; - for (i = 0; i < numregs; i++) - ccl->reg[i] = regs[i]; - for (; i < 8; i++) + ccl->size = XVECTOR_LENGTH (vec); + ccl->prog = XVECTOR_DATA (vec); + ccl->ic = CCL_HEADER_MAIN; + ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]); + ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]); + for (i = 0; i < 8; i++) ccl->reg[i] = 0; - ccl->end_flag = 0; + ccl->last_block = 0; ccl->status = 0; } #ifdef emacs -static void -set_ccl_program_from_lisp_values (struct ccl_program *ccl, - Lisp_Object prog, - Lisp_Object status) +DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /* +Execute CCL-PROGRAM with registers initialized by REGISTERS. +CCL-PROGRAM is a compiled code generated by `ccl-compile', + no I/O commands should appear in the CCL program. +REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value + of Nth register. +As side effect, each element of REGISTER holds the value of + corresponding register after the execution. +*/ + (ccl_prog, reg)) { + struct ccl_program ccl; int i; - int intregs[8]; - int ic; + + CHECK_VECTOR (ccl_prog); + CHECK_VECTOR (reg); + if (XVECTOR_LENGTH (reg) != 8) + error ("Invalid length of vector REGISTERS"); + + setup_ccl_program (&ccl, ccl_prog); + for (i = 0; i < 8; i++) + ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i]) + ? XINT (XVECTOR_DATA (reg)[i]) + : 0); + + ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0, + 0, (int *)0); + QUIT; + if (ccl.status != CCL_STAT_SUCCESS) + error ("Error in CCL program at %dth code", ccl.ic); + + for (i = 0; i < 8; i++) + XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]); + return Qnil; +} - CHECK_VECTOR (prog); +DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /* +Execute CCL-PROGRAM with initial STATUS on STRING. +CCL-PROGRAM is a compiled code generated by `ccl-compile'. +Read buffer is set to STRING, and write buffer is allocated automatically. +STATUS is a vector of [R0 R1 ... R7 IC], where + R0..R7 are initial values of corresponding registers, + IC is the instruction counter specifying from where to start the program. +If R0..R7 are nil, they are initialized to 0. +If IC is nil, it is initialized to head of the CCL program. +Returns the contents of write buffer as a string, + and as side effect, STATUS is updated. +If optional 4th arg CONTINUE is non-nil, keep IC on read operation +when read buffer is exausted, else, IC is always set to the end of +CCL-PROGRAM on exit. +*/ + (ccl_prog, status, str, contin)) +{ + Lisp_Object val; + struct ccl_program ccl; + int i, produced; + unsigned_char_dynarr *outbuf; + struct gcpro gcpro1, gcpro2, gcpro3; + + CHECK_VECTOR (ccl_prog); CHECK_VECTOR (status); + if (XVECTOR_LENGTH (status) != 9) + error ("Invalid length of vector STATUS"); + CHECK_STRING (str); + GCPRO3 (ccl_prog, status, str); - if (XVECTOR_LENGTH (status) != 9) - signal_simple_error ("Must specify values for the eight registers and IC", - status); + setup_ccl_program (&ccl, ccl_prog); for (i = 0; i < 8; i++) { - Lisp_Object regval = XVECTOR_DATA (status)[i]; - if (NILP (regval)) - intregs[i] = 0; - else + if (NILP (XVECTOR_DATA (status)[i])) + XSETINT (XVECTOR_DATA (status)[i], 0); + if (INTP (XVECTOR_DATA (status)[i])) + ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]); + } + if (INTP (XVECTOR_DATA (status)[8])) + { + i = XINT (XVECTOR_DATA (status)[8]); + if (ccl.ic < i && i < ccl.size) + ccl.ic = i; + } + outbuf = Dynarr_new (unsigned_char); + ccl.last_block = NILP (contin); + produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf, + XSTRING_LENGTH (str), (int *)0); + for (i = 0; i < 8; i++) + XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]); + XSETINT (XVECTOR_DATA (status)[8], ccl.ic); + UNGCPRO; + + val = make_string (Dynarr_atp (outbuf, 0), produced); + free (outbuf); + QUIT; + if (ccl.status != CCL_STAT_SUCCESS + && ccl.status != CCL_STAT_SUSPEND) + error ("Error in CCL program at %dth code", ccl.ic); + + return val; +} + +DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /* +Register CCL program PROGRAM of NAME in `ccl-program-table'. +PROGRAM should be a compiled code of CCL program, or nil. +Return index number of the registered CCL program. +*/ + (name, ccl_prog)) +{ + int len = XVECTOR_LENGTH (Vccl_program_table); + int i; + + CHECK_SYMBOL (name); + if (!NILP (ccl_prog)) + CHECK_VECTOR (ccl_prog); + + for (i = 0; i < len; i++) + { + Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i]; + + if (!CONSP (slot)) + break; + + if (EQ (name, XCAR (slot))) { - CHECK_INT (regval); - intregs[i] = XINT (regval); + XCDR (slot) = ccl_prog; + return make_int (i); } } - { - Lisp_Object lic = XVECTOR_DATA (status)[8]; - if (NILP (lic)) - ic = 0; - else - { - CHECK_NATNUM (lic); - ic = XINT (lic); - } - } - - set_ccl_program (ccl, prog, intregs, 8, ic); -} - -static void -set_lisp_status_from_ccl_program (Lisp_Object status, - struct ccl_program *ccl) -{ - int i; - - for (i = 0; i < 8; i++) - XVECTOR_DATA (status)[i] = make_int (ccl->reg[i]); - XVECTOR_DATA (status)[8] = make_int (ccl->ic); -} - - -DEFUN ("execute-ccl-program", Fexecute_ccl_program, 2, 2, 0, /* -Execute CCL-PROGRAM with registers initialized by STATUS. -CCL-PROGRAM is a vector of compiled CCL code created by `ccl-compile'. -STATUS must be a vector of nine values, specifying the initial value - for the R0, R1 .. R7 registers and for the instruction counter IC. -A nil value for a register initializer causes the register to be set -to 0. A nil value for the IC initializer causes execution to start - at the beginning of the program. -When the program is done, STATUS is modified (by side-effect) to contain - the ending values for the corresponding registers and IC. -*/ - (ccl_program, status)) -{ - struct ccl_program ccl; - - set_ccl_program_from_lisp_values (&ccl, ccl_program, status); - ccl_driver (&ccl, 0, 0, 0, 0); - set_lisp_status_from_ccl_program (status, &ccl); - return Qnil; -} + if (i == len) + { + Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil); + int j; -DEFUN ("execute-ccl-program-string", Fexecute_ccl_program_string, 3, 3, 0, /* -Execute CCL-PROGRAM with initial STATUS on STRING. -CCL-PROGRAM is a vector of compiled CCL code created by `ccl-compile'. -STATUS must be a vector of nine values, specifying the initial value - for the R0, R1 .. R7 registers and for the instruction counter IC. -A nil value for a register initializer causes the register to be set -to 0. A nil value for the IC initializer causes execution to start - at the beginning of the program. -When the program is done, STATUS is modified (by side-effect) to contain - the ending values for the corresponding registers and IC. -Returns the resulting string. -*/ - (ccl_program, status, str)) -{ - struct ccl_program ccl; - Lisp_Object val; - int len; - unsigned_char_dynarr *outbuf; - - set_ccl_program_from_lisp_values (&ccl, ccl_program, status); - CHECK_STRING (str); + for (j = 0; j < len; j++) + XVECTOR_DATA (new_table)[j] + = XVECTOR_DATA (Vccl_program_table)[j]; + Vccl_program_table = new_table; + } - outbuf = Dynarr_new (unsigned_char); - len = ccl_driver (&ccl, XSTRING_DATA (str), outbuf, XSTRING_LENGTH (str), 0); - ccl_driver (&ccl, (unsigned char *) "", outbuf, 0, 1); - set_lisp_status_from_ccl_program (status, &ccl); - - val = make_string (Dynarr_atp (outbuf, 0), len); - Dynarr_free (outbuf); - return val; -} - -DEFUN ("ccl-reset-elapsed-time", Fccl_reset_elapsed_time, 0, 0, 0, /* -Reset the internal value which holds the time elapsed by CCL interpreter. -*/ - ()) -{ - error ("Not yet implemented; use `current-process-time'"); - return Qnil; -} - -DEFUN ("ccl-elapsed-time", Fccl_elapsed_time, 0, 0, 0, /* -Return the time elapsed by CCL interpreter as cons of user and system time. -This measures processor time, not real time. Both values are floating point -numbers measured in seconds. If only one overall value can be determined, -the return value will be a cons of that value and 0. -*/ - ()) -{ - error ("Not yet implemented; use `current-process-time'"); - return Qnil; + XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog); + return make_int (i); } void syms_of_mule_ccl (void) { - DEFSUBR (Fexecute_ccl_program); - DEFSUBR (Fexecute_ccl_program_string); - DEFSUBR (Fccl_reset_elapsed_time); - DEFSUBR (Fccl_elapsed_time); + staticpro (&Vccl_program_table); + Vccl_program_table = Fmake_vector (make_int (32), Qnil); + + DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /* +Alist of fontname patterns vs corresponding CCL program. +Each element looks like (REGEXP . CCL-CODE), + where CCL-CODE is a compiled CCL program. +When a font whose name matches REGEXP is used for displaying a character, + CCL-CODE is executed to calculate the code point in the font + from the charset number and position code(s) of the character which are set + in CCL registers R0, R1, and R2 before the execution. +The code point in the font is set in CCL registers R1 and R2 + when the execution terminated. +If the font is single-byte font, the register R2 is not used. +*/ ); + Vfont_ccl_encoder_alist = Qnil; + + DEFSUBR (Fccl_execute); + DEFSUBR (Fccl_execute_on_string); + DEFSUBR (Fregister_ccl_program); } -#else /* not emacs */ -#ifdef standalone - -#define INBUF_SIZE 1024 -#define MAX_CCL_CODE_SIZE 4096 - -void -main (int argc, char **argv) -{ - FILE *progf; - char inbuf[INBUF_SIZE]; - unsigned_char_dynarr *outbuf; - struct ccl_program ccl; - int i; - Lisp_Object ccl_prog = make_vector (MAX_CCL_CODE_SIZE); - - if (argc < 2) - { - fprintf (stderr, - "Usage: %s ccl_program_file_name outfile\n", - argv[0]); - exit (1); - } - - if ((progf = fopen (argv[1], "r")) == NULL) - { - fprintf (stderr, "%s: Can't read file %s", argv[0], argv[1]); - exit (1); - } - - XVECTOR_LENGTH (ccl_prog) = 0; - while (fscanf (progf, "%x", &i) == 1) - XVECTOR_DATA (ccl_prog)[XVECTOR_LENGTH (ccl_prog)++] = make_int (i); - set_ccl_program (&ccl, ccl_prog, 0, 0, 0); - - outbuf = Dynarr_new (unsigned char); - - while ((i = fread (inbuf, 1, INBUF_SIZE, stdin)) == INBUF_SIZE) - { - i = ccl_driver (&ccl, inbuf, outbuf, INBUF_SIZE, 0); - fwrite (Dynarr_atp (outbuf, 0), 1, i, stdout); - } - if (i) - { - i = ccl_driver (&ccl, inbuf, outbuf, i, 1); - fwrite (Dynarr_atp (outbuf, 0), 1, i, stdout); - } - - fclose (progf); - exit (0); -} -#endif /* standalone */ -#endif /* not emacs */ +#endif /* emacs */ diff -r d8688acf4c5b -r 78f53ef88e17 src/mule-ccl.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/mule-ccl.h Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,53 @@ +/* Header for CCL (Code Conversion Language) interpreter. + Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. + Licensed to the Free Software Foundation. + +This file is part of XEmacs. + +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GNU Emacs 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 General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: FSF Emacs 20.2 */ + +#ifndef _CCL_H +#define _CCL_H + +/* Structure to hold information about running CCL code. Read + comments in the file ccl.c for the detail of each field. */ +struct ccl_program { + int size; /* Size of the compiled code. */ + Lisp_Object *prog; /* Pointer into the compiled code. */ + int ic; /* Instruction Counter (index for PROG). */ + int eof_ic; /* Instruction Counter for end-of-file + processing code. */ + int reg[8]; /* CCL registers, reg[7] is used for + condition flag of relational + operations. */ + int last_block; /* Set to 1 while processing the last + block. */ + int status; /* Exit status of the CCL program. */ + int buf_magnification; /* Output buffer magnification. How + many times bigger the output buffer + should be than the input buffer. */ +}; + +int ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, + unsigned_char_dynarr *destination, int src_bytes, int *consumed); +void setup_ccl_program (struct ccl_program *ccl, Lisp_Object val); + +/* Alist of fontname patterns vs corresponding CCL program. */ +extern Lisp_Object Vfont_ccl_encoder_alist; + +#endif /* _CCL_H */ diff -r d8688acf4c5b -r 78f53ef88e17 src/mule-charset.c --- a/src/mule-charset.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/mule-charset.c Mon Aug 13 10:06:47 2007 +0200 @@ -436,7 +436,7 @@ /* Make a new charset. */ static Lisp_Object -make_charset (Lisp_Object name, Bufbyte leading_byte, unsigned char rep_bytes, +make_charset (int id, Lisp_Object name, Bufbyte leading_byte, unsigned char rep_bytes, unsigned char type, unsigned char columns, unsigned char graphic, Bufbyte final, unsigned char direction, Lisp_Object doc, Lisp_Object reg) @@ -447,6 +447,7 @@ cs = alloc_lcrecord_type (struct Lisp_Charset, lrecord_charset); XSETCHARSET (obj, cs); + CHARSET_ID (cs) = id; CHARSET_NAME (cs) = name; CHARSET_LEADING_BYTE (cs) = leading_byte; CHARSET_REP_BYTES (cs) = rep_bytes; @@ -760,7 +761,7 @@ if (columns == -1) columns = dimension; - charset = make_charset (name, lb, dimension + 2, type, columns, graphic, + charset = make_charset (-1, name, lb, dimension + 2, type, columns, graphic, final, direction, doc_string, registry); if (!NILP (ccl_program)) XCHARSET_CCL_PROGRAM (charset) = ccl_program; @@ -804,7 +805,7 @@ doc_string = CHARSET_DOC_STRING (cs); registry = CHARSET_REGISTRY (cs); - new_charset = make_charset (new_name, lb, dimension + 2, type, columns, + new_charset = make_charset (-1, new_name, lb, dimension + 2, type, columns, graphic, final, direction, doc_string, registry); CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset; @@ -938,6 +939,14 @@ return Qnil; /* not reached */ } +DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /* +Return charset identification number of CHARSET. +*/ + (charset)) +{ + return make_int(XCHARSET_ID (Fget_charset (charset))); +} + /* #### We need to figure out which properties we really want to allow to be set. */ @@ -1149,6 +1158,7 @@ DEFSUBR (Fcharset_doc_string); DEFSUBR (Fcharset_dimension); DEFSUBR (Fcharset_property); + DEFSUBR (Fcharset_id); DEFSUBR (Fset_charset_ccl_program); DEFSUBR (Fset_charset_registry); @@ -1231,73 +1241,73 @@ ease of access. */ Vcharset_ascii = - make_charset (Qascii, LEADING_BYTE_ASCII, 1, + make_charset (0, Qascii, LEADING_BYTE_ASCII, 1, CHARSET_TYPE_94, 1, 0, 'B', CHARSET_LEFT_TO_RIGHT, build_string ("ASCII (ISO 646 IRV)"), build_string ("iso8859-1")); Vcharset_control_1 = - make_charset (Qcontrol_1, LEADING_BYTE_CONTROL_1, 2, + make_charset (-1, Qcontrol_1, LEADING_BYTE_CONTROL_1, 2, CHARSET_TYPE_94, 1, 0, 0, CHARSET_LEFT_TO_RIGHT, build_string ("Control characters"), build_string ("")); Vcharset_latin_iso8859_1 = - make_charset (Qlatin_iso8859_1, LEADING_BYTE_LATIN_ISO8859_1, 2, + make_charset (129, Qlatin_iso8859_1, LEADING_BYTE_LATIN_ISO8859_1, 2, CHARSET_TYPE_96, 1, 1, 'A', CHARSET_LEFT_TO_RIGHT, build_string ("ISO 8859-1 (Latin-1)"), build_string ("iso8859-1")); Vcharset_latin_iso8859_2 = - make_charset (Qlatin_iso8859_2, LEADING_BYTE_LATIN_ISO8859_2, 2, + make_charset (130, Qlatin_iso8859_2, LEADING_BYTE_LATIN_ISO8859_2, 2, CHARSET_TYPE_96, 1, 1, 'B', CHARSET_LEFT_TO_RIGHT, build_string ("ISO 8859-2 (Latin-2)"), build_string ("iso8859-2")); Vcharset_latin_iso8859_3 = - make_charset (Qlatin_iso8859_3, LEADING_BYTE_LATIN_ISO8859_3, 2, + make_charset (131, Qlatin_iso8859_3, LEADING_BYTE_LATIN_ISO8859_3, 2, CHARSET_TYPE_96, 1, 1, 'C', CHARSET_LEFT_TO_RIGHT, build_string ("ISO 8859-3 (Latin-3)"), build_string ("iso8859-3")); Vcharset_latin_iso8859_4 = - make_charset (Qlatin_iso8859_4, LEADING_BYTE_LATIN_ISO8859_4, 2, + make_charset (132, Qlatin_iso8859_4, LEADING_BYTE_LATIN_ISO8859_4, 2, CHARSET_TYPE_96, 1, 1, 'D', CHARSET_LEFT_TO_RIGHT, build_string ("ISO 8859-4 (Latin-4)"), build_string ("iso8859-4")); Vcharset_cyrillic_iso8859_5 = - make_charset (Qcyrillic_iso8859_5, LEADING_BYTE_CYRILLIC_ISO8859_5, 2, + make_charset (140, Qcyrillic_iso8859_5, LEADING_BYTE_CYRILLIC_ISO8859_5, 2, CHARSET_TYPE_96, 1, 1, 'L', CHARSET_LEFT_TO_RIGHT, build_string ("ISO 8859-5 (Cyrillic)"), build_string ("iso8859-5")); Vcharset_arabic_iso8859_6 = - make_charset (Qarabic_iso8859_6, LEADING_BYTE_ARABIC_ISO8859_6, 2, + make_charset (135, Qarabic_iso8859_6, LEADING_BYTE_ARABIC_ISO8859_6, 2, CHARSET_TYPE_96, 1, 1, 'G', CHARSET_RIGHT_TO_LEFT, build_string ("ISO 8859-6 (Arabic)"), build_string ("iso8859-6")); Vcharset_greek_iso8859_7 = - make_charset (Qgreek_iso8859_7, LEADING_BYTE_GREEK_ISO8859_7, 2, + make_charset (134, Qgreek_iso8859_7, LEADING_BYTE_GREEK_ISO8859_7, 2, CHARSET_TYPE_96, 1, 1, 'F', CHARSET_LEFT_TO_RIGHT, build_string ("ISO 8859-7 (Greek)"), build_string ("iso8859-7")); Vcharset_hebrew_iso8859_8 = - make_charset (Qhebrew_iso8859_8, LEADING_BYTE_HEBREW_ISO8859_8, 2, + make_charset (136, Qhebrew_iso8859_8, LEADING_BYTE_HEBREW_ISO8859_8, 2, CHARSET_TYPE_96, 1, 1, 'H', CHARSET_RIGHT_TO_LEFT, build_string ("ISO 8859-8 (Hebrew)"), build_string ("iso8859-8")); Vcharset_latin_iso8859_9 = - make_charset (Qlatin_iso8859_9, LEADING_BYTE_LATIN_ISO8859_9, 2, + make_charset (141, Qlatin_iso8859_9, LEADING_BYTE_LATIN_ISO8859_9, 2, CHARSET_TYPE_96, 1, 1, 'M', CHARSET_LEFT_TO_RIGHT, build_string ("ISO 8859-9 (Latin-5)"), build_string ("iso8859-9")); Vcharset_thai_tis620 = - make_charset (Qthai_tis620, LEADING_BYTE_THAI_TIS620, 2, + make_charset (133, Qthai_tis620, LEADING_BYTE_THAI_TIS620, 2, CHARSET_TYPE_96, 1, 1, 'T', CHARSET_LEFT_TO_RIGHT, build_string ("TIS 620.2529 (Thai)"), @@ -1305,21 +1315,21 @@ /* Japanese */ Vcharset_katakana_jisx0201 = - make_charset (Qkatakana_jisx0201, + make_charset (137, Qkatakana_jisx0201, LEADING_BYTE_KATAKANA_JISX0201, 2, CHARSET_TYPE_94, 1, 1, 'I', CHARSET_LEFT_TO_RIGHT, build_string ("JIS X0201-Katakana"), build_string ("jisx0201.1976")); Vcharset_latin_jisx0201 = - make_charset (Qlatin_jisx0201, + make_charset (138, Qlatin_jisx0201, LEADING_BYTE_LATIN_JISX0201, 2, CHARSET_TYPE_94, 1, 0, 'J', CHARSET_LEFT_TO_RIGHT, build_string ("JIS X0201-Latin"), build_string ("jisx0201.1976")); Vcharset_japanese_jisx0208_1978 = - make_charset (Qjapanese_jisx0208_1978, + make_charset (144, Qjapanese_jisx0208_1978, LEADING_BYTE_JAPANESE_JISX0208_1978, 3, CHARSET_TYPE_94X94, 2, 0, '@', CHARSET_LEFT_TO_RIGHT, @@ -1327,14 +1337,14 @@ ("JIS X0208-1978 (Japanese Kanji; Old Version)"), build_string ("\\(jisx0208\\|jisc6226\\).19")); Vcharset_japanese_jisx0208 = - make_charset (Qjapanese_jisx0208, + make_charset (146, Qjapanese_jisx0208, LEADING_BYTE_JAPANESE_JISX0208, 3, CHARSET_TYPE_94X94, 2, 0, 'B', CHARSET_LEFT_TO_RIGHT, build_string ("JIS X0208-1983 (Japanese Kanji)"), build_string ("jisx0208.19\\(83\\|90\\)")); Vcharset_japanese_jisx0212 = - make_charset (Qjapanese_jisx0212, + make_charset (148, Qjapanese_jisx0212, LEADING_BYTE_JAPANESE_JISX0212, 3, CHARSET_TYPE_94X94, 2, 0, 'D', CHARSET_LEFT_TO_RIGHT, @@ -1343,14 +1353,14 @@ /* Chinese */ Vcharset_chinese_gb2312 = - make_charset (Qchinese_gb2312, LEADING_BYTE_CHINESE_GB2312, 3, + make_charset (145, Qchinese_gb2312, LEADING_BYTE_CHINESE_GB2312, 3, CHARSET_TYPE_94X94, 2, 0, 'A', CHARSET_LEFT_TO_RIGHT, build_string ("GB 2312 (Simplified Chinese)"), build_string ("gb2312")); #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$" Vcharset_chinese_cns11643_1 = - make_charset (Qchinese_cns11643_1, + make_charset (149, Qchinese_cns11643_1, LEADING_BYTE_CHINESE_CNS11643_1, 3, CHARSET_TYPE_94X94, 2, 0, 'G', CHARSET_LEFT_TO_RIGHT, @@ -1358,7 +1368,7 @@ ("CNS 11643 Plane 1 (Traditional Chinese for daily use)"), build_string (CHINESE_CNS_PLANE_RE("1"))); Vcharset_chinese_cns11643_2 = - make_charset (Qchinese_cns11643_2, + make_charset (150, Qchinese_cns11643_2, LEADING_BYTE_CHINESE_CNS11643_2, 3, CHARSET_TYPE_94X94, 2, 0, 'H', CHARSET_LEFT_TO_RIGHT, @@ -1366,14 +1376,14 @@ ("CNS 11643 Plane 2 (Traditional Chinese for daily use)"), build_string (CHINESE_CNS_PLANE_RE("2"))); Vcharset_chinese_big5_1 = - make_charset (Qchinese_big5_1, LEADING_BYTE_CHINESE_BIG5_1, 3, + make_charset (152, Qchinese_big5_1, LEADING_BYTE_CHINESE_BIG5_1, 3, CHARSET_TYPE_94X94, 2, 0, '0', CHARSET_LEFT_TO_RIGHT, build_string ("Big5 Level 1 (Traditional Chinese for daily use)"), build_string ("big5")); Vcharset_chinese_big5_2 = - make_charset (Qchinese_big5_2, LEADING_BYTE_CHINESE_BIG5_2, 3, + make_charset (153, Qchinese_big5_2, LEADING_BYTE_CHINESE_BIG5_2, 3, CHARSET_TYPE_94X94, 2, 0, '1', CHARSET_LEFT_TO_RIGHT, build_string @@ -1381,7 +1391,7 @@ build_string ("big5")); Vcharset_korean_ksc5601 = - make_charset (Qkorean_ksc5601, LEADING_BYTE_KOREAN_KSC5601, 3, + make_charset (147, Qkorean_ksc5601, LEADING_BYTE_KOREAN_KSC5601, 3, CHARSET_TYPE_94X94, 2, 0, 'C', CHARSET_LEFT_TO_RIGHT, build_string ("KS C5601 (Hangul and Korean Hanja)"), @@ -1390,7 +1400,7 @@ This is going to lead to problems because you can run out of room, esp. as we don't yet recycle numbers. */ Vcharset_composite = - make_charset (Qcomposite, LEADING_BYTE_COMPOSITE, 3, + make_charset (-1, Qcomposite, LEADING_BYTE_COMPOSITE, 3, CHARSET_TYPE_96X96, 2, 0, 0, CHARSET_LEFT_TO_RIGHT, build_string ("Composite characters"), diff -r d8688acf4c5b -r 78f53ef88e17 src/mule-charset.h --- a/src/mule-charset.h Mon Aug 13 10:05:53 2007 +0200 +++ b/src/mule-charset.h Mon Aug 13 10:06:47 2007 +0200 @@ -444,6 +444,7 @@ { struct lcrecord_header header; + int id; Lisp_Object name; Lisp_Object doc_string, registry; @@ -492,6 +493,7 @@ #define CHARSET_LEFT_TO_RIGHT 0 #define CHARSET_RIGHT_TO_LEFT 1 +#define CHARSET_ID(cs) ((cs)->id) #define CHARSET_NAME(cs) ((cs)->name) #define CHARSET_LEADING_BYTE(cs) ((cs)->leading_byte) #define CHARSET_REP_BYTES(cs) ((cs)->rep_bytes) @@ -511,6 +513,7 @@ #define CHARSET_PRIVATE_P(cs) LEADING_BYTE_PRIVATE_P (CHARSET_LEADING_BYTE (cs)) +#define XCHARSET_ID(cs) CHARSET_ID (XCHARSET (cs)) #define XCHARSET_NAME(cs) CHARSET_NAME (XCHARSET (cs)) #define XCHARSET_REP_BYTES(cs) CHARSET_REP_BYTES (XCHARSET (cs)) #define XCHARSET_COLUMNS(cs) CHARSET_COLUMNS (XCHARSET (cs)) diff -r d8688acf4c5b -r 78f53ef88e17 src/mule-coding.c --- a/src/mule-coding.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/mule-coding.c Mon Aug 13 10:06:47 2007 +0200 @@ -30,6 +30,7 @@ #include "elhash.h" #include "insdel.h" #include "lstream.h" +#include "mule-ccl.h" #include "mule-coding.h" Lisp_Object Qbuffer_file_coding_system, Qcoding_system_error; @@ -1810,8 +1811,7 @@ } else if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_CCL) { - set_ccl_program (&str->ccl, CODING_SYSTEM_CCL_DECODE (str->codesys), - 0, 0, 0); + setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_DECODE (str->codesys)); } str->flags = str->ch = 0; @@ -1985,7 +1985,7 @@ decode_coding_big5 (decoding, src, dst, n); break; case CODESYS_CCL: - ccl_driver (&str->ccl, src, dst, n, (str->flags) & CODING_STATE_END); + ccl_driver (&str->ccl, src, dst, n, 0); break; case CODESYS_ISO2022: decode_coding_iso2022 (decoding, src, dst, n); @@ -2263,7 +2263,7 @@ break; } case CODESYS_CCL: - set_ccl_program (&str->ccl, CODING_SYSTEM_CCL_ENCODE (str->codesys), 0, 0, 0); + setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_ENCODE (str->codesys)); break; default: break; @@ -2385,7 +2385,7 @@ encode_coding_big5 (encoding, src, dst, n); break; case CODESYS_CCL: - ccl_driver (&str->ccl, src, dst, n, (str->flags) & CODING_STATE_END); + ccl_driver (&str->ccl, src, dst, n, 0); break; case CODESYS_ISO2022: encode_coding_iso2022 (encoding, src, dst, n); @@ -2496,44 +2496,6 @@ #define BYTE_SJIS_KATAKANA_P(c) \ ((c) >= 0xA1 && (c) <= 0xDF) -/* Code conversion macros. These are macros because they are used in - inner loops during code conversion. - - Note that temporary variables in macros introduce the classic - dynamic-scoping problems with variable names. We use capital- - lettered variables in the assumption that XEmacs does not use - capital letters in variables except in a very formalized way - (e.g. Qstring). */ - -/* Convert shift-JIS code (sj1, sj2) into internal string - representation (c1, c2). (The leading byte is assumed.) */ - -#define DECODE_SJIS(sj1, sj2, c1, c2) \ -do { \ - int I1 = sj1, I2 = sj2; \ - if (I2 >= 0x9f) \ - c1 = (I1 << 1) - ((I1 >= 0xe0) ? 0xe0 : 0x60), \ - c2 = I2 + 2; \ - else \ - c1 = (I1 << 1) - ((I1 >= 0xe0) ? 0xe1 : 0x61), \ - c2 = I2 + ((I2 >= 0x7f) ? 0x60 : 0x61); \ -} while (0) - -/* Convert the internal string representation of a Shift-JIS character - (c1, c2) into Shift-JIS code (sj1, sj2). The leading byte is - assumed. */ - -#define ENCODE_SJIS(c1, c2, sj1, sj2) \ -do { \ - int I1 = c1, I2 = c2; \ - if (I1 & 1) \ - sj1 = (I1 >> 1) + ((I1 < 0xdf) ? 0x31 : 0x71), \ - sj2 = I2 - ((I2 >= 0xe0) ? 0x60 : 0x61); \ - else \ - sj1 = (I1 >> 1) + ((I1 < 0xdf) ? 0x30 : 0x70), \ - sj2 = I2 - 2; \ -} while (0) - static int detect_coding_sjis (struct detection_state *st, CONST unsigned char *src, unsigned int n) diff -r d8688acf4c5b -r 78f53ef88e17 src/mule-coding.h --- a/src/mule-coding.h Mon Aug 13 10:05:53 2007 +0200 +++ b/src/mule-coding.h Mon Aug 13 10:06:47 2007 +0200 @@ -60,18 +60,6 @@ EOL_CR }; -/* This holds the current state of a running CCL program. */ -struct ccl_program -{ - Lisp_Object saved_vector; - Lisp_Object *prog; /* compiled code */ - int size; /* size of compiled code */ - int ic; /* instruction counter */ - int reg[8]; /* reg[7] is used for `condition' */ - int end_flag; /* set when processing the last block */ - int status; -}; - typedef struct charset_conversion_spec charset_conversion_spec; struct charset_conversion_spec { @@ -420,6 +408,32 @@ #define CODING_CATEGORY_NOT_FINISHED_MASK \ (1 << 30) +/* Macros to decode or encode a character of JISX0208 in SJIS. S1 and + S2 are the 1st and 2nd position-codes of JISX0208 in SJIS coding + system. C1 and C2 are the 1st and 2nd position codes of Emacs' + internal format. */ + +#define DECODE_SJIS(s1, s2, c1, c2) \ + do { \ + if (s2 >= 0x9F) \ + c1 = s1 * 2 - (s1 >= 0xE0 ? 0x160 : 0xE0), \ + c2 = s2 - 0x7E; \ + else \ + c1 = s1 * 2 - ((s1 >= 0xE0) ? 0x161 : 0xE1), \ + c2 = s2 - ((s2 >= 0x7F) ? 0x20 : 0x1F); \ + } while (0) + +#define ENCODE_SJIS(c1, c2, s1, s2) \ + do { \ + if ((c1) & 1) \ + s1 = (c1) / 2 + (((c1) < 0x5F) ? 0x71 : 0xB1), \ + s2 = (c2) + (((c2) >= 0x60) ? 0x20 : 0x1F); \ + else \ + s1 = (c1) / 2 + (((c1) < 0x5F) ? 0x70 : 0xB0), \ + s2 = (c2) + 0x7E; \ + } while (0) + + extern Lisp_Object make_decoding_input_stream (Lstream *stream, Lisp_Object codesys); extern Lisp_Object make_encoding_input_stream (Lstream *stream, @@ -434,11 +448,4 @@ Lisp_Object codesys); extern void set_encoding_stream_coding_system (Lstream *stream, Lisp_Object codesys); - -/* In mule-ccl.c */ -int ccl_driver (struct ccl_program *ccl, CONST unsigned char *src, - unsigned_char_dynarr *dst, int n, int end_flag); -void set_ccl_program (struct ccl_program *ccl, Lisp_Object val, int *regs, - int numregs, int initial_ic); - #endif /* _XEMACS_MULE_CODING_H_ */ diff -r d8688acf4c5b -r 78f53ef88e17 src/nt.c --- a/src/nt.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/nt.c Mon Aug 13 10:06:47 2007 +0200 @@ -590,7 +590,7 @@ return 0; } -#define REG_ROOT "SOFTWARE\\GNU\\Emacs" +#define REG_ROOT "SOFTWARE\\GNU\\XEmacs" LPBYTE nt_get_resource (key, lpdwtype) diff -r d8688acf4c5b -r 78f53ef88e17 src/objects-msw.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/objects-msw.c Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,1095 @@ +/* mswindows-specific Lisp objects. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995 Tinker Systems. + Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 1997 Jonathan Harris. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs 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 General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Jamie Zawinski, Chuck Thompson, Ben Wing + Rewritten for mswindows by Jonathan Harris, November 1997 for 20.4. + */ + + +/* TODO: palette handling */ + +#include +#include "lisp.h" + +#include "console-msw.h" +#include "objects-msw.h" + +#ifdef MULE +#include "mule-charset.h" +#endif + +#include "buffer.h" +#include "device.h" +#include "insdel.h" + +#include "windows.h" + +typedef struct colormap_t +{ + char *name; + COLORREF colorref; +} colormap_t; + +static CONST colormap_t mswindows_X_color_map[] = +{ + {"Black" , PALETTERGB ( 0, 0, 0)}, + {"Gray0" , PALETTERGB ( 0, 0, 0)}, + {"Grey0" , PALETTERGB ( 0, 0, 0)}, + {"Transparent" , PALETTERGB ( 0, 0, 1)}, + {"NavyBlue" , PALETTERGB ( 0, 0,128)}, + {"navy" , PALETTERGB ( 0, 0,128)}, + {"blue4" , PALETTERGB ( 0, 0,139)}, + {"MediumBlue" , PALETTERGB ( 0, 0,205)}, + {"blue3" , PALETTERGB ( 0, 0,205)}, + {"blue2" , PALETTERGB ( 0, 0,238)}, + {"Blue" , PALETTERGB ( 0, 0,255)}, + {"blue1" , PALETTERGB ( 0, 0,255)}, + {"DarkGreen" , PALETTERGB ( 0, 86, 45)}, + {"DeepSkyBlue4" , PALETTERGB ( 0,104,139)}, + {"turquoise4" , PALETTERGB ( 0,134,139)}, + {"green4" , PALETTERGB ( 0,139, 0)}, + {"SpringGreen4" , PALETTERGB ( 0,139, 69)}, + {"cyan4" , PALETTERGB ( 0,139,139)}, + {"MediumAquamarine" , PALETTERGB ( 0,147,143)}, + {"DeepSkyBlue3" , PALETTERGB ( 0,154,205)}, + {"DarkTurquoise" , PALETTERGB ( 0,166,166)}, + {"LimeGreen" , PALETTERGB ( 0,175, 20)}, + {"DeepSkyBlue2" , PALETTERGB ( 0,178,238)}, + {"DeepSkyBlue" , PALETTERGB ( 0,191,255)}, + {"DeepSkyBlue1" , PALETTERGB ( 0,191,255)}, + {"turquoise3" , PALETTERGB ( 0,197,205)}, + {"green3" , PALETTERGB ( 0,205, 0)}, + {"SpringGreen3" , PALETTERGB ( 0,205,102)}, + {"cyan3" , PALETTERGB ( 0,205,205)}, + {"MediumTurquoise" , PALETTERGB ( 0,210,210)}, + {"turquoise2" , PALETTERGB ( 0,229,238)}, + {"green2" , PALETTERGB ( 0,238, 0)}, + {"SpringGreen2" , PALETTERGB ( 0,238,118)}, + {"cyan2" , PALETTERGB ( 0,238,238)}, + {"turquoise1" , PALETTERGB ( 0,245,255)}, + {"MediumSpringGreen" , PALETTERGB ( 0,250,154)}, + {"Green" , PALETTERGB ( 0,255, 0)}, + {"green1" , PALETTERGB ( 0,255, 0)}, + {"SpringGreen" , PALETTERGB ( 0,255,127)}, + {"SpringGreen1" , PALETTERGB ( 0,255,127)}, + {"Cyan" , PALETTERGB ( 0,255,255)}, + {"cyan1" , PALETTERGB ( 0,255,255)}, + {"Gray1" , PALETTERGB ( 3, 3, 3)}, + {"Grey1" , PALETTERGB ( 3, 3, 3)}, + {"Gray2" , PALETTERGB ( 5, 5, 5)}, + {"Grey2" , PALETTERGB ( 5, 5, 5)}, + {"Gray3" , PALETTERGB ( 8, 8, 8)}, + {"Grey3" , PALETTERGB ( 8, 8, 8)}, + {"Gray4" , PALETTERGB ( 10, 10, 10)}, + {"Grey4" , PALETTERGB ( 10, 10, 10)}, + {"Gray5" , PALETTERGB ( 13, 13, 13)}, + {"Grey5" , PALETTERGB ( 13, 13, 13)}, + {"Gray6" , PALETTERGB ( 15, 15, 15)}, + {"Grey6" , PALETTERGB ( 15, 15, 15)}, + {"DodgerBlue4" , PALETTERGB ( 16, 78,139)}, + {"Gray7" , PALETTERGB ( 18, 18, 18)}, + {"Grey7" , PALETTERGB ( 18, 18, 18)}, + {"Gray8" , PALETTERGB ( 20, 20, 20)}, + {"Grey8" , PALETTERGB ( 20, 20, 20)}, + {"Gray9" , PALETTERGB ( 23, 23, 23)}, + {"Grey9" , PALETTERGB ( 23, 23, 23)}, + {"DodgerBlue3" , PALETTERGB ( 24,116,205)}, + {"MidnightBlue" , PALETTERGB ( 25, 25,112)}, + {"Turquoise" , PALETTERGB ( 25,204,223)}, + {"Gray10" , PALETTERGB ( 26, 26, 26)}, + {"Grey10" , PALETTERGB ( 26, 26, 26)}, + {"Gray11" , PALETTERGB ( 28, 28, 28)}, + {"Grey11" , PALETTERGB ( 28, 28, 28)}, + {"DodgerBlue2" , PALETTERGB ( 28,134,238)}, + {"DodgerBlue" , PALETTERGB ( 30,144,255)}, + {"DodgerBlue1" , PALETTERGB ( 30,144,255)}, + {"Gray12" , PALETTERGB ( 31, 31, 31)}, + {"Grey12" , PALETTERGB ( 31, 31, 31)}, + {"LightSeaGreen" , PALETTERGB ( 32,178,170)}, + {"Gray13" , PALETTERGB ( 33, 33, 33)}, + {"Grey13" , PALETTERGB ( 33, 33, 33)}, + {"Indigo2" , PALETTERGB ( 33,136,104)}, + {"CornflowerBlue" , PALETTERGB ( 34, 34,152)}, + {"ForestGreen" , PALETTERGB ( 34,139, 34)}, + {"Gray14" , PALETTERGB ( 36, 36, 36)}, + {"Grey14" , PALETTERGB ( 36, 36, 36)}, + {"Gray15" , PALETTERGB ( 38, 38, 38)}, + {"Grey15" , PALETTERGB ( 38, 38, 38)}, + {"RoyalBlue4" , PALETTERGB ( 39, 64,139)}, + {"Gray16" , PALETTERGB ( 41, 41, 41)}, + {"Grey16" , PALETTERGB ( 41, 41, 41)}, + {"Gray17" , PALETTERGB ( 43, 43, 43)}, + {"Grey17" , PALETTERGB ( 43, 43, 43)}, + {"Gray18" , PALETTERGB ( 46, 46, 46)}, + {"Grey18" , PALETTERGB ( 46, 46, 46)}, + {"SeaGreen" , PALETTERGB ( 46,139, 87)}, + {"SeaGreen4" , PALETTERGB ( 46,139, 87)}, + {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)}, + {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)}, + {"Gray19" , PALETTERGB ( 48, 48, 48)}, + {"Grey19" , PALETTERGB ( 48, 48, 48)}, + {"MediumForestGreen" , PALETTERGB ( 50,129, 75)}, + {"Aquamarine" , PALETTERGB ( 50,191,193)}, + {"YellowGreen" , PALETTERGB ( 50,216, 56)}, + {"Gray20" , PALETTERGB ( 51, 51, 51)}, + {"Grey20" , PALETTERGB ( 51, 51, 51)}, + {"MediumSeaGreen" , PALETTERGB ( 52,119,102)}, + {"Gray21" , PALETTERGB ( 54, 54, 54)}, + {"Grey21" , PALETTERGB ( 54, 54, 54)}, + {"SteelBlue4" , PALETTERGB ( 54,100,139)}, + {"Gray22" , PALETTERGB ( 56, 56, 56)}, + {"Grey22" , PALETTERGB ( 56, 56, 56)}, + {"DarkSlateBlue" , PALETTERGB ( 56, 75,102)}, + {"RoyalBlue3" , PALETTERGB ( 58, 95,205)}, + {"Gray23" , PALETTERGB ( 59, 59, 59)}, + {"Grey23" , PALETTERGB ( 59, 59, 59)}, + {"Gray24" , PALETTERGB ( 61, 61, 61)}, + {"Grey24" , PALETTERGB ( 61, 61, 61)}, + {"Gray25" , PALETTERGB ( 64, 64, 64)}, + {"Grey25" , PALETTERGB ( 64, 64, 64)}, + {"RoyalBlue" , PALETTERGB ( 65,105,225)}, + {"Gray26" , PALETTERGB ( 66, 66, 66)}, + {"Grey26" , PALETTERGB ( 66, 66, 66)}, + {"RoyalBlue2" , PALETTERGB ( 67,110,238)}, + {"SeaGreen3" , PALETTERGB ( 67,205,128)}, + {"Gray27" , PALETTERGB ( 69, 69, 69)}, + {"Grey27" , PALETTERGB ( 69, 69, 69)}, + {"chartreuse4" , PALETTERGB ( 69,139, 0)}, + {"aquamarine4" , PALETTERGB ( 69,139,116)}, + {"SteelBlue" , PALETTERGB ( 70,130,180)}, + {"SlateBlue4" , PALETTERGB ( 71, 60,139)}, + {"Gray28" , PALETTERGB ( 71, 71, 71)}, + {"Grey28" , PALETTERGB ( 71, 71, 71)}, + {"RoyalBlue1" , PALETTERGB ( 72,118,255)}, + {"Gray29" , PALETTERGB ( 74, 74, 74)}, + {"Grey29" , PALETTERGB ( 74, 74, 74)}, + {"SkyBlue4" , PALETTERGB ( 74,112,139)}, + {"Indigo" , PALETTERGB ( 75, 0,130)}, + {"Gray30" , PALETTERGB ( 77, 77, 77)}, + {"Grey30" , PALETTERGB ( 77, 77, 77)}, + {"SeaGreen2" , PALETTERGB ( 78,238,148)}, + {"Gray31" , PALETTERGB ( 79, 79, 79)}, + {"Grey31" , PALETTERGB ( 79, 79, 79)}, + {"SteelBlue3" , PALETTERGB ( 79,148,205)}, + {"Gray32" , PALETTERGB ( 82, 82, 82)}, + {"Grey32" , PALETTERGB ( 82, 82, 82)}, + {"DarkSlateGray4" , PALETTERGB ( 82,139,139)}, + {"CadetBlue4" , PALETTERGB ( 83,134,139)}, + {"DimGray" , PALETTERGB ( 84, 84, 84)}, + {"DimGrey" , PALETTERGB ( 84, 84, 84)}, + {"Gray33" , PALETTERGB ( 84, 84, 84)}, + {"Grey33" , PALETTERGB ( 84, 84, 84)}, + {"PaleGreen4" , PALETTERGB ( 84,139, 84)}, + {"SeaGreen1" , PALETTERGB ( 84,255,159)}, + {"purple4" , PALETTERGB ( 85, 26,139)}, + {"DarkOliveGreen" , PALETTERGB ( 85, 86, 47)}, + {"Gray34" , PALETTERGB ( 87, 87, 87)}, + {"Grey34" , PALETTERGB ( 87, 87, 87)}, + {"Gray35" , PALETTERGB ( 89, 89, 89)}, + {"Grey35" , PALETTERGB ( 89, 89, 89)}, + {"Gray36" , PALETTERGB ( 92, 92, 92)}, + {"Grey36" , PALETTERGB ( 92, 92, 92)}, + {"SteelBlue2" , PALETTERGB ( 92,172,238)}, + {"MediumPurple4" , PALETTERGB ( 93, 71,139)}, + {"Gray37" , PALETTERGB ( 94, 94, 94)}, + {"Grey37" , PALETTERGB ( 94, 94, 94)}, + {"CadetBlue" , PALETTERGB ( 95,146,158)}, + {"LightSkyBlue4" , PALETTERGB ( 96,123,139)}, + {"Gray38" , PALETTERGB ( 97, 97, 97)}, + {"Grey38" , PALETTERGB ( 97, 97, 97)}, + {"Gray39" , PALETTERGB ( 99, 99, 99)}, + {"Grey39" , PALETTERGB ( 99, 99, 99)}, + {"SteelBlue1" , PALETTERGB ( 99,184,255)}, + {"Gray40" , PALETTERGB (102,102,102)}, + {"Grey40" , PALETTERGB (102,102,102)}, + {"PaleTurquoise4" , PALETTERGB (102,139,139)}, + {"chartreuse3" , PALETTERGB (102,205, 0)}, + {"aquamarine3" , PALETTERGB (102,205,170)}, + {"DarkOrchid4" , PALETTERGB (104, 34,139)}, + {"LightBlue4" , PALETTERGB (104,131,139)}, + {"SlateBlue3" , PALETTERGB (105, 89,205)}, + {"Gray41" , PALETTERGB (105,105,105)}, + {"Grey41" , PALETTERGB (105,105,105)}, + {"OliveDrab4" , PALETTERGB (105,139, 34)}, + {"DarkSeaGreen4" , PALETTERGB (105,139,105)}, + {"SlateBlue" , PALETTERGB (106, 90,205)}, + {"MediumSlateBlue" , PALETTERGB (106,106,141)}, + {"IndianRed" , PALETTERGB (107, 57, 57)}, + {"Gray42" , PALETTERGB (107,107,107)}, + {"Grey42" , PALETTERGB (107,107,107)}, + {"OliveDrab" , PALETTERGB (107,142, 35)}, + {"SlateGray4" , PALETTERGB (108,123,139)}, + {"SkyBlue3" , PALETTERGB (108,166,205)}, + {"Gray43" , PALETTERGB (110,110,110)}, + {"Grey43" , PALETTERGB (110,110,110)}, + {"LightSteelBlue4" , PALETTERGB (110,123,139)}, + {"DarkOliveGreen4" , PALETTERGB (110,139, 61)}, + {"Gray44" , PALETTERGB (112,112,112)}, + {"Grey44" , PALETTERGB (112,112,112)}, + {"SlateGray" , PALETTERGB (112,128,144)}, + {"SlateGrey" , PALETTERGB (112,128,144)}, + {"SkyBlue" , PALETTERGB (114,159,255)}, + {"Gray45" , PALETTERGB (115,115,115)}, + {"Grey45" , PALETTERGB (115,115,115)}, + {"PaleGreen" , PALETTERGB (115,222,120)}, + {"Gray46" , PALETTERGB (117,117,117)}, + {"Grey46" , PALETTERGB (117,117,117)}, + {"chartreuse2" , PALETTERGB (118,238, 0)}, + {"aquamarine2" , PALETTERGB (118,238,198)}, + {"LightSlateGray" , PALETTERGB (119,136,153)}, + {"LightSlateGrey" , PALETTERGB (119,136,153)}, + {"Gray47" , PALETTERGB (120,120,120)}, + {"Grey47" , PALETTERGB (120,120,120)}, + {"DarkSlateGray3" , PALETTERGB (121,205,205)}, + {"MediumOrchid4" , PALETTERGB (122, 55,139)}, + {"SlateBlue2" , PALETTERGB (122,103,238)}, + {"Gray48" , PALETTERGB (122,122,122)}, + {"Grey48" , PALETTERGB (122,122,122)}, + {"LightCyan4" , PALETTERGB (122,139,139)}, + {"CadetBlue3" , PALETTERGB (122,197,205)}, + {"LightSteelBlue" , PALETTERGB (124,152,211)}, + {"PaleGreen3" , PALETTERGB (124,205,124)}, + {"LawnGreen" , PALETTERGB (124,252, 0)}, + {"purple3" , PALETTERGB (125, 38,205)}, + {"Gray49" , PALETTERGB (125,125,125)}, + {"Grey49" , PALETTERGB (125,125,125)}, + {"Gray" , PALETTERGB (126,126,126)}, + {"Grey" , PALETTERGB (126,126,126)}, + {"SkyBlue2" , PALETTERGB (126,192,238)}, + {"Gray50" , PALETTERGB (127,127,127)}, + {"Grey50" , PALETTERGB (127,127,127)}, + {"chartreuse" , PALETTERGB (127,255, 0)}, + {"chartreuse1" , PALETTERGB (127,255, 0)}, + {"aquamarine1" , PALETTERGB (127,255,212)}, + {"Gray51" , PALETTERGB (130,130,130)}, + {"Grey51" , PALETTERGB (130,130,130)}, + {"SlateBlue1" , PALETTERGB (131,111,255)}, + {"honeydew4" , PALETTERGB (131,139,131)}, + {"azure4" , PALETTERGB (131,139,139)}, + {"LightSlateBlue" , PALETTERGB (132,112,255)}, + {"Gray52" , PALETTERGB (133,133,133)}, + {"Grey52" , PALETTERGB (133,133,133)}, + {"Gray53" , PALETTERGB (135,135,135)}, + {"Grey53" , PALETTERGB (135,135,135)}, + {"LightSkyBlue" , PALETTERGB (135,206,250)}, + {"SkyBlue1" , PALETTERGB (135,206,255)}, + {"MediumPurple3" , PALETTERGB (137,104,205)}, + {"BlueViolet" , PALETTERGB (138, 43,226)}, + {"Gray54" , PALETTERGB (138,138,138)}, + {"Grey54" , PALETTERGB (138,138,138)}, + {"red4" , PALETTERGB (139, 0, 0)}, + {"magenta4" , PALETTERGB (139, 0,139)}, + {"DeepPink4" , PALETTERGB (139, 10, 80)}, + {"firebrick4" , PALETTERGB (139, 26, 26)}, + {"maroon4" , PALETTERGB (139, 28, 98)}, + {"DarkOrchid" , PALETTERGB (139, 32,139)}, + {"VioletRed4" , PALETTERGB (139, 34, 82)}, + {"brown4" , PALETTERGB (139, 35, 35)}, + {"OrangeRed4" , PALETTERGB (139, 37, 0)}, + {"tomato4" , PALETTERGB (139, 54, 38)}, + {"IndianRed4" , PALETTERGB (139, 58, 58)}, + {"HotPink4" , PALETTERGB (139, 58, 98)}, + {"coral4" , PALETTERGB (139, 62, 47)}, + {"DarkOrange4" , PALETTERGB (139, 69, 0)}, + {"SaddleBrown" , PALETTERGB (139, 69, 19)}, + {"chocolate4" , PALETTERGB (139, 69, 19)}, + {"sienna4" , PALETTERGB (139, 71, 38)}, + {"PaleVioletRed4" , PALETTERGB (139, 71, 93)}, + {"orchid4" , PALETTERGB (139, 71,137)}, + {"salmon4" , PALETTERGB (139, 76, 57)}, + {"LightSalmon4" , PALETTERGB (139, 87, 66)}, + {"orange4" , PALETTERGB (139, 90, 0)}, + {"tan4" , PALETTERGB (139, 90, 43)}, + {"LightPink4" , PALETTERGB (139, 95,101)}, + {"pink4" , PALETTERGB (139, 99,108)}, + {"DarkGoldenrod4" , PALETTERGB (139,101, 8)}, + {"plum4" , PALETTERGB (139,102,139)}, + {"goldenrod4" , PALETTERGB (139,105, 20)}, + {"RosyBrown4" , PALETTERGB (139,105,105)}, + {"burlywood4" , PALETTERGB (139,115, 85)}, + {"gold4" , PALETTERGB (139,117, 0)}, + {"PeachPuff4" , PALETTERGB (139,119,101)}, + {"NavajoWhite4" , PALETTERGB (139,121, 94)}, + {"thistle4" , PALETTERGB (139,123,139)}, + {"bisque4" , PALETTERGB (139,125,107)}, + {"MistyRose4" , PALETTERGB (139,125,123)}, + {"wheat4" , PALETTERGB (139,126,102)}, + {"LightGoldenrod4" , PALETTERGB (139,129, 76)}, + {"AntiqueWhite4" , PALETTERGB (139,131,120)}, + {"LavenderBlush4" , PALETTERGB (139,131,134)}, + {"khaki4" , PALETTERGB (139,134, 78)}, + {"seashell4" , PALETTERGB (139,134,130)}, + {"cornsilk4" , PALETTERGB (139,136,120)}, + {"LemonChiffon4" , PALETTERGB (139,137,112)}, + {"snow4" , PALETTERGB (139,137,137)}, + {"yellow4" , PALETTERGB (139,139, 0)}, + {"LightYellow4" , PALETTERGB (139,139,122)}, + {"ivory4" , PALETTERGB (139,139,131)}, + {"Gray55" , PALETTERGB (140,140,140)}, + {"Grey55" , PALETTERGB (140,140,140)}, + {"LightSkyBlue3" , PALETTERGB (141,182,205)}, + {"DarkSlateGray2" , PALETTERGB (141,238,238)}, + {"Firebrick" , PALETTERGB (142, 35, 35)}, + {"CadetBlue2" , PALETTERGB (142,229,238)}, + {"Maroon" , PALETTERGB (143, 0, 82)}, + {"Gray56" , PALETTERGB (143,143,143)}, + {"Grey56" , PALETTERGB (143,143,143)}, + {"DarkSeaGreen" , PALETTERGB (143,188,143)}, + {"PaleGreen2" , PALETTERGB (144,238,144)}, + {"purple2" , PALETTERGB (145, 44,238)}, + {"Gray57" , PALETTERGB (145,145,145)}, + {"Grey57" , PALETTERGB (145,145,145)}, + {"MediumPurple" , PALETTERGB (147,112,219)}, + {"DarkViolet" , PALETTERGB (148, 0,211)}, + {"Gray58" , PALETTERGB (148,148,148)}, + {"Grey58" , PALETTERGB (148,148,148)}, + {"Sienna" , PALETTERGB (150, 82, 45)}, + {"Gray59" , PALETTERGB (150,150,150)}, + {"Grey59" , PALETTERGB (150,150,150)}, + {"PaleTurquoise3" , PALETTERGB (150,205,205)}, + {"DarkSlateGray1" , PALETTERGB (151,255,255)}, + {"CadetBlue1" , PALETTERGB (152,245,255)}, + {"Gray60" , PALETTERGB (153,153,153)}, + {"Grey60" , PALETTERGB (153,153,153)}, + {"DarkOrchid3" , PALETTERGB (154, 50,205)}, + {"LightBlue3" , PALETTERGB (154,192,205)}, + {"OliveDrab3" , PALETTERGB (154,205, 50)}, + {"PaleGreen1" , PALETTERGB (154,255,154)}, + {"purple1" , PALETTERGB (155, 48,255)}, + {"DarkSeaGreen3" , PALETTERGB (155,205,155)}, + {"Violet" , PALETTERGB (156, 62,206)}, + {"Gray61" , PALETTERGB (156,156,156)}, + {"Grey61" , PALETTERGB (156,156,156)}, + {"Gray62" , PALETTERGB (158,158,158)}, + {"Grey62" , PALETTERGB (158,158,158)}, + {"MediumPurple2" , PALETTERGB (159,121,238)}, + {"SlateGray3" , PALETTERGB (159,182,205)}, + {"purple" , PALETTERGB (160, 32,240)}, + {"Gray63" , PALETTERGB (161,161,161)}, + {"Grey63" , PALETTERGB (161,161,161)}, + {"LightSteelBlue3" , PALETTERGB (162,181,205)}, + {"DarkOliveGreen3" , PALETTERGB (162,205, 90)}, + {"Gray64" , PALETTERGB (163,163,163)}, + {"Grey64" , PALETTERGB (163,163,163)}, + {"LightSkyBlue2" , PALETTERGB (164,211,238)}, + {"Brown" , PALETTERGB (165, 42, 42)}, + {"Gray65" , PALETTERGB (166,166,166)}, + {"Grey65" , PALETTERGB (166,166,166)}, + {"Gray66" , PALETTERGB (168,168,168)}, + {"Grey66" , PALETTERGB (168,168,168)}, + {"LightGray" , PALETTERGB (168,168,168)}, + {"LightGrey" , PALETTERGB (168,168,168)}, + {"MediumPurple1" , PALETTERGB (171,130,255)}, + {"Gray67" , PALETTERGB (171,171,171)}, + {"Grey67" , PALETTERGB (171,171,171)}, + {"Gray68" , PALETTERGB (173,173,173)}, + {"Grey68" , PALETTERGB (173,173,173)}, + {"LightBlue" , PALETTERGB (173,216,230)}, + {"GreenYellow" , PALETTERGB (173,255, 47)}, + {"PaleTurquoise2" , PALETTERGB (174,238,238)}, + {"PaleTurquoise" , PALETTERGB (175,238,238)}, + {"Gray69" , PALETTERGB (176,176,176)}, + {"Grey69" , PALETTERGB (176,176,176)}, + {"PowderBlue" , PALETTERGB (176,224,230)}, + {"LightSkyBlue1" , PALETTERGB (176,226,255)}, + {"DarkOrchid2" , PALETTERGB (178, 58,238)}, + {"LightBlue2" , PALETTERGB (178,223,238)}, + {"Khaki" , PALETTERGB (179,179,126)}, + {"Gray70" , PALETTERGB (179,179,179)}, + {"Grey70" , PALETTERGB (179,179,179)}, + {"OliveDrab2" , PALETTERGB (179,238, 58)}, + {"MediumOrchid3" , PALETTERGB (180, 82,205)}, + {"LightCyan3" , PALETTERGB (180,205,205)}, + {"DarkSeaGreen2" , PALETTERGB (180,238,180)}, + {"Gray71" , PALETTERGB (181,181,181)}, + {"Grey71" , PALETTERGB (181,181,181)}, + {"DarkGoldenrod" , PALETTERGB (184,134, 11)}, + {"Gray72" , PALETTERGB (184,184,184)}, + {"Grey72" , PALETTERGB (184,184,184)}, + {"SlateGray2" , PALETTERGB (185,211,238)}, + {"MediumOrchid" , PALETTERGB (186, 85,211)}, + {"Gray73" , PALETTERGB (186,186,186)}, + {"Grey73" , PALETTERGB (186,186,186)}, + {"PaleTurquoise1" , PALETTERGB (187,255,255)}, + {"RosyBrown" , PALETTERGB (188,143,143)}, + {"LightSteelBlue2" , PALETTERGB (188,210,238)}, + {"DarkOliveGreen2" , PALETTERGB (188,238,104)}, + {"DarkKhaki" , PALETTERGB (189,183,107)}, + {"Gray74" , PALETTERGB (189,189,189)}, + {"Grey74" , PALETTERGB (189,189,189)}, + {"DarkOrchid1" , PALETTERGB (191, 62,255)}, + {"Gray75" , PALETTERGB (191,191,191)}, + {"Grey75" , PALETTERGB (191,191,191)}, + {"LightBlue1" , PALETTERGB (191,239,255)}, + {"OliveDrab1" , PALETTERGB (192,255, 62)}, + {"honeydew3" , PALETTERGB (193,205,193)}, + {"azure3" , PALETTERGB (193,205,205)}, + {"DarkSeaGreen1" , PALETTERGB (193,255,193)}, + {"Gray76" , PALETTERGB (194,194,194)}, + {"Grey76" , PALETTERGB (194,194,194)}, + {"Gray77" , PALETTERGB (196,196,196)}, + {"Grey77" , PALETTERGB (196,196,196)}, + {"Plum" , PALETTERGB (197, 72,155)}, + {"SlateGray1" , PALETTERGB (198,226,255)}, + {"MediumVioletRed" , PALETTERGB (199, 21,133)}, + {"Gray78" , PALETTERGB (199,199,199)}, + {"Grey78" , PALETTERGB (199,199,199)}, + {"Gray79" , PALETTERGB (201,201,201)}, + {"Grey79" , PALETTERGB (201,201,201)}, + {"LightSteelBlue1" , PALETTERGB (202,225,255)}, + {"DarkOliveGreen1" , PALETTERGB (202,255,112)}, + {"Gray80" , PALETTERGB (204,204,204)}, + {"Grey80" , PALETTERGB (204,204,204)}, + {"red3" , PALETTERGB (205, 0, 0)}, + {"magenta3" , PALETTERGB (205, 0,205)}, + {"DeepPink3" , PALETTERGB (205, 16,118)}, + {"firebrick3" , PALETTERGB (205, 38, 38)}, + {"maroon3" , PALETTERGB (205, 41,144)}, + {"VioletRed3" , PALETTERGB (205, 50,120)}, + {"brown3" , PALETTERGB (205, 51, 51)}, + {"OrangeRed3" , PALETTERGB (205, 55, 0)}, + {"tomato3" , PALETTERGB (205, 79, 57)}, + {"IndianRed3" , PALETTERGB (205, 85, 85)}, + {"coral3" , PALETTERGB (205, 91, 69)}, + {"HotPink3" , PALETTERGB (205, 96,144)}, + {"DarkOrange3" , PALETTERGB (205,102, 0)}, + {"chocolate3" , PALETTERGB (205,102, 29)}, + {"sienna3" , PALETTERGB (205,104, 57)}, + {"PaleVioletRed3" , PALETTERGB (205,104,137)}, + {"orchid3" , PALETTERGB (205,105,201)}, + {"salmon3" , PALETTERGB (205,112, 84)}, + {"LightSalmon3" , PALETTERGB (205,129, 98)}, + {"orange3" , PALETTERGB (205,133, 0)}, + {"peru" , PALETTERGB (205,133, 63)}, + {"tan3" , PALETTERGB (205,133, 63)}, + {"LightPink3" , PALETTERGB (205,140,149)}, + {"pink3" , PALETTERGB (205,145,158)}, + {"DarkGoldenrod3" , PALETTERGB (205,149, 12)}, + {"plum3" , PALETTERGB (205,150,205)}, + {"goldenrod3" , PALETTERGB (205,155, 29)}, + {"RosyBrown3" , PALETTERGB (205,155,155)}, + {"burlywood3" , PALETTERGB (205,170,125)}, + {"gold3" , PALETTERGB (205,173, 0)}, + {"PeachPuff3" , PALETTERGB (205,175,149)}, + {"NavajoWhite3" , PALETTERGB (205,179,139)}, + {"thistle3" , PALETTERGB (205,181,205)}, + {"bisque3" , PALETTERGB (205,183,158)}, + {"MistyRose3" , PALETTERGB (205,183,181)}, + {"wheat3" , PALETTERGB (205,186,150)}, + {"LightGoldenrod3" , PALETTERGB (205,190,112)}, + {"AntiqueWhite3" , PALETTERGB (205,192,176)}, + {"LavenderBlush3" , PALETTERGB (205,193,197)}, + {"seashell3" , PALETTERGB (205,197,191)}, + {"khaki3" , PALETTERGB (205,198,115)}, + {"cornsilk3" , PALETTERGB (205,200,177)}, + {"LemonChiffon3" , PALETTERGB (205,201,165)}, + {"snow3" , PALETTERGB (205,201,201)}, + {"yellow3" , PALETTERGB (205,205, 0)}, + {"LightYellow3" , PALETTERGB (205,205,180)}, + {"ivory3" , PALETTERGB (205,205,193)}, + {"Gray81" , PALETTERGB (207,207,207)}, + {"Grey81" , PALETTERGB (207,207,207)}, + {"VioletRed" , PALETTERGB (208, 32,144)}, + {"MediumOrchid2" , PALETTERGB (209, 95,238)}, + {"MediumGoldenrod" , PALETTERGB (209,193,102)}, + {"Gray82" , PALETTERGB (209,209,209)}, + {"Grey82" , PALETTERGB (209,209,209)}, + {"LightCyan2" , PALETTERGB (209,238,238)}, + {"chocolate" , PALETTERGB (210,105, 30)}, + {"tan" , PALETTERGB (210,180,140)}, + {"Gray83" , PALETTERGB (212,212,212)}, + {"Grey83" , PALETTERGB (212,212,212)}, + {"Gray84" , PALETTERGB (214,214,214)}, + {"Grey84" , PALETTERGB (214,214,214)}, + {"Thistle" , PALETTERGB (216,191,216)}, + {"Gray85" , PALETTERGB (217,217,217)}, + {"Grey85" , PALETTERGB (217,217,217)}, + {"orchid" , PALETTERGB (218,112,214)}, + {"goldenrod" , PALETTERGB (218,165, 32)}, + {"Gold" , PALETTERGB (218,170, 0)}, + {"PaleVioletRed" , PALETTERGB (219,112,147)}, + {"Gray86" , PALETTERGB (219,219,219)}, + {"Grey86" , PALETTERGB (219,219,219)}, + {"Crimson" , PALETTERGB (220, 20, 60)}, + {"gainsboro" , PALETTERGB (220,220,220)}, + {"burlywood" , PALETTERGB (222,184,135)}, + {"Gray87" , PALETTERGB (222,222,222)}, + {"Grey87" , PALETTERGB (222,222,222)}, + {"MediumOrchid1" , PALETTERGB (224,102,255)}, + {"Gray88" , PALETTERGB (224,224,224)}, + {"Grey88" , PALETTERGB (224,224,224)}, + {"honeydew2" , PALETTERGB (224,238,224)}, + {"azure2" , PALETTERGB (224,238,238)}, + {"LightCyan" , PALETTERGB (224,255,255)}, + {"LightCyan1" , PALETTERGB (224,255,255)}, + {"Gray89" , PALETTERGB (227,227,227)}, + {"Grey89" , PALETTERGB (227,227,227)}, + {"Gray90" , PALETTERGB (229,229,229)}, + {"Grey90" , PALETTERGB (229,229,229)}, + {"lavender" , PALETTERGB (230,230,250)}, + {"Gray91" , PALETTERGB (232,232,232)}, + {"Grey91" , PALETTERGB (232,232,232)}, + {"DarkSalmon" , PALETTERGB (233,150,122)}, + {"Salmon" , PALETTERGB (233,150,122)}, + {"Gray92" , PALETTERGB (235,235,235)}, + {"Grey92" , PALETTERGB (235,235,235)}, + {"Gray93" , PALETTERGB (237,237,237)}, + {"Grey93" , PALETTERGB (237,237,237)}, + {"red2" , PALETTERGB (238, 0, 0)}, + {"magenta2" , PALETTERGB (238, 0,238)}, + {"DeepPink2" , PALETTERGB (238, 18,137)}, + {"firebrick2" , PALETTERGB (238, 44, 44)}, + {"maroon2" , PALETTERGB (238, 48,167)}, + {"VioletRed2" , PALETTERGB (238, 58,140)}, + {"brown2" , PALETTERGB (238, 59, 59)}, + {"OrangeRed2" , PALETTERGB (238, 64, 0)}, + {"tomato2" , PALETTERGB (238, 92, 66)}, + {"IndianRed2" , PALETTERGB (238, 99, 99)}, + {"coral2" , PALETTERGB (238,106, 80)}, + {"HotPink2" , PALETTERGB (238,106,167)}, + {"DarkOrange2" , PALETTERGB (238,118, 0)}, + {"chocolate2" , PALETTERGB (238,118, 33)}, + {"sienna2" , PALETTERGB (238,121, 66)}, + {"PaleVioletRed2" , PALETTERGB (238,121,159)}, + {"orchid2" , PALETTERGB (238,122,233)}, + {"salmon2" , PALETTERGB (238,130, 98)}, + {"LightSalmon2" , PALETTERGB (238,149,114)}, + {"orange2" , PALETTERGB (238,154, 0)}, + {"tan2" , PALETTERGB (238,154, 73)}, + {"LightPink2" , PALETTERGB (238,162,173)}, + {"pink2" , PALETTERGB (238,169,184)}, + {"DarkGoldenrod2" , PALETTERGB (238,173, 14)}, + {"plum2" , PALETTERGB (238,174,238)}, + {"goldenrod2" , PALETTERGB (238,180, 34)}, + {"RosyBrown2" , PALETTERGB (238,180,180)}, + {"burlywood2" , PALETTERGB (238,197,145)}, + {"gold2" , PALETTERGB (238,201, 0)}, + {"PeachPuff2" , PALETTERGB (238,203,173)}, + {"NavajoWhite2" , PALETTERGB (238,207,161)}, + {"thistle2" , PALETTERGB (238,210,238)}, + {"bisque2" , PALETTERGB (238,213,183)}, + {"MistyRose2" , PALETTERGB (238,213,210)}, + {"wheat2" , PALETTERGB (238,216,174)}, + {"LightGoldenrod2" , PALETTERGB (238,220,130)}, + {"LightGoldenrod" , PALETTERGB (238,221,130)}, + {"AntiqueWhite2" , PALETTERGB (238,223,204)}, + {"LavenderBlush2" , PALETTERGB (238,224,229)}, + {"seashell2" , PALETTERGB (238,229,222)}, + {"khaki2" , PALETTERGB (238,230,133)}, + {"PaleGoldenrod" , PALETTERGB (238,232,170)}, + {"cornsilk2" , PALETTERGB (238,232,205)}, + {"LemonChiffon2" , PALETTERGB (238,233,191)}, + {"snow2" , PALETTERGB (238,233,233)}, + {"yellow2" , PALETTERGB (238,238, 0)}, + {"LightYellow2" , PALETTERGB (238,238,209)}, + {"ivory2" , PALETTERGB (238,238,224)}, + {"LightCoral" , PALETTERGB (240,128,128)}, + {"Gray94" , PALETTERGB (240,240,240)}, + {"Grey94" , PALETTERGB (240,240,240)}, + {"AliceBlue" , PALETTERGB (240,248,255)}, + {"honeydew" , PALETTERGB (240,255,240)}, + {"honeydew1" , PALETTERGB (240,255,240)}, + {"azure" , PALETTERGB (240,255,255)}, + {"azure1" , PALETTERGB (240,255,255)}, + {"Gray95" , PALETTERGB (242,242,242)}, + {"Grey95" , PALETTERGB (242,242,242)}, + {"SandyBrown" , PALETTERGB (244,164, 96)}, + {"Wheat" , PALETTERGB (245,222,179)}, + {"beige" , PALETTERGB (245,245,220)}, + {"Gray96" , PALETTERGB (245,245,245)}, + {"Grey96" , PALETTERGB (245,245,245)}, + {"WhiteSmoke" , PALETTERGB (245,245,245)}, + {"MintCream" , PALETTERGB (245,255,250)}, + {"Gray97" , PALETTERGB (247,247,247)}, + {"Grey97" , PALETTERGB (247,247,247)}, + {"GhostWhite" , PALETTERGB (248,248,255)}, + {"AntiqueWhite" , PALETTERGB (250,235,215)}, + {"linen" , PALETTERGB (250,240,230)}, + {"LightGoldenrodYellow" , PALETTERGB (250,250,210)}, + {"Gray98" , PALETTERGB (250,250,250)}, + {"Grey98" , PALETTERGB (250,250,250)}, + {"Gray99" , PALETTERGB (252,252,252)}, + {"Grey99" , PALETTERGB (252,252,252)}, + {"OldLace" , PALETTERGB (253,245,230)}, + {"Red" , PALETTERGB (255, 0, 0)}, + {"red1" , PALETTERGB (255, 0, 0)}, + {"Magenta" , PALETTERGB (255, 0,255)}, + {"magenta1" , PALETTERGB (255, 0,255)}, + {"DeepPink" , PALETTERGB (255, 20,147)}, + {"DeepPink1" , PALETTERGB (255, 20,147)}, + {"firebrick1" , PALETTERGB (255, 48, 48)}, + {"maroon1" , PALETTERGB (255, 52,179)}, + {"VioletRed1" , PALETTERGB (255, 62,150)}, + {"brown1" , PALETTERGB (255, 64, 64)}, + {"OrangeRed" , PALETTERGB (255, 69, 0)}, + {"OrangeRed1" , PALETTERGB (255, 69, 0)}, + {"tomato" , PALETTERGB (255, 99, 71)}, + {"tomato1" , PALETTERGB (255, 99, 71)}, + {"HotPink" , PALETTERGB (255,105,180)}, + {"IndianRed1" , PALETTERGB (255,106,106)}, + {"HotPink1" , PALETTERGB (255,110,180)}, + {"Coral" , PALETTERGB (255,114, 86)}, + {"coral1" , PALETTERGB (255,114, 86)}, + {"DarkOrange1" , PALETTERGB (255,127, 0)}, + {"chocolate1" , PALETTERGB (255,127, 36)}, + {"sienna1" , PALETTERGB (255,130, 71)}, + {"PaleVioletRed1" , PALETTERGB (255,130,171)}, + {"orchid1" , PALETTERGB (255,131,250)}, + {"Orange" , PALETTERGB (255,135, 0)}, + {"DarkOrange" , PALETTERGB (255,140, 0)}, + {"salmon1" , PALETTERGB (255,140,105)}, + {"LightSalmon" , PALETTERGB (255,160,122)}, + {"LightSalmon1" , PALETTERGB (255,160,122)}, + {"orange1" , PALETTERGB (255,165, 0)}, + {"tan1" , PALETTERGB (255,165, 79)}, + {"LightPink1" , PALETTERGB (255,174,185)}, + {"Pink" , PALETTERGB (255,181,197)}, + {"pink1" , PALETTERGB (255,181,197)}, + {"LightPink" , PALETTERGB (255,182,193)}, + {"DarkGoldenrod1" , PALETTERGB (255,185, 15)}, + {"plum1" , PALETTERGB (255,187,255)}, + {"goldenrod1" , PALETTERGB (255,193, 37)}, + {"RosyBrown1" , PALETTERGB (255,193,193)}, + {"burlywood1" , PALETTERGB (255,211,155)}, + {"gold1" , PALETTERGB (255,215, 0)}, + {"PeachPuff" , PALETTERGB (255,218,185)}, + {"PeachPuff1" , PALETTERGB (255,218,185)}, + {"NavajoWhite" , PALETTERGB (255,222,173)}, + {"NavajoWhite1" , PALETTERGB (255,222,173)}, + {"thistle1" , PALETTERGB (255,225,255)}, + {"moccasin" , PALETTERGB (255,228,181)}, + {"bisque" , PALETTERGB (255,228,196)}, + {"bisque1" , PALETTERGB (255,228,196)}, + {"MistyRose" , PALETTERGB (255,228,225)}, + {"MistyRose1" , PALETTERGB (255,228,225)}, + {"wheat1" , PALETTERGB (255,231,186)}, + {"BlanchedAlmond" , PALETTERGB (255,235,205)}, + {"LightGoldenrod1" , PALETTERGB (255,236,139)}, + {"PapayaWhip" , PALETTERGB (255,239,213)}, + {"AntiqueWhite1" , PALETTERGB (255,239,219)}, + {"LavenderBlush" , PALETTERGB (255,240,245)}, + {"LavenderBlush1" , PALETTERGB (255,240,245)}, + {"seashell" , PALETTERGB (255,245,238)}, + {"seashell1" , PALETTERGB (255,245,238)}, + {"khaki1" , PALETTERGB (255,246,143)}, + {"cornsilk" , PALETTERGB (255,248,220)}, + {"cornsilk1" , PALETTERGB (255,248,220)}, + {"LemonChiffon" , PALETTERGB (255,250,205)}, + {"LemonChiffon1" , PALETTERGB (255,250,205)}, + {"FloralWhite" , PALETTERGB (255,250,240)}, + {"snow" , PALETTERGB (255,250,250)}, + {"snow1" , PALETTERGB (255,250,250)}, + {"Yellow" , PALETTERGB (255,255, 0)}, + {"yellow1" , PALETTERGB (255,255, 0)}, + {"LightYellow" , PALETTERGB (255,255,224)}, + {"LightYellow1" , PALETTERGB (255,255,224)}, + {"ivory" , PALETTERGB (255,255,240)}, + {"ivory1" , PALETTERGB (255,255,240)}, + {"Gray100" , PALETTERGB (255,255,255)}, + {"Grey100" , PALETTERGB (255,255,255)}, + {"White" , PALETTERGB (255,255,255)} +}; + +static COLORREF +mswindows_string_to_color(CONST char *name) +{ + int color, i; + + if (*name == '#') + { + /* mswindows numeric names look like "#BBGGRR" */ + if (strlen(name)!=7) + return (-1); + for (i=1; i<7; i++) + if (!isxdigit(name[i])) + return(-1); + if (sscanf(name+1, "%x", &color) == 1) + return(0x02000000 | color); /* See PALETTERGB in docs */ + } + else + { + for(i=0; i<(sizeof(mswindows_X_color_map)/sizeof(colormap_t)); i++) + if (!stricmp(name, mswindows_X_color_map[i].name)) + return (mswindows_X_color_map[i].colorref); + } + return(-1); +} + +static int +mswindows_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name, + Lisp_Object device, Error_behavior errb) +{ + CONST char *extname; + COLORREF color; + + GET_C_STRING_CTEXT_DATA_ALLOCA (name, extname); + color = mswindows_string_to_color(extname); + if (color != -1) + { + c->data = xnew (struct mswindows_color_instance_data); + COLOR_INSTANCE_MSWINDOWS_COLOR (c) = color; + COLOR_INSTANCE_MSWINDOWS_BRUSH (c) = CreateSolidBrush (color); + return 1; + } + maybe_signal_simple_error ("unrecognized color", name, Qcolor, errb); + return(0); +} + +static void +mswindows_mark_color_instance (struct Lisp_Color_Instance *c, + void (*markobj) (Lisp_Object)) +{ +} + +static void +mswindows_print_color_instance (struct Lisp_Color_Instance *c, + Lisp_Object printcharfun, + int escapeflag) +{ + char buf[32]; + COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c); + sprintf (buf, " %06ld=(%02X,%02X,%02X)", color & 0xffffff, + GetRValue(color), GetGValue(color), GetBValue(color)); + write_c_string (buf, printcharfun); +} + +static void +mswindows_finalize_color_instance (struct Lisp_Color_Instance *c) +{ + if (c->data) + { + DeleteObject (COLOR_INSTANCE_MSWINDOWS_BRUSH (c)); + xfree (c->data); + c->data = 0; + } +} + +static int +mswindows_color_instance_equal (struct Lisp_Color_Instance *c1, + struct Lisp_Color_Instance *c2, + int depth) +{ + return (COLOR_INSTANCE_MSWINDOWS_COLOR(c1) == COLOR_INSTANCE_MSWINDOWS_COLOR(c2)); +} + +static unsigned long +mswindows_color_instance_hash (struct Lisp_Color_Instance *c, int depth) +{ + return LISP_HASH (COLOR_INSTANCE_MSWINDOWS_COLOR(c)); +} + +static Lisp_Object +mswindows_color_instance_rgb_components (struct Lisp_Color_Instance *c) +{ + COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c); + return (list3 (make_int (GetRValue(color)), + make_int (GetGValue(color)), + make_int (GetBValue(color)))); +} + +static int +mswindows_valid_color_name_p (struct device *d, Lisp_Object color) +{ + CONST char *extname; + + GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname); + return (mswindows_string_to_color(extname)!=-1); +} + + + +static void +mswindows_finalize_font_instance (struct Lisp_Font_Instance *f) +{ + if (f->data) + { + DeleteObject(f->data); + f->data=0; + } +} + +static int +mswindows_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name, + Lisp_Object device, Error_behavior errb) +{ + CONST char *extname; + LOGFONT logfont; + int fields; + int pt; + char fontname[LF_FACESIZE], weight[32], *style, points[8], effects[32], charset[32]; + + GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname); + + /* + * mswindows fonts look like: + * fontname[:[weight ][style][:pointsize[:effects[:charset]]]] + * The font name field shouldn't be empty. + * XXX Windows will substitute a default (monospace) font if the font name + * specifies a non-existent font. We don't catch this. + * effects and charset are currently ignored. + * + * ie: + * Lucida Console:Regular:10 + * minimal: + * Courier New + * maximal: + * Courier New:Bold Italic:10:underline strikeout:ansi + */ + fields = sscanf (extname, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s", + fontname, weight, points, effects, charset); + + if (fields<0) + { + maybe_signal_simple_error ("Invalid font", f->name, Qfont, errb); + return (0); + } + + if (fields>0 && strlen(fontname)) + { + strncpy (logfont.lfFaceName, fontname, LF_FACESIZE); + logfont.lfFaceName[LF_FACESIZE-1] = 0; + } + else + { + maybe_signal_simple_error ("Must specify a font name", f->name, Qfont, errb); + return (0); + } + + if (fields > 1 && strlen(weight)) + { + char *c; + /* Maybe split weight into weight and style */ + if (c=strchr(weight, ' ')) + { + *c = '\0'; + style = c+1; + } + else + style = NULL; + + /* weight: Most-often used (maybe) first */ + if (stricmp (weight,"regular") == 0) + logfont.lfWeight = FW_REGULAR; + else if (stricmp (weight,"normal") == 0) + logfont.lfWeight = FW_NORMAL; + else if (stricmp (weight,"bold") == 0) + logfont.lfWeight = FW_BOLD; + else if (stricmp (weight,"medium") == 0) + logfont.lfWeight = FW_MEDIUM; + else if (stricmp (weight,"italic") == 0) /* Hack for early exit */ + { + logfont.lfWeight = FW_NORMAL; + style=weight; + } + /* the rest */ + else if (stricmp (weight,"black") == 0) + logfont.lfWeight = FW_BLACK; + else if (stricmp (weight,"heavy") == 0) + logfont.lfWeight = FW_HEAVY; + else if (stricmp (weight,"ultrabold") == 0) + logfont.lfWeight = FW_ULTRABOLD; + else if (stricmp (weight,"extrabold") == 0) + logfont.lfWeight = FW_EXTRABOLD; + else if (stricmp (weight,"demibold") == 0) + logfont.lfWeight = FW_SEMIBOLD; + else if (stricmp (weight,"semibold") == 0) + logfont.lfWeight = FW_SEMIBOLD; + else if (stricmp (weight,"light") == 0) + logfont.lfWeight = FW_LIGHT; + else if (stricmp (weight,"ultralight") == 0) + logfont.lfWeight = FW_ULTRALIGHT; + else if (stricmp (weight,"extralight") == 0) + logfont.lfWeight = FW_EXTRALIGHT; + else if (stricmp (weight,"thin") == 0) + logfont.lfWeight = FW_THIN; + else + { + logfont.lfWeight = FW_NORMAL; + if (!style) + style = weight; /* May have specified a style without a weight */ + else + { + maybe_signal_simple_error ("Invalid font weight", f->name, Qfont, errb); + return (0); /* Invalid weight */ + } + } + + if (style) + { + /* XXX what about oblique? */ + if (stricmp (style,"italic") == 0) + logfont.lfItalic = TRUE; + else if (stricmp (style,"roman") == 0) + logfont.lfItalic = FALSE; + else + { + maybe_signal_simple_error ("Invalid font weight or style", f->name, Qfont, errb); + return (0); /* Invalid weight or style */ + } + } + else + { + logfont.lfItalic = FALSE; + } + + } + else + { + logfont.lfWeight = FW_NORMAL; + logfont.lfItalic = FALSE; + } + + /* XXX Should we reject strings that don't specify a size? */ + if (fields < 3 || !strlen(points) || (pt=atoi(points))==0) + pt = 10; + + /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */ + logfont.lfHeight = -MulDiv(pt, DEVICE_MSWINDOWS_LOGPIXELSY(XDEVICE (device)), 72); + logfont.lfWidth = 0; + + /* Default to monospaced if the specified font name is not found */ + logfont.lfPitchAndFamily = FF_MODERN; + + /* XXX: FIXME? */ + logfont.lfUnderline = FALSE; + logfont.lfStrikeOut = FALSE; + + /* XXX: FIXME: we ignore charset */ + logfont.lfCharSet = DEFAULT_CHARSET; + + /* Misc crud */ + logfont.lfEscapement = logfont.lfOrientation = 0; +#if 1 + logfont.lfOutPrecision = OUT_DEFAULT_PRECIS; + logfont.lfClipPrecision = CLIP_DEFAULT_PRECIS; + logfont.lfQuality = DEFAULT_QUALITY; +#else + logfont.lfOutPrecision = OUT_STROKE_PRECIS; + logfont.lfClipPrecision = CLIP_STROKE_PRECIS; + logfont.lfQuality = PROOF_QUALITY; +#endif + + if ((f->data = CreateFontIndirect(&logfont)) == NULL) + { + maybe_signal_simple_error ("Couldn't create font", f->name, Qfont, errb); + return 0; + } + + /* Have to apply Font to a GC to get its values. + * We'll borrow the desktop window becuase its the only window that we + * know about that is guaranteed to exist when this gets called + */ + { + HWND hwnd; + HDC hdc; + HFONT holdfont; + TEXTMETRIC metrics; + + hwnd = GetDesktopWindow(); + assert(hdc = GetDC(hwnd)); /* XXX FIXME: can this temporarily fail? */ + holdfont = SelectObject(hdc, f->data); + if (!holdfont) + { + mswindows_finalize_font_instance (f); + maybe_signal_simple_error ("Couldn't map font", f->name, Qfont, errb); + return 0; + } + GetTextMetrics(hdc, &metrics); + SelectObject(hdc, holdfont); + ReleaseDC(hwnd, hdc); + f->width = metrics.tmAveCharWidth; + f->height = metrics.tmHeight; + f->ascent = metrics.tmAscent; + f->descent = metrics.tmDescent; + f->proportional_p = (metrics.tmPitchAndFamily & TMPF_FIXED_PITCH); + } + + return 1; +} + +static void +mswindows_mark_font_instance (struct Lisp_Font_Instance *f, + void (*markobj) (Lisp_Object)) +{ +} + +static void +mswindows_print_font_instance (struct Lisp_Font_Instance *f, + Lisp_Object printcharfun, + int escapeflag) +{ +} + +static Lisp_Object +mswindows_list_fonts (Lisp_Object pattern, Lisp_Object device) +{ + /* XXX Implement me */ + return list1 (build_string ("Courier New:Regular:10")); +} + + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_objects_mswindows (void) +{ +} + +void +console_type_create_objects_mswindows (void) +{ + /* object methods */ + CONSOLE_HAS_METHOD (mswindows, initialize_color_instance); +/* CONSOLE_HAS_METHOD (mswindows, mark_color_instance); */ + CONSOLE_HAS_METHOD (mswindows, print_color_instance); + CONSOLE_HAS_METHOD (mswindows, finalize_color_instance); + CONSOLE_HAS_METHOD (mswindows, color_instance_equal); + CONSOLE_HAS_METHOD (mswindows, color_instance_hash); + CONSOLE_HAS_METHOD (mswindows, color_instance_rgb_components); + CONSOLE_HAS_METHOD (mswindows, valid_color_name_p); + + CONSOLE_HAS_METHOD (mswindows, initialize_font_instance); +/* CONSOLE_HAS_METHOD (mswindows, mark_font_instance); */ + CONSOLE_HAS_METHOD (mswindows, print_font_instance); + CONSOLE_HAS_METHOD (mswindows, finalize_font_instance); +/* CONSOLE_HAS_METHOD (mswindows, font_instance_truename); */ + CONSOLE_HAS_METHOD (mswindows, list_fonts); +#ifdef MULE + CONSOLE_HAS_METHOD (mswindows, font_spec_matches_charset); + CONSOLE_HAS_METHOD (mswindows, find_charset_font); +#endif +} + +void +vars_of_objects_mswindows (void) +{ +} diff -r d8688acf4c5b -r 78f53ef88e17 src/objects-msw.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/objects-msw.h Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,54 @@ +/* mswindows-specific Lisp objects. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Board of Trustees, University of Illinois. + Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1997, Jonathan Harris. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs 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 General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Ultimately based on FSF. + Rewritten by Ben Wing. + Rewritten for mswindows by Jonathan Harris, November 1997 for 20.4. + */ + + +#ifndef _XEMACS_OBJECTS_MSW_H_ +#define _XEMACS_OBJECTS_MSW_H_ + +#include "objects.h" + +struct mswindows_color_instance_data +{ + COLORREF color; + HBRUSH brush; +}; + +#define MSWINDOWS_COLOR_INSTANCE_DATA(c) \ + ((struct mswindows_color_instance_data *) (c)->data) +#define COLOR_INSTANCE_MSWINDOWS_COLOR(c) \ + (MSWINDOWS_COLOR_INSTANCE_DATA (c)->color) +#define COLOR_INSTANCE_MSWINDOWS_BRUSH(c) \ + (MSWINDOWS_COLOR_INSTANCE_DATA (c)->brush) + +#define FONT_INSTANCE_MSWINDOWS_HFONT(c) ((HFONT) (c)->data) + +#endif /* _XEMACS_OBJECTS_MSW_H_ */ diff -r d8688acf4c5b -r 78f53ef88e17 src/objects-w32.c --- a/src/objects-w32.c Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,679 +0,0 @@ -/* win32-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Tinker Systems. - Copyright (C) 1995, 1996 Ben Wing. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1997 Jonathan Harris. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Jamie Zawinski, Chuck Thompson, Ben Wing - Rewritten for win32 by Jonathan Harris, November 1997 for 20.4. - */ - - -/* TODO: palette handling */ - -#include -#include "lisp.h" - -#include "console-w32.h" -#include "objects-w32.h" - -#ifdef MULE -#include "mule-charset.h" -#endif - -#include "buffer.h" -#include "device.h" -#include "insdel.h" - -#include "windows.h" - -typedef struct colormap_t -{ - char *name; - COLORREF colorref; -} colormap_t; - -static colormap_t w32_X_color_map[] = -{ - {"snow" , PALETTERGB (255,250,250)}, - {"ghost white" , PALETTERGB (248,248,255)}, - {"GhostWhite" , PALETTERGB (248,248,255)}, - {"white smoke" , PALETTERGB (245,245,245)}, - {"WhiteSmoke" , PALETTERGB (245,245,245)}, - {"gainsboro" , PALETTERGB (220,220,220)}, - {"floral white" , PALETTERGB (255,250,240)}, - {"FloralWhite" , PALETTERGB (255,250,240)}, - {"old lace" , PALETTERGB (253,245,230)}, - {"OldLace" , PALETTERGB (253,245,230)}, - {"linen" , PALETTERGB (250,240,230)}, - {"antique white" , PALETTERGB (250,235,215)}, - {"AntiqueWhite" , PALETTERGB (250,235,215)}, - {"papaya whip" , PALETTERGB (255,239,213)}, - {"PapayaWhip" , PALETTERGB (255,239,213)}, - {"blanched almond" , PALETTERGB (255,235,205)}, - {"BlanchedAlmond" , PALETTERGB (255,235,205)}, - {"bisque" , PALETTERGB (255,228,196)}, - {"peach puff" , PALETTERGB (255,218,185)}, - {"PeachPuff" , PALETTERGB (255,218,185)}, - {"navajo white" , PALETTERGB (255,222,173)}, - {"NavajoWhite" , PALETTERGB (255,222,173)}, - {"moccasin" , PALETTERGB (255,228,181)}, - {"cornsilk" , PALETTERGB (255,248,220)}, - {"ivory" , PALETTERGB (255,255,240)}, - {"lemon chiffon" , PALETTERGB (255,250,205)}, - {"LemonChiffon" , PALETTERGB (255,250,205)}, - {"seashell" , PALETTERGB (255,245,238)}, - {"honeydew" , PALETTERGB (240,255,240)}, - {"mint cream" , PALETTERGB (245,255,250)}, - {"MintCream" , PALETTERGB (245,255,250)}, - {"azure" , PALETTERGB (240,255,255)}, - {"alice blue" , PALETTERGB (240,248,255)}, - {"AliceBlue" , PALETTERGB (240,248,255)}, - {"lavender" , PALETTERGB (230,230,250)}, - {"lavender blush" , PALETTERGB (255,240,245)}, - {"LavenderBlush" , PALETTERGB (255,240,245)}, - {"misty rose" , PALETTERGB (255,228,225)}, - {"MistyRose" , PALETTERGB (255,228,225)}, - {"white" , PALETTERGB (255,255,255)}, - {"black" , PALETTERGB ( 0, 0, 0)}, - {"dark slate gray" , PALETTERGB ( 47, 79, 79)}, - {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)}, - {"dark slate grey" , PALETTERGB ( 47, 79, 79)}, - {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)}, - {"dim gray" , PALETTERGB (105,105,105)}, - {"DimGray" , PALETTERGB (105,105,105)}, - {"dim grey" , PALETTERGB (105,105,105)}, - {"DimGrey" , PALETTERGB (105,105,105)}, - {"slate gray" , PALETTERGB (112,128,144)}, - {"SlateGray" , PALETTERGB (112,128,144)}, - {"slate grey" , PALETTERGB (112,128,144)}, - {"SlateGrey" , PALETTERGB (112,128,144)}, - {"light slate gray" , PALETTERGB (119,136,153)}, - {"LightSlateGray" , PALETTERGB (119,136,153)}, - {"light slate grey" , PALETTERGB (119,136,153)}, - {"LightSlateGrey" , PALETTERGB (119,136,153)}, - {"gray" , PALETTERGB (190,190,190)}, - {"grey" , PALETTERGB (190,190,190)}, - {"light grey" , PALETTERGB (211,211,211)}, - {"LightGrey" , PALETTERGB (211,211,211)}, - {"light gray" , PALETTERGB (211,211,211)}, - {"LightGray" , PALETTERGB (211,211,211)}, - {"midnight blue" , PALETTERGB ( 25, 25,112)}, - {"MidnightBlue" , PALETTERGB ( 25, 25,112)}, - {"navy" , PALETTERGB ( 0, 0,128)}, - {"navy blue" , PALETTERGB ( 0, 0,128)}, - {"NavyBlue" , PALETTERGB ( 0, 0,128)}, - {"cornflower blue" , PALETTERGB (100,149,237)}, - {"CornflowerBlue" , PALETTERGB (100,149,237)}, - {"dark slate blue" , PALETTERGB ( 72, 61,139)}, - {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)}, - {"slate blue" , PALETTERGB (106, 90,205)}, - {"SlateBlue" , PALETTERGB (106, 90,205)}, - {"medium slate blue" , PALETTERGB (123,104,238)}, - {"MediumSlateBlue" , PALETTERGB (123,104,238)}, - {"light slate blue" , PALETTERGB (132,112,255)}, - {"LightSlateBlue" , PALETTERGB (132,112,255)}, - {"medium blue" , PALETTERGB ( 0, 0,205)}, - {"MediumBlue" , PALETTERGB ( 0, 0,205)}, - {"royal blue" , PALETTERGB ( 65,105,225)}, - {"RoyalBlue" , PALETTERGB ( 65,105,225)}, - {"blue" , PALETTERGB ( 0, 0,255)}, - {"dodger blue" , PALETTERGB ( 30,144,255)}, - {"DodgerBlue" , PALETTERGB ( 30,144,255)}, - {"deep sky blue" , PALETTERGB ( 0,191,255)}, - {"DeepSkyBlue" , PALETTERGB ( 0,191,255)}, - {"sky blue" , PALETTERGB (135,206,235)}, - {"SkyBlue" , PALETTERGB (135,206,235)}, - {"light sky blue" , PALETTERGB (135,206,250)}, - {"LightSkyBlue" , PALETTERGB (135,206,250)}, - {"steel blue" , PALETTERGB ( 70,130,180)}, - {"SteelBlue" , PALETTERGB ( 70,130,180)}, - {"light steel blue" , PALETTERGB (176,196,222)}, - {"LightSteelBlue" , PALETTERGB (176,196,222)}, - {"light blue" , PALETTERGB (173,216,230)}, - {"LightBlue" , PALETTERGB (173,216,230)}, - {"powder blue" , PALETTERGB (176,224,230)}, - {"PowderBlue" , PALETTERGB (176,224,230)}, - {"pale turquoise" , PALETTERGB (175,238,238)}, - {"PaleTurquoise" , PALETTERGB (175,238,238)}, - {"dark turquoise" , PALETTERGB ( 0,206,209)}, - {"DarkTurquoise" , PALETTERGB ( 0,206,209)}, - {"medium turquoise" , PALETTERGB ( 72,209,204)}, - {"MediumTurquoise" , PALETTERGB ( 72,209,204)}, - {"turquoise" , PALETTERGB ( 64,224,208)}, - {"cyan" , PALETTERGB ( 0,255,255)}, - {"light cyan" , PALETTERGB (224,255,255)}, - {"LightCyan" , PALETTERGB (224,255,255)}, - {"cadet blue" , PALETTERGB ( 95,158,160)}, - {"CadetBlue" , PALETTERGB ( 95,158,160)}, - {"medium aquamarine" , PALETTERGB (102,205,170)}, - {"MediumAquamarine" , PALETTERGB (102,205,170)}, - {"aquamarine" , PALETTERGB (127,255,212)}, - {"dark green" , PALETTERGB ( 0,100, 0)}, - {"DarkGreen" , PALETTERGB ( 0,100, 0)}, - {"dark olive green" , PALETTERGB ( 85,107, 47)}, - {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)}, - {"dark sea green" , PALETTERGB (143,188,143)}, - {"DarkSeaGreen" , PALETTERGB (143,188,143)}, - {"sea green" , PALETTERGB ( 46,139, 87)}, - {"SeaGreen" , PALETTERGB ( 46,139, 87)}, - {"medium sea green" , PALETTERGB ( 60,179,113)}, - {"MediumSeaGreen" , PALETTERGB ( 60,179,113)}, - {"light sea green" , PALETTERGB ( 32,178,170)}, - {"LightSeaGreen" , PALETTERGB ( 32,178,170)}, - {"pale green" , PALETTERGB (152,251,152)}, - {"PaleGreen" , PALETTERGB (152,251,152)}, - {"spring green" , PALETTERGB ( 0,255,127)}, - {"SpringGreen" , PALETTERGB ( 0,255,127)}, - {"lawn green" , PALETTERGB (124,252, 0)}, - {"LawnGreen" , PALETTERGB (124,252, 0)}, - {"green" , PALETTERGB ( 0,255, 0)}, - {"chartreuse" , PALETTERGB (127,255, 0)}, - {"medium spring green" , PALETTERGB ( 0,250,154)}, - {"MediumSpringGreen" , PALETTERGB ( 0,250,154)}, - {"green yellow" , PALETTERGB (173,255, 47)}, - {"GreenYellow" , PALETTERGB (173,255, 47)}, - {"lime green" , PALETTERGB ( 50,205, 50)}, - {"LimeGreen" , PALETTERGB ( 50,205, 50)}, - {"yellow green" , PALETTERGB (154,205, 50)}, - {"YellowGreen" , PALETTERGB (154,205, 50)}, - {"forest green" , PALETTERGB ( 34,139, 34)}, - {"ForestGreen" , PALETTERGB ( 34,139, 34)}, - {"olive drab" , PALETTERGB (107,142, 35)}, - {"OliveDrab" , PALETTERGB (107,142, 35)}, - {"dark khaki" , PALETTERGB (189,183,107)}, - {"DarkKhaki" , PALETTERGB (189,183,107)}, - {"khaki" , PALETTERGB (240,230,140)}, - {"pale goldenrod" , PALETTERGB (238,232,170)}, - {"PaleGoldenrod" , PALETTERGB (238,232,170)}, - {"light goldenrod yellow" , PALETTERGB (250,250,210)}, - {"LightGoldenrodYellow" , PALETTERGB (250,250,210)}, - {"light yellow" , PALETTERGB (255,255,224)}, - {"LightYellow" , PALETTERGB (255,255,224)}, - {"yellow" , PALETTERGB (255,255, 0)}, - {"gold" , PALETTERGB (255,215, 0)}, - {"light goldenrod" , PALETTERGB (238,221,130)}, - {"LightGoldenrod" , PALETTERGB (238,221,130)}, - {"goldenrod" , PALETTERGB (218,165, 32)}, - {"dark goldenrod" , PALETTERGB (184,134, 11)}, - {"DarkGoldenrod" , PALETTERGB (184,134, 11)}, - {"rosy brown" , PALETTERGB (188,143,143)}, - {"RosyBrown" , PALETTERGB (188,143,143)}, - {"indian red" , PALETTERGB (205, 92, 92)}, - {"IndianRed" , PALETTERGB (205, 92, 92)}, - {"saddle brown" , PALETTERGB (139, 69, 19)}, - {"SaddleBrown" , PALETTERGB (139, 69, 19)}, - {"sienna" , PALETTERGB (160, 82, 45)}, - {"peru" , PALETTERGB (205,133, 63)}, - {"burlywood" , PALETTERGB (222,184,135)}, - {"beige" , PALETTERGB (245,245,220)}, - {"wheat" , PALETTERGB (245,222,179)}, - {"sandy brown" , PALETTERGB (244,164, 96)}, - {"SandyBrown" , PALETTERGB (244,164, 96)}, - {"tan" , PALETTERGB (210,180,140)}, - {"chocolate" , PALETTERGB (210,105, 30)}, - {"firebrick" , PALETTERGB (178, 34, 34)}, - {"brown" , PALETTERGB (165, 42, 42)}, - {"dark salmon" , PALETTERGB (233,150,122)}, - {"DarkSalmon" , PALETTERGB (233,150,122)}, - {"salmon" , PALETTERGB (250,128,114)}, - {"light salmon" , PALETTERGB (255,160,122)}, - {"LightSalmon" , PALETTERGB (255,160,122)}, - {"orange" , PALETTERGB (255,165, 0)}, - {"dark orange" , PALETTERGB (255,140, 0)}, - {"DarkOrange" , PALETTERGB (255,140, 0)}, - {"coral" , PALETTERGB (255,127, 80)}, - {"light coral" , PALETTERGB (240,128,128)}, - {"LightCoral" , PALETTERGB (240,128,128)}, - {"tomato" , PALETTERGB (255, 99, 71)}, - {"orange red" , PALETTERGB (255, 69, 0)}, - {"OrangeRed" , PALETTERGB (255, 69, 0)}, - {"red" , PALETTERGB (255, 0, 0)}, - {"hot pink" , PALETTERGB (255,105,180)}, - {"HotPink" , PALETTERGB (255,105,180)}, - {"deep pink" , PALETTERGB (255, 20,147)}, - {"DeepPink" , PALETTERGB (255, 20,147)}, - {"pink" , PALETTERGB (255,192,203)}, - {"light pink" , PALETTERGB (255,182,193)}, - {"LightPink" , PALETTERGB (255,182,193)}, - {"pale violet red" , PALETTERGB (219,112,147)}, - {"PaleVioletRed" , PALETTERGB (219,112,147)}, - {"maroon" , PALETTERGB (176, 48, 96)}, - {"medium violet red" , PALETTERGB (199, 21,133)}, - {"MediumVioletRed" , PALETTERGB (199, 21,133)}, - {"violet red" , PALETTERGB (208, 32,144)}, - {"VioletRed" , PALETTERGB (208, 32,144)}, - {"magenta" , PALETTERGB (255, 0,255)}, - {"violet" , PALETTERGB (238,130,238)}, - {"plum" , PALETTERGB (221,160,221)}, - {"orchid" , PALETTERGB (218,112,214)}, - {"medium orchid" , PALETTERGB (186, 85,211)}, - {"MediumOrchid" , PALETTERGB (186, 85,211)}, - {"dark orchid" , PALETTERGB (153, 50,204)}, - {"DarkOrchid" , PALETTERGB (153, 50,204)}, - {"dark violet" , PALETTERGB (148, 0,211)}, - {"DarkViolet" , PALETTERGB (148, 0,211)}, - {"blue violet" , PALETTERGB (138, 43,226)}, - {"BlueViolet" , PALETTERGB (138, 43,226)}, - {"purple" , PALETTERGB (160, 32,240)}, - {"medium purple" , PALETTERGB (147,112,219)}, - {"MediumPurple" , PALETTERGB (147,112,219)}, - {"thistle" , PALETTERGB (216,191,216)}, - {"gray0" , PALETTERGB ( 0, 0, 0)}, - {"grey0" , PALETTERGB ( 0, 0, 0)}, - {"dark grey" , PALETTERGB (169,169,169)}, - {"DarkGrey" , PALETTERGB (169,169,169)}, - {"dark gray" , PALETTERGB (169,169,169)}, - {"DarkGray" , PALETTERGB (169,169,169)}, - {"dark blue" , PALETTERGB ( 0, 0,139)}, - {"DarkBlue" , PALETTERGB ( 0, 0,139)}, - {"dark cyan" , PALETTERGB ( 0,139,139)}, - {"DarkCyan" , PALETTERGB ( 0,139,139)}, - {"dark magenta" , PALETTERGB (139, 0,139)}, - {"DarkMagenta" , PALETTERGB (139, 0,139)}, - {"dark red" , PALETTERGB (139, 0, 0)}, - {"DarkRed" , PALETTERGB (139, 0, 0)}, - {"light green" , PALETTERGB (144,238,144)}, - {"LightGreen" , PALETTERGB (144,238,144)}, -}; - -static COLORREF -w32_string_to_color(CONST char *name) -{ - int color, i; - - if (*name == '#') - { - /* w32 numeric names look like "#BBGGRR" */ - if (strlen(name)!=7) - return (-1); - for (i=1; i<7; i++) - if (!isxdigit(name[i])) - return(-1); - if (sscanf(name+1, "%x", &color) == 1) - return(0x02000000 | color); /* See PALETTERGB in docs */ - } - else - { - for(i=0; i<(sizeof(w32_X_color_map)/sizeof(colormap_t)); i++) - if (!stricmp(name, w32_X_color_map[i].name)) - return (w32_X_color_map[i].colorref); - } - return(-1); -} - -static int -w32_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name, - Lisp_Object device, Error_behavior errb) -{ - CONST char *extname; - COLORREF color; - - GET_C_STRING_CTEXT_DATA_ALLOCA (name, extname); - color = w32_string_to_color(extname); - if (color != -1) - { - c->data = xnew (struct w32_color_instance_data); - COLOR_INSTANCE_W32_COLOR (c) = color; - COLOR_INSTANCE_W32_BRUSH (c) = CreateSolidBrush (color); - return 1; - } - maybe_signal_simple_error ("unrecognized color", name, Qcolor, errb); - return(0); -} - -static void -w32_mark_color_instance (struct Lisp_Color_Instance *c, - void (*markobj) (Lisp_Object)) -{ -} - -static void -w32_print_color_instance (struct Lisp_Color_Instance *c, - Lisp_Object printcharfun, - int escapeflag) -{ - char buf[32]; - COLORREF color = COLOR_INSTANCE_W32_COLOR (c); - sprintf (buf, " %06ld=(%02X,%02X,%02X)", color & 0xffffff, - GetRValue(color), GetGValue(color), GetBValue(color)); - write_c_string (buf, printcharfun); -} - -static void -w32_finalize_color_instance (struct Lisp_Color_Instance *c) -{ - if (c->data) - { - DeleteObject (COLOR_INSTANCE_W32_BRUSH (c)); - xfree (c->data); - c->data = 0; - } -} - -static int -w32_color_instance_equal (struct Lisp_Color_Instance *c1, - struct Lisp_Color_Instance *c2, - int depth) -{ - return (COLOR_INSTANCE_W32_COLOR(c1) == COLOR_INSTANCE_W32_COLOR(c2)); -} - -static unsigned long -w32_color_instance_hash (struct Lisp_Color_Instance *c, int depth) -{ - return LISP_HASH (COLOR_INSTANCE_W32_COLOR(c)); -} - -static Lisp_Object -w32_color_instance_rgb_components (struct Lisp_Color_Instance *c) -{ - COLORREF color = COLOR_INSTANCE_W32_COLOR (c); - return (list3 (make_int (GetRValue(color)), - make_int (GetGValue(color)), - make_int (GetBValue(color)))); -} - -static int -w32_valid_color_name_p (struct device *d, Lisp_Object color) -{ - CONST char *extname; - - GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname); - return (w32_string_to_color(extname)!=-1); -} - - - -static void -w32_finalize_font_instance (struct Lisp_Font_Instance *f) -{ - if (f->data) - { - DeleteObject(f->data); - f->data=0; - } -} - -static int -w32_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name, - Lisp_Object device, Error_behavior errb) -{ - CONST char *extname; - LOGFONT logfont; - int fields; - int pt; - char fontname[LF_FACESIZE], weight[32], *style, points[8], effects[32], charset[32]; - - GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname); - - /* - * w32 fonts look like: - * fontname[:[weight ][style][:pointsize[:effects[:charset]]]] - * The font name field shouldn't be empty. - * XXX Windows will substitute a default (monospace) font if the font name - * specifies a non-existent font. We don't catch this. - * effects and charset are currently ignored. - * - * ie: - * Lucida Console:Regular:10 - * minimal: - * Courier New - * maximal: - * Courier New:Bold Italic:10:underline strikeout:ansi - */ - fields = sscanf (extname, "%31[^:]:%31[^:]:%7[^:]:%31[^:]:%31s", - fontname, weight, points, effects, charset); - - if (fields<0) - { - maybe_signal_simple_error ("Invalid font", f->name, Qfont, errb); - return (0); - } - - if (fields>0 && strlen(fontname)) - { - strncpy (logfont.lfFaceName, fontname, LF_FACESIZE); - logfont.lfFaceName[LF_FACESIZE-1] = 0; - } - else - { - maybe_signal_simple_error ("Must specify a font name", f->name, Qfont, errb); - return (0); - } - - if (fields > 1 && strlen(weight)) - { - char *c; - /* Maybe split weight into weight and style */ - if (c=strchr(weight, ' ')) - { - *c = '\0'; - style = c+1; - } - else - style = NULL; - - /* weight: Most-often used (maybe) first */ - if (stricmp (weight,"regular") == 0) - logfont.lfWeight = FW_REGULAR; - else if (stricmp (weight,"normal") == 0) - logfont.lfWeight = FW_NORMAL; - else if (stricmp (weight,"bold") == 0) - logfont.lfWeight = FW_BOLD; - else if (stricmp (weight,"medium") == 0) - logfont.lfWeight = FW_MEDIUM; - else if (stricmp (weight,"italic") == 0) /* Hack for early exit */ - { - logfont.lfWeight = FW_NORMAL; - style=weight; - } - /* the rest */ - else if (stricmp (weight,"black") == 0) - logfont.lfWeight = FW_BLACK; - else if (stricmp (weight,"heavy") == 0) - logfont.lfWeight = FW_HEAVY; - else if (stricmp (weight,"ultrabold") == 0) - logfont.lfWeight = FW_ULTRABOLD; - else if (stricmp (weight,"extrabold") == 0) - logfont.lfWeight = FW_EXTRABOLD; - else if (stricmp (weight,"demibold") == 0) - logfont.lfWeight = FW_SEMIBOLD; - else if (stricmp (weight,"semibold") == 0) - logfont.lfWeight = FW_SEMIBOLD; - else if (stricmp (weight,"light") == 0) - logfont.lfWeight = FW_LIGHT; - else if (stricmp (weight,"ultralight") == 0) - logfont.lfWeight = FW_ULTRALIGHT; - else if (stricmp (weight,"extralight") == 0) - logfont.lfWeight = FW_EXTRALIGHT; - else if (stricmp (weight,"thin") == 0) - logfont.lfWeight = FW_THIN; - else - { - logfont.lfWeight = FW_NORMAL; - if (!style) - style = weight; /* May have specified a style without a weight */ - else - { - maybe_signal_simple_error ("Invalid font weight", f->name, Qfont, errb); - return (0); /* Invalid weight */ - } - } - - if (style) - { - /* XXX what about oblique? */ - if (stricmp (style,"italic") == 0) - logfont.lfItalic = TRUE; - else if (stricmp (style,"roman") == 0) - logfont.lfItalic = FALSE; - else - { - maybe_signal_simple_error ("Invalid font weight or style", f->name, Qfont, errb); - return (0); /* Invalid weight or style */ - } - } - else - { - logfont.lfItalic = FALSE; - } - - } - else - { - logfont.lfWeight = FW_NORMAL; - logfont.lfItalic = FALSE; - } - - /* XXX Should we reject strings that don't specify a size? */ - if (fields < 3 || !strlen(points) || (pt=atoi(points))==0) - pt = 10; - - /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */ - logfont.lfHeight = -MulDiv(pt, DEVICE_W32_LOGPIXELSY(XDEVICE (device)), 72); - logfont.lfWidth = 0; - - /* Default to monospaced if the specified font name is not found */ - logfont.lfPitchAndFamily = FF_MODERN; - - /* XXX: FIXME? */ - logfont.lfUnderline = FALSE; - logfont.lfStrikeOut = FALSE; - - /* XXX: FIXME: we ignore charset */ - logfont.lfCharSet = DEFAULT_CHARSET; - - /* Misc crud */ - logfont.lfEscapement = logfont.lfOrientation = 0; -#if 1 - logfont.lfOutPrecision = OUT_DEFAULT_PRECIS; - logfont.lfClipPrecision = CLIP_DEFAULT_PRECIS; - logfont.lfQuality = DEFAULT_QUALITY; -#else - logfont.lfOutPrecision = OUT_STROKE_PRECIS; - logfont.lfClipPrecision = CLIP_STROKE_PRECIS; - logfont.lfQuality = PROOF_QUALITY; -#endif - - if ((f->data = CreateFontIndirect(&logfont)) == NULL) - { - maybe_signal_simple_error ("Couldn't create font", f->name, Qfont, errb); - return 0; - } - - /* Have to apply Font to a GC to get its values. - * We'll borrow the desktop window becuase its the only window that we - * know about that is guaranteed to exist when this gets called - */ - { - HWND hwnd; - HDC hdc; - HFONT holdfont; - TEXTMETRIC metrics; - - hwnd = GetDesktopWindow(); - assert(hdc = GetDC(hwnd)); /* XXX FIXME: can this temporarily fail? */ - holdfont = SelectObject(hdc, f->data); - if (!holdfont) - { - w32_finalize_font_instance (f); - maybe_signal_simple_error ("Couldn't map font", f->name, Qfont, errb); - return 0; - } - GetTextMetrics(hdc, &metrics); - SelectObject(hdc, holdfont); - ReleaseDC(hwnd, hdc); - f->width = metrics.tmAveCharWidth; - f->height = metrics.tmHeight; - f->ascent = metrics.tmAscent; - f->descent = metrics.tmDescent; - f->proportional_p = (metrics.tmPitchAndFamily & TMPF_FIXED_PITCH); - } - - return 1; -} - -static void -w32_mark_font_instance (struct Lisp_Font_Instance *f, - void (*markobj) (Lisp_Object)) -{ -} - -static void -w32_print_font_instance (struct Lisp_Font_Instance *f, - Lisp_Object printcharfun, - int escapeflag) -{ -} - -static Lisp_Object -w32_list_fonts (Lisp_Object pattern, Lisp_Object device) -{ - /* XXX Implement me */ - return list1 (build_string ("Courier New:Regular:10")); -} - - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_objects_w32 (void) -{ -} - -void -console_type_create_objects_w32 (void) -{ - /* object methods */ - CONSOLE_HAS_METHOD (w32, initialize_color_instance); -/* CONSOLE_HAS_METHOD (w32, mark_color_instance); */ - CONSOLE_HAS_METHOD (w32, print_color_instance); - CONSOLE_HAS_METHOD (w32, finalize_color_instance); - CONSOLE_HAS_METHOD (w32, color_instance_equal); - CONSOLE_HAS_METHOD (w32, color_instance_hash); - CONSOLE_HAS_METHOD (w32, color_instance_rgb_components); - CONSOLE_HAS_METHOD (w32, valid_color_name_p); - - CONSOLE_HAS_METHOD (w32, initialize_font_instance); -/* CONSOLE_HAS_METHOD (w32, mark_font_instance); */ - CONSOLE_HAS_METHOD (w32, print_font_instance); - CONSOLE_HAS_METHOD (w32, finalize_font_instance); -/* CONSOLE_HAS_METHOD (w32, font_instance_truename); */ - CONSOLE_HAS_METHOD (w32, list_fonts); -#ifdef MULE - CONSOLE_HAS_METHOD (w32, font_spec_matches_charset); - CONSOLE_HAS_METHOD (w32, find_charset_font); -#endif -} - -void -vars_of_objects_w32 (void) -{ -} diff -r d8688acf4c5b -r 78f53ef88e17 src/objects-w32.h --- a/src/objects-w32.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -/* win32-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing. - Copyright (C) 1997, Jonathan Harris. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Ultimately based on FSF. - Rewritten by Ben Wing. - Rewritten for win32 by Jonathan Harris, November 1997 for 20.4. - */ - - -#ifndef _XEMACS_OBJECTS_W32_H_ -#define _XEMACS_OBJECTS_W32_H_ - -#include "objects.h" - -struct w32_color_instance_data -{ - COLORREF color; - HBRUSH brush; -}; - -#define W32_COLOR_INSTANCE_DATA(c) ((struct w32_color_instance_data *) (c)->data) -#define COLOR_INSTANCE_W32_COLOR(c) (W32_COLOR_INSTANCE_DATA (c)->color) -#define COLOR_INSTANCE_W32_BRUSH(c) (W32_COLOR_INSTANCE_DATA (c)->brush) - - -#define FONT_INSTANCE_W32_HFONT(c) ((HFONT) (c)->data) - -#endif /* _XEMACS_OBJECTS_W32_H_ */ diff -r d8688acf4c5b -r 78f53ef88e17 src/redisplay-msw.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/redisplay-msw.c Mon Aug 13 10:06:47 2007 +0200 @@ -0,0 +1,1187 @@ +/* mswindows output and frame manipulation routines. + Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. + Copyright (C) 1994 Lucid, Inc. + Copyright (C) 1995 Sun Microsystems, Inc. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs 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 General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* Authorship: + + Chuck Thompson + Lots of work done by Ben Wing for Mule + Partially rewritten for mswindows by Jonathan Harris, November 1997 for 20.4. + */ + +#include +#include "lisp.h" + +#include "console-msw.h" +#include "objects-msw.h" + +#include "buffer.h" +#include "debug.h" +#include "events.h" +#include "faces.h" +#include "frame.h" +#include "glyphs.h" /* XXX FIXME: Should be glyphs-mswindows when we make one */ +#include "redisplay.h" +#include "sysdep.h" +#include "window.h" + +#include "windows.h" + +/* MSWINDOWS_DIVIDER_LINE_WIDTH is the width of the line drawn in the gutter. + MSWINDOWS_DIVIDER_SPACING is the amount of blank space on each side of the line. + MSWINDOWS_DIVIDER_WIDTH = MSWINDOWS_DIVIDER_LINE_WIDTH + 2*MSWINDOWS_DIVIDER_SPACING +*/ +#define MSWINDOWS_DIVIDER_LINE_WIDTH 7 +#define MSWINDOWS_DIVIDER_SPACING 0 +#define MSWINDOWS_DIVIDER_WIDTH (MSWINDOWS_DIVIDER_LINE_WIDTH + 2 * MSWINDOWS_DIVIDER_SPACING) + +#define MSWINDOWS_EOL_CURSOR_WIDTH 5 + +/* + * Random forward delarations + */ +static void mswindows_clear_region (Lisp_Object locale, face_index findex, + int x, int y, int width, int height); +static void mswindows_output_vertical_divider (struct window *w, int clear); +static void mswindows_redraw_exposed_windows (Lisp_Object window, int x, + int y, int width, int height); + + + +typedef struct textual_run +{ + Lisp_Object charset; + unsigned char *ptr; + int len; + int dimension; +} textual_run; + +/* Separate out the text in DYN into a series of textual runs of a + particular charset. Also convert the characters as necessary into + the format needed by XDrawImageString(), XDrawImageString16(), et + al. (This means converting to one or two byte format, possibly + tweaking the high bits, and possibly running a CCL program.) You + must pre-allocate the space used and pass it in. (This is done so + you can alloca() the space.) You need to allocate (2 * len) bytes + of TEXT_STORAGE and (len * sizeof (textual_run)) bytes of + RUN_STORAGE, where LEN is the length of the dynarr. + + Returns the number of runs actually used. */ + +static int +separate_textual_runs (unsigned char *text_storage, + textual_run *run_storage, + CONST Emchar *str, Charcount len) +{ + Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a + possible valid charset when + MULE is not defined */ + int runs_so_far = 0; + int i; +#ifdef MULE + struct ccl_program char_converter; + int need_ccl_conversion = 0; +#endif + + for (i = 0; i < len; i++) + { + Emchar ch = str[i]; + Lisp_Object charset; + int byte1, byte2; + int dimension; + int graphic; + + BREAKUP_CHAR (ch, charset, byte1, byte2); + dimension = XCHARSET_DIMENSION (charset); + graphic = XCHARSET_GRAPHIC (charset); + + if (!EQ (charset, prev_charset)) + { + run_storage[runs_so_far].ptr = text_storage; + run_storage[runs_so_far].charset = charset; + run_storage[runs_so_far].dimension = dimension; + + if (runs_so_far) + { + run_storage[runs_so_far - 1].len = + text_storage - run_storage[runs_so_far - 1].ptr; + if (run_storage[runs_so_far - 1].dimension == 2) + run_storage[runs_so_far - 1].len >>= 1; + } + runs_so_far++; + prev_charset = charset; +#ifdef MULE + { + Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset); + need_ccl_conversion = !NILP (ccl_prog); + if (need_ccl_conversion) + setup_ccl_program (&char_converter, ccl_prog); + } +#endif + } + + if (graphic == 0) + { + byte1 &= 0x7F; + byte2 &= 0x7F; + } + else if (graphic == 1) + { + byte1 |= 0x80; + byte2 |= 0x80; + } +#ifdef MULE + if (need_ccl_conversion) + { + char_converter.reg[0] = XCHARSET_ID (charset); + char_converter.reg[1] = byte1; + char_converter.reg[2] = byte2; + char_converter.ic = 0; /* start at beginning each time */ + ccl_driver (&char_converter, 0, 0, 0, 0); + byte1 = char_converter.reg[1]; + byte2 = char_converter.reg[2]; + } +#endif + *text_storage++ = (unsigned char) byte1; + if (dimension == 2) + *text_storage++ = (unsigned char) byte2; + } + + if (runs_so_far) + { + run_storage[runs_so_far - 1].len = + text_storage - run_storage[runs_so_far - 1].ptr; + if (run_storage[runs_so_far - 1].dimension == 2) + run_storage[runs_so_far - 1].len >>= 1; + } + + return runs_so_far; +} + + +static int +mswindows_text_width_single_run (HDC hdc, struct face_cachel *cachel, + textual_run *run) +{ + Lisp_Object font_inst = FACE_CACHEL_FONT (cachel, run->charset); + struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_inst); + SIZE size; + +#if 0 /* XXX HACK: mswindows_text_width is broken and will pass in a NULL hdc */ + if (!fi->proportional_p) +#else + if (!fi->proportional_p || !hdc) +#endif + return (fi->width * run->len); + else + { + assert(run->dimension == 1); /* XXX FIXME! */ + GetTextExtentPoint32(hdc, run->ptr, run->len, &size); + return(size.cx); + } +} + + +/***************************************************************************** + mswindows_update_gc + + Given a number of parameters munge the GC so it has those properties. + ****************************************************************************/ +static void +mswindows_update_gc (HDC hdc, Lisp_Object font, Lisp_Object fg, Lisp_Object bg, + Lisp_Object bg_pmap, Lisp_Object lwidth) +{ + if (!NILP (font)) + SelectObject(hdc, (XFONT_INSTANCE (font))->data); + + /* evil kludge! - XXX do we need this? */ + if (!NILP (fg) && !COLOR_INSTANCEP (fg)) + { + fprintf (stderr, "Help! mswindows_update_gc got a bogus fg value! fg = "); + debug_print (fg); + fg = Qnil; + } + + if (!NILP (fg)) + SetTextColor (hdc, COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (fg))); + + if (!NILP (bg)) + SetBkColor (hdc, COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (bg))); + +#if 0 /* XXX Implement me */ + /* I expect that the Lisp_Image_Instance's data will point to a brush */ + if (IMAGE_INSTANCEP (bg_pmap) + && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) + { + if (XIMAGE_INSTANCE_PIXMAP_DEPTH (bg_pmap) == 0) + { + gcv.fill_style = FillOpaqueStippled; + gcv.stipple = XIMAGE_INSTANCE_X_PIXMAP (bg_pmap); + mask |= (GCStipple | GCFillStyle); + } + else + { + gcv.fill_style = FillTiled; + gcv.tile = XIMAGE_INSTANCE_X_PIXMAP (bg_pmap); + mask |= (GCTile | GCFillStyle); + } + } +#endif + +#if 0 /* XXX FIXME */ + if (!NILP (lwidth)) + { + gcv.line_width = XINT (lwidth); + mask |= GCLineWidth; + } +#endif +} + + +/***************************************************************************** + mswindows_output_hline + + Output a horizontal line in the foreground of its face. + ****************************************************************************/ +static void +mswindows_output_hline (struct window *w, struct display_line *dl, struct rune *rb) +{ /* XXX Implement me */ +} + + +/***************************************************************************** + mswindows_output_blank + + Output a blank by clearing the area it covers in the background color + of its face. + ****************************************************************************/ +static void +mswindows_output_blank (struct window *w, struct display_line *dl, struct rune *rb) +{ + struct frame *f = XFRAME (w->frame); + RECT rect = { rb->xpos, dl->ypos-dl->ascent, + rb->xpos+rb->width, dl->ypos+dl->descent-dl->clip }; + struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, rb->findex); + + Lisp_Object bg_pmap = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, rb->findex); + + if (!IMAGE_INSTANCEP (bg_pmap) + || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) + bg_pmap = Qnil; + + FillRect (FRAME_MSWINDOWS_DC (f), &rect, + COLOR_INSTANCE_MSWINDOWS_BRUSH (XCOLOR_INSTANCE (cachel->background))); +} + + +/***************************************************************************** + mswindows_output_cursor + + Draw a normal or end-of-line cursor. The end-of-line cursor is + narrower than the normal cursor. + ****************************************************************************/ +static void +mswindows_output_cursor (struct window *w, struct display_line *dl, int xpos, + int width, struct rune *rb) +{ + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + struct face_cachel *cachel; + Lisp_Object font; + int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); + HBRUSH brush; + HDC hdc = FRAME_MSWINDOWS_DC (f); + int real_char_p = (rb->type == RUNE_CHAR && rb->object.chr.ch != '\n'); + RECT rect = { xpos, + dl->ypos - dl->ascent, + xpos + width, + dl->ypos + dl->descent - dl->clip}; + +#if 0 /* XXX FIXME: Whar about the bar_cursor? */ + Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor, + WINDOW_BUFFER (w)); +#endif + + if (real_char_p) + { + /* Use the font from the underlying character */ + cachel = WINDOW_FACE_CACHEL (w, rb->findex); + + /* XXX MULE: Need to know the charset! */ + font = FACE_CACHEL_FONT (cachel, Vcharset_ascii); + } + + /* Clear the area */ + if (focus) + cachel = WINDOW_FACE_CACHEL (w, + get_builtin_face_cache_index (w, Vtext_cursor_face)); + else if (!real_char_p) + cachel = WINDOW_FACE_CACHEL (w, rb->findex); + + brush = COLOR_INSTANCE_MSWINDOWS_BRUSH (XCOLOR_INSTANCE (cachel->background)); + FillRect (hdc, &rect, brush); + + if (real_char_p) + { + /* XXX FIXME: Need to clip if dl->clip!=0. How rare is this case? */ + /* Output the underlying character */ + mswindows_update_gc (hdc, font, cachel->foreground, + cachel->background, Qnil, Qnil); + TextOut(hdc, xpos, dl->ypos, (char*) &rb->object.chr.ch, 1); + } + + if (!focus) + { + /* Draw hollow rectangle in cursor's background color */ + cachel = WINDOW_FACE_CACHEL (w, + get_builtin_face_cache_index (w, Vtext_cursor_face)); + brush = COLOR_INSTANCE_MSWINDOWS_BRUSH (XCOLOR_INSTANCE (cachel->background)); + FrameRect (hdc, &rect, brush); + } +} + + +/***************************************************************************** + mswindows_output_string + + Given a string and a starting position, output that string in the + given face. + Correctly handles multiple charsets in the string. + + The meaning of the parameters is something like this: + + W Window that the text is to be displayed in. + DL Display line that this text is on. The values in the + structure are used to determine the vertical position and + clipping range of the text. + BUF Dynamic array of Emchars specifying what is actually to be + drawn. + XPOS X position in pixels where the text should start being drawn. + XOFFSET Number of pixels to be chopped off the left side of the + text. The effect is as if the text were shifted to the + left this many pixels and clipped at XPOS. + CLIP_START Clip everything left of this X position. + WIDTH Clip everything right of XPOS + WIDTH. + FINDEX Index for the face cache element describing how to display + the text. + ****************************************************************************/ +void +mswindows_output_string (struct window *w, struct display_line *dl, + Emchar_dynarr *buf, int xpos, int xoffset, int clip_start, + int width, face_index findex) +{ + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + Lisp_Object window = Qnil; + HDC hdc; + int clip_end; + Lisp_Object bg_pmap; + int len = Dynarr_length (buf); + unsigned char *text_storage = (unsigned char *) alloca (2 * len); + textual_run *runs = alloca_array (textual_run, len); + int nruns; + int i; + struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex); + + XSETWINDOW (window, w); + hdc = FRAME_MSWINDOWS_DC(f); + +#if 0 /* XXX: FIXME? */ + /* We can't work out the width before we've set the font in the DC */ + if (width < 0) + width = mswindows_text_width (cachel, Dynarr_atp (buf, 0), Dynarr_length (buf)); +#else + assert(width>=0); +#endif + + /* Regularize the variables passed in. */ + if (clip_start < xpos) + clip_start = xpos; + clip_end = xpos + width; + if (clip_start >= clip_end) + /* It's all clipped out. */ + return; + + xpos -= xoffset; + + nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), + Dynarr_length (buf)); + + bg_pmap = cachel->background_pixmap; + if (!IMAGE_INSTANCEP (bg_pmap) + || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) + bg_pmap = Qnil; + + for (i = 0; i < nruns; i++) + { + Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset); + struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font); + int this_width; + int need_clipping; + RECT rect = { clip_start, dl->ypos - dl->ascent, + clip_end, dl->ypos + dl->descent - dl->clip }; + HRGN region; + + if (EQ (font, Vthe_null_font_instance)) + continue; + + mswindows_update_gc (hdc, font, cachel->foreground, + cachel->background, Qnil, Qnil); + + this_width = mswindows_text_width_single_run (hdc, cachel, runs + i); + need_clipping = (dl->clip || clip_start > xpos || + clip_end < xpos + this_width); + + if (need_clipping) + { + region = CreateRectRgn (rect.left, rect.top, + rect.right, rect.bottom); + SelectClipRgn (hdc, region); + } + + /* TextOut only clears the area equal to the height of + the given font. It is possible that a font is being displayed + on a line taller than it is, so this would cause us to fail to + clear some areas. */ + if (fi->ascent < dl->ascent || fi->descent < dl->descent-dl->clip) + FillRect (hdc, &rect, + COLOR_INSTANCE_MSWINDOWS_BRUSH (XCOLOR_INSTANCE (cachel->background))); + + assert (runs[i].dimension == 1); /* XXX FIXME */ + TextOut(hdc, xpos, dl->ypos, (char *) runs[i].ptr, runs[i].len); + + /* XXX FIXME? X does underline/strikethrough here + we will do it as part of face's font */ + + if (need_clipping) + { + SelectClipRgn (hdc, NULL); + DeleteObject (region); + } + + xpos += this_width; + } +} + +/***************************************************************************** + mswindows_redraw_exposed_window + + Given a bounding box for an area that needs to be redrawn, determine + what parts of what lines are contained within and re-output their + contents. + Copied from redisplay-x.c + ****************************************************************************/ +static void +mswindows_redraw_exposed_window (struct window *w, int x, int y, int width, + int height) +{ + struct frame *f = XFRAME (w->frame); + int line; + int start_x, start_y, end_x, end_y; + int orig_windows_structure_changed; + + display_line_dynarr *cdla = window_display_lines (w, CURRENT_DISP); + + if (!NILP (w->vchild)) + { + mswindows_redraw_exposed_windows (w->vchild, x, y, width, height); + return; + } + else if (!NILP (w->hchild)) + { + mswindows_redraw_exposed_windows (w->hchild, x, y, width, height); + return; + } + + /* If the window doesn't intersect the exposed region, we're done here. */ + if (x >= WINDOW_RIGHT (w) || (x + width) <= WINDOW_LEFT (w) + || y >= WINDOW_BOTTOM (w) || (y + height) <= WINDOW_TOP (w)) + { + return; + } + else + { + start_x = max (WINDOW_LEFT (w), x); + end_x = min (WINDOW_RIGHT (w), (x + width)); + start_y = max (WINDOW_TOP (w), y); + end_y = min (WINDOW_BOTTOM (w), y + height); + + /* We do this to make sure that the 3D modelines get redrawn if + they are in the exposed region. */ + orig_windows_structure_changed = f->windows_structure_changed; + f->windows_structure_changed = 1; + } + + if (window_needs_vertical_divider (w)) + { + mswindows_output_vertical_divider (w, 0); + } + + for (line = 0; line < Dynarr_length (cdla); line++) + { + struct display_line *cdl = Dynarr_atp (cdla, line); + int top_y = cdl->ypos - cdl->ascent; + int bottom_y = cdl->ypos + cdl->descent; + + if (bottom_y >= start_y) + { + if (top_y > end_y) + { + if (line == 0) + continue; + else + break; + } + else + { + output_display_line (w, 0, cdla, line, start_x, end_x); + } + } + } + + f->windows_structure_changed = orig_windows_structure_changed; + + /* If there have never been any face cache_elements created, then this + expose event doesn't actually have anything to do. */ + if (Dynarr_largest (w->face_cachels)) + redisplay_clear_bottom_of_window (w, cdla, start_y, end_y); +} + +/***************************************************************************** + mswindows_redraw_exposed_windows + + For each window beneath the given window in the window hierarchy, + ensure that it is redrawn if necessary after an Expose event. + ****************************************************************************/ +static void +mswindows_redraw_exposed_windows (Lisp_Object window, int x, int y, int width, + int height) +{ + for (; !NILP (window); window = XWINDOW (window)->next) + mswindows_redraw_exposed_window (XWINDOW (window), x, y, width, height); +} + +/***************************************************************************** + mswindows_redraw_exposed_area + + For each window on the given frame, ensure that any area in the + Exposed area is redrawn. + ****************************************************************************/ +void +mswindows_redraw_exposed_area (struct frame *f, int x, int y, int width, int height) +{ + /* If any window on the frame has had its face cache reset then the + redisplay structures are effectively invalid. If we attempt to + use them we'll blow up. We mark the frame as changed to ensure + that redisplay will do a full update. This probably isn't + necessary but it can't hurt. */ + + if (!f->window_face_cache_reset) + mswindows_redraw_exposed_windows (f->root_window, x, y, width, height); + else + MARK_FRAME_CHANGED (f); +} + + +/***************************************************************************** + mswindows_bevel_modeline + + Draw a 3d border around the modeline on window W. + ****************************************************************************/ +static void +mswindows_bevel_modeline (struct window *w, struct display_line *dl) +{ + struct frame *f = XFRAME (w->frame); + Lisp_Object color; + int shadow_width = MODELINE_SHADOW_THICKNESS (w); + RECT rect = { WINDOW_MODELINE_LEFT (w), + dl->ypos - dl->ascent - shadow_width, + WINDOW_MODELINE_RIGHT (w), + dl->ypos + dl->descent + shadow_width}; + + + color = WINDOW_FACE_CACHEL_BACKGROUND (w, MODELINE_INDEX); + mswindows_update_gc(FRAME_MSWINDOWS_DC(f), Qnil, Qnil, color, Qnil, Qnil); + +#if 0 /* XXX Eh? */ + if (shadow_width < 0) + { + GC temp; + + temp = top_shadow_gc; + top_shadow_gc = bottom_shadow_gc; + bottom_shadow_gc = temp; + } +#endif + + DrawEdge (FRAME_MSWINDOWS_DC(f), &rect, shadow_width==1 ? BDR_RAISEDINNER : + EDGE_RAISED, BF_RECT); +} + + +/***************************************************************************** + #### Display methods +/***************************************************************************** + +/***************************************************************************** + mswindows_divider_width + + Return the width of the vertical divider. + ****************************************************************************/ +static int +mswindows_divider_width (void) +{ + return MSWINDOWS_DIVIDER_WIDTH; +} + +/***************************************************************************** + mswindows_divider_height + + Return the height of the horizontal divider. + ****************************************************************************/ +static int +mswindows_divider_height (void) +{ + return 1; /* XXX Copied from redisplay-X.c. What is this? */ +} + +/***************************************************************************** + mswindows_eol_cursor_width + + Return the width of the end-of-line cursor. + ****************************************************************************/ +static int +mswindows_eol_cursor_width (void) +{ + return MSWINDOWS_EOL_CURSOR_WIDTH; +} + +/***************************************************************************** + mswindows_output_begin + + Perform any necessary initialization prior to an update. + ****************************************************************************/ +static void +mswindows_output_begin (struct device *d) +{ +} + +/***************************************************************************** + mswindows_output_end + + Perform any necessary flushing of queues when an update has completed. + ****************************************************************************/ +static void +mswindows_output_end (struct device *d) +{ +} + +static int +mswindows_flash (struct device *d) +{ + struct frame *f = device_selected_frame (d); + + /* XXX FIXME: Do something more visible here, maybe involving a timer */ + FlashWindow (FRAME_MSWINDOWS_HANDLE (f), TRUE); + FlashWindow (FRAME_MSWINDOWS_HANDLE (f), FALSE); +} + +static void +mswindows_ring_bell (struct device *d, int volume, int pitch, int duration) +{ + /* XXX FIXME: I'm guessing pitch=Hz and duration is milliseconds */ + + if ((pitch|duration) == -1) /* Pitch and/or duration may be bogus */ + MessageBeep(-1); /* Default system sound via speaker */ + else + Beep(pitch, duration); +} + + +/***************************************************************************** + mswindows_output_display_block + + Given a display line, a block number for that start line, output all + runes between start and end in the specified display block. + Ripped off with mininmal thought from the corresponding X routine. + ****************************************************************************/ +static void +mswindows_output_display_block (struct window *w, struct display_line *dl, int block, + int start, int end, int start_pixpos, int cursor_start, + int cursor_width, int cursor_height) +{ + struct frame *f = XFRAME (w->frame); + Emchar_dynarr *buf = Dynarr_new (Emchar); + Lisp_Object window; + + struct display_block *db = Dynarr_atp (dl->display_blocks, block); + rune_dynarr *rba = db->runes; + struct rune *rb; + + int elt = start; + face_index findex; + int xpos, width; + Lisp_Object charset = Qunbound; /* Qnil is a valid charset when + MULE is not defined */ + XSETWINDOW (window, w); + rb = Dynarr_atp (rba, start); + + if (!rb) + { + /* Nothing to do so don't do anything. */ + return; + } + else + { + findex = rb->findex; + xpos = rb->xpos; + width = 0; + if (rb->type == RUNE_CHAR) + charset = CHAR_CHARSET (rb->object.chr.ch); + } + + if (end < 0) + end = Dynarr_length (rba); + Dynarr_reset (buf); + + while (elt < end) + { + rb = Dynarr_atp (rba, elt); + + if (rb->findex == findex && rb->type == RUNE_CHAR + && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON + && EQ (charset, CHAR_CHARSET (rb->object.chr.ch))) + { + Dynarr_add (buf, rb->object.chr.ch); + width += rb->width; + elt++; + } + else + { + if (Dynarr_length (buf)) + { + mswindows_output_string (w, dl, buf, xpos, 0, start_pixpos, width, + findex); + xpos = rb->xpos; + width = 0; + } + Dynarr_reset (buf); + width = 0; + + if (rb->type == RUNE_CHAR) + { + findex = rb->findex; + xpos = rb->xpos; + charset = CHAR_CHARSET (rb->object.chr.ch); + + if (rb->cursor_type == CURSOR_ON) + { + if (rb->object.chr.ch == '\n') + { + mswindows_output_cursor (w, dl, xpos, cursor_width, rb); + } + else + { + Dynarr_add (buf, rb->object.chr.ch); +#if 0 + mswindows_output_string (w, dl, buf, xpos, 0, start_pixpos, + rb->width, findex, 1, + cursor_start, cursor_width, + cursor_height); +#else + mswindows_output_cursor (w, dl, xpos, cursor_width, rb); +#endif + Dynarr_reset (buf); + } + + xpos += rb->width; + elt++; + } + else if (rb->object.chr.ch == '\n') + { + /* Clear in case a cursor was formerly here. */ + int height = dl->ascent + dl->descent - dl->clip; + + mswindows_clear_region (window, findex, xpos, dl->ypos - dl->ascent, + rb->width, height); + elt++; + } + } + else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE) + { + if (rb->type == RUNE_BLANK) + mswindows_output_blank (w, dl, rb); + else + { + /* #### Our flagging of when we need to redraw the + modeline shadows sucks. Since RUNE_HLINE is only used + by the modeline at the moment it is a good bet + that if it gets redrawn then we should also + redraw the shadows. This won't be true forever. + We borrow the shadow_thickness_changed flag for + now. */ + w->shadow_thickness_changed = 1; + mswindows_output_hline (w, dl, rb); + } + + if (rb->cursor_type == CURSOR_ON) + mswindows_output_cursor (w, dl, xpos, cursor_width, rb); + + elt++; + if (elt < end) + { + rb = Dynarr_atp (rba, elt); + + findex = rb->findex; + xpos = rb->xpos; + } + } + else if (rb->type == RUNE_DGLYPH) + { + Lisp_Object instance; + + XSETWINDOW (window, w); + instance = glyph_image_instance (rb->object.dglyph.glyph, + window, ERROR_ME_NOT, 1); + findex = rb->findex; + + if (IMAGE_INSTANCEP (instance)) + switch (XIMAGE_INSTANCE_TYPE (instance)) + { + case IMAGE_TEXT: + { + /* #### This is way losing. See the comment in + add_glyph_rune(). */ + Lisp_Object string = + XIMAGE_INSTANCE_TEXT_STRING (instance); + convert_bufbyte_string_into_emchar_dynarr + (XSTRING_DATA (string), XSTRING_LENGTH (string), buf); + + if (rb->cursor_type == CURSOR_ON) + mswindows_output_cursor (w, dl, xpos, cursor_width, rb); + else + mswindows_output_string (w, dl, buf, xpos, + rb->object.dglyph.xoffset, + start_pixpos, -1, findex); + Dynarr_reset (buf); + } + break; + + case IMAGE_MONO_PIXMAP: + case IMAGE_COLOR_PIXMAP: +#if 0 + mswindows_output_pixmap (w, dl, instance, xpos, + rb->object.dglyph.xoffset, start_pixpos, + rb->width, findex, cursor_start, + cursor_width, cursor_height); +#endif + break; + + case IMAGE_POINTER: + abort (); + + case IMAGE_SUBWINDOW: + /* #### implement me */ + break; + + case IMAGE_NOTHING: + /* nothing is as nothing does */ + break; + + default: + abort (); + } + + xpos += rb->width; + elt++; + } + else + abort (); + } + } + + if (Dynarr_length (buf)) + mswindows_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex); + + if (dl->modeline + && !EQ (Qzero, w->modeline_shadow_thickness) + && (f->clear + || f->windows_structure_changed + || w->shadow_thickness_changed)) + mswindows_bevel_modeline (w, dl); + + Dynarr_free (buf); + +} + + +/***************************************************************************** + mswindows_output_vertical_divider + + Draw a vertical divider down the left side of the given window. + ****************************************************************************/ +static void +mswindows_output_vertical_divider (struct window *w, int clear) +{ + struct frame *f = XFRAME (w->frame); + Lisp_Object color; + RECT rect; + HBRUSH brush; + int shadow_width = MODELINE_SHADOW_THICKNESS (w); + + /* We don't use the normal gutter measurements here because the + horizontal scrollbars and toolbars do not stretch completely over + to the right edge of the window. Only the modeline does. */ + int modeline_height = window_modeline_height (w); + + assert(!MSWINDOWS_DIVIDER_SPACING); /* This code doesn't handle this */ + + /* XXX Not sure about this */ +#ifdef HAVE_SCROLLBARS + if (f->scrollbar_on_left) + rect.left = WINDOW_LEFT (w); + else + rect.left = WINDOW_RIGHT (w) - MSWINDOWS_DIVIDER_WIDTH; +#else + rect.left = WINDOW_LEFT (w); +#endif + rect.right = rect.left + MSWINDOWS_DIVIDER_WIDTH; + +#ifdef HAVE_SCROLLBARS + if (f->scrollbar_on_top) + rect.top = WINDOW_TOP (w); + else +#endif + rect.top = WINDOW_TEXT_TOP (w); + rect.bottom = WINDOW_BOTTOM (w) - modeline_height; + + /* Draw the divider line */ + color = WINDOW_FACE_CACHEL_BACKGROUND (w, MODELINE_INDEX); + mswindows_update_gc(FRAME_MSWINDOWS_DC(f), Qnil, Qnil, color, Qnil, Qnil); + brush = COLOR_INSTANCE_MSWINDOWS_BRUSH (XCOLOR_INSTANCE (color)); + FillRect (FRAME_MSWINDOWS_DC(f), &rect, brush); + if (shadow_width) + DrawEdge (FRAME_MSWINDOWS_DC(f), &rect, + shadow_width==1 ? BDR_RAISEDINNER : EDGE_RAISED, + BF_TOP|BF_RIGHT|BF_LEFT); +} + + +/**************************************************************************** + mswindows_text_width + + Given a string and a face, return the string's length in pixels when + displayed in the font associated with the face. + XXX FIXME: get redisplay_text_width_emchar_string() etc to pass in the + window so we can get hold of the window's frame's gc + ****************************************************************************/ +static int +mswindows_text_width (struct face_cachel *cachel, CONST Emchar *str, + Charcount len) +{ + int width_so_far = 0; + unsigned char *text_storage = (unsigned char *) alloca (2 * len); + textual_run *runs = alloca_array (textual_run, len); + int nruns; + int i; + HDC hdc=NULL; /* XXXXX FIXME! only works for non-proportional fonts! */ + + nruns = separate_textual_runs (text_storage, runs, str, len); + + for (i = 0; i < nruns; i++) + width_so_far += mswindows_text_width_single_run (hdc, cachel, runs + i); + + return width_so_far; +} + + +/**************************************************************************** + mswindows_clear_region + + Clear the area in the box defined by the given parameters using the + given face. + ****************************************************************************/ +static void +mswindows_clear_region (Lisp_Object locale, face_index findex, int x, int y, + int width, int height) +{ + struct window *w; + struct frame *f; + Lisp_Object background_pixmap = Qunbound; + Lisp_Object temp; + RECT rect = { x, y, x+width, y+height }; + HBRUSH brush; + + if (!(width && height)) /* We often seem to get called with width==0 */ + return; + + if (WINDOWP (locale)) + { + w = XWINDOW (locale); + f = XFRAME (w->frame); + } + else if (FRAMEP (locale)) + { + w = NULL; + f = XFRAME (locale); + } + else + abort (); + + if (w) + { + temp = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, findex); + + if (IMAGE_INSTANCEP (temp) + && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) + { + /* #### maybe we could implement such that a string + can be a background pixmap? */ + background_pixmap = temp; + } + } + else + { + temp = FACE_BACKGROUND_PIXMAP (Vdefault_face, locale); + + if (IMAGE_INSTANCEP (temp) + && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) + { + background_pixmap = temp; + } + } + + if (!UNBOUNDP (background_pixmap)) + { + if (XIMAGE_INSTANCE_PIXMAP_DEPTH (background_pixmap) == 0) + { + Lisp_Object fcolor, bcolor; + + if (w) + { + fcolor = WINDOW_FACE_CACHEL_FOREGROUND (w, findex); + bcolor = WINDOW_FACE_CACHEL_BACKGROUND (w, findex); + } + else + { + fcolor = FACE_FOREGROUND (Vdefault_face, locale); + bcolor = FACE_BACKGROUND (Vdefault_face, locale); + } + + mswindows_update_gc (FRAME_MSWINDOWS_DC(f), Qnil, fcolor, bcolor, background_pixmap, Qnil); + } + + /* XX FIXME: Get brush from background_pixmap here */ + assert(0); + } + else + { + Lisp_Object color = (w ? WINDOW_FACE_CACHEL_BACKGROUND (w, findex) : + FACE_BACKGROUND (Vdefault_face, locale)); + brush = COLOR_INSTANCE_MSWINDOWS_BRUSH (XCOLOR_INSTANCE (color)); + } + + FillRect (FRAME_MSWINDOWS_DC(f), &rect, brush); +} + + +/***************************************************************************** + mswindows_clear_to_window_end + + Clear the area between ypos1 and ypos2. Each margin area and the + text area is handled separately since they may each have their own + background color. + ****************************************************************************/ +static void +mswindows_clear_to_window_end (struct window *w, int ypos1, int ypos2) +{ + int height = ypos2 - ypos1; + + if (height) + { + struct frame *f = XFRAME (w->frame); + Lisp_Object window; + int bflag = (window_needs_vertical_divider (w) ? 0 : 1); + layout_bounds bounds; + + bounds = calculate_display_line_boundaries (w, bflag); + XSETWINDOW (window, w); + + if (window_is_leftmost (w)) + mswindows_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), + ypos1, FRAME_BORDER_WIDTH (f), height); + + if (bounds.left_in - bounds.left_out > 0) + mswindows_clear_region (window, + get_builtin_face_cache_index (w, Vleft_margin_face), + bounds.left_out, ypos1, + bounds.left_in - bounds.left_out, height); + + if (bounds.right_in - bounds.left_in > 0) + mswindows_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1, + bounds.right_in - bounds.left_in, height); + + if (bounds.right_out - bounds.right_in > 0) + mswindows_clear_region (window, + get_builtin_face_cache_index (w, Vright_margin_face), + bounds.right_in, ypos1, + bounds.right_out - bounds.right_in, height); + + if (window_is_rightmost (w)) + mswindows_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), + ypos1, FRAME_BORDER_WIDTH (f), height); + } + +} + + +static void +mswindows_clear_frame (struct frame *f) +{ +} + + + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +console_type_create_redisplay_mswindows (void) +{ + /* redisplay methods */ + CONSOLE_HAS_METHOD (mswindows, text_width); + CONSOLE_HAS_METHOD (mswindows, output_display_block); + CONSOLE_HAS_METHOD (mswindows, divider_width); + CONSOLE_HAS_METHOD (mswindows, divider_height); + CONSOLE_HAS_METHOD (mswindows, eol_cursor_width); + CONSOLE_HAS_METHOD (mswindows, output_vertical_divider); + CONSOLE_HAS_METHOD (mswindows, clear_to_window_end); + CONSOLE_HAS_METHOD (mswindows, clear_region); + CONSOLE_HAS_METHOD (mswindows, clear_frame); + CONSOLE_HAS_METHOD (mswindows, output_begin); + CONSOLE_HAS_METHOD (mswindows, output_end); + CONSOLE_HAS_METHOD (mswindows, flash); + CONSOLE_HAS_METHOD (mswindows, ring_bell); +} diff -r d8688acf4c5b -r 78f53ef88e17 src/redisplay-w32.c --- a/src/redisplay-w32.c Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1184 +0,0 @@ -/* win32 output and frame manipulation routines. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1994 Lucid, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Chuck Thompson - Lots of work done by Ben Wing for Mule - Partially rewritten for win32 by Jonathan Harris, November 1997 for 20.4. - */ - -#include -#include "lisp.h" - -#include "console-w32.h" -#include "objects-w32.h" - -#include "buffer.h" -#include "debug.h" -#include "events.h" -#include "faces.h" -#include "frame.h" -#include "glyphs.h" /* XXX FIXME: Should be glyphs-w32 when we make one */ -#include "redisplay.h" -#include "sysdep.h" -#include "window.h" - -#include "windows.h" - -/* W32_DIVIDER_LINE_WIDTH is the width of the line drawn in the gutter. - W32_DIVIDER_SPACING is the amount of blank space on each side of the line. - W32_DIVIDER_WIDTH = W32_DIVIDER_LINE_WIDTH + 2*W32_DIVIDER_SPACING -*/ -#define W32_DIVIDER_LINE_WIDTH 5 -#define W32_DIVIDER_SPACING 0 -#define W32_DIVIDER_WIDTH (W32_DIVIDER_LINE_WIDTH + 2 * W32_DIVIDER_SPACING) - -#define W32_EOL_CURSOR_WIDTH 5 - -/* - * Random forward delarations - */ -static void w32_clear_region (Lisp_Object locale, face_index findex, - int x, int y, int width, int height); -static void w32_output_vertical_divider (struct window *w, int clear); -static void w32_redraw_exposed_windows (Lisp_Object window, int x, - int y, int width, int height); - - - -typedef struct textual_run -{ - Lisp_Object charset; - unsigned char *ptr; - int len; - int dimension; -} textual_run; - -/* Separate out the text in DYN into a series of textual runs of a - particular charset. Also convert the characters as necessary into - the format needed by XDrawImageString(), XDrawImageString16(), et - al. (This means converting to one or two byte format, possibly - tweaking the high bits, and possibly running a CCL program.) You - must pre-allocate the space used and pass it in. (This is done so - you can alloca() the space.) You need to allocate (2 * len) bytes - of TEXT_STORAGE and (len * sizeof (textual_run)) bytes of - RUN_STORAGE, where LEN is the length of the dynarr. - - Returns the number of runs actually used. */ - -static int -separate_textual_runs (unsigned char *text_storage, - textual_run *run_storage, - CONST Emchar *str, Charcount len) -{ - Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a - possible valid charset when - MULE is not defined */ - int runs_so_far = 0; - int i; -#ifdef MULE - struct ccl_program char_converter; - int need_ccl_conversion = 0; -#endif - - for (i = 0; i < len; i++) - { - Emchar ch = str[i]; - Lisp_Object charset; - int byte1, byte2; - int dimension; - int graphic; - - BREAKUP_CHAR (ch, charset, byte1, byte2); - dimension = XCHARSET_DIMENSION (charset); - graphic = XCHARSET_GRAPHIC (charset); - - if (!EQ (charset, prev_charset)) - { - run_storage[runs_so_far].ptr = text_storage; - run_storage[runs_so_far].charset = charset; - run_storage[runs_so_far].dimension = dimension; - - if (runs_so_far) - { - run_storage[runs_so_far - 1].len = - text_storage - run_storage[runs_so_far - 1].ptr; - if (run_storage[runs_so_far - 1].dimension == 2) - run_storage[runs_so_far - 1].len >>= 1; - } - runs_so_far++; - prev_charset = charset; -#ifdef MULE - { - Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset); - need_ccl_conversion = !NILP (ccl_prog); - if (need_ccl_conversion) - set_ccl_program (&char_converter, ccl_prog, 0, 0, 0); - } -#endif - } - - if (graphic == 0) - { - byte1 &= 0x7F; - byte2 &= 0x7F; - } - else if (graphic == 1) - { - byte1 |= 0x80; - byte2 |= 0x80; - } -#ifdef MULE - if (need_ccl_conversion) - { - char_converter.reg[0] = byte1; - char_converter.reg[1] = byte2; - char_converter.ic = 0; /* start at beginning each time */ - ccl_driver (&char_converter, 0, 0, 0, 0); - byte1 = char_converter.reg[0]; - byte2 = char_converter.reg[1]; - } -#endif - *text_storage++ = (unsigned char) byte1; - if (dimension == 2) - *text_storage++ = (unsigned char) byte2; - } - - if (runs_so_far) - { - run_storage[runs_so_far - 1].len = - text_storage - run_storage[runs_so_far - 1].ptr; - if (run_storage[runs_so_far - 1].dimension == 2) - run_storage[runs_so_far - 1].len >>= 1; - } - - return runs_so_far; -} - - -static int -w32_text_width_single_run (HDC hdc, struct face_cachel *cachel, - textual_run *run) -{ - Lisp_Object font_inst = FACE_CACHEL_FONT (cachel, run->charset); - struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_inst); - SIZE size; - -#if 0 /* XXX HACK: w32_text_width is broken and will pass in a NULL hdc */ - if (!fi->proportional_p) -#else - if (!fi->proportional_p || !hdc) -#endif - return (fi->width * run->len); - else - { - assert(run->dimension == 1); /* XXX FIXME! */ - GetTextExtentPoint32(hdc, run->ptr, run->len, &size); - return(size.cx); - } -} - - -/***************************************************************************** - w32_update_gc - - Given a number of parameters munge the GC so it has those properties. - ****************************************************************************/ -static void -w32_update_gc (HDC hdc, Lisp_Object font, Lisp_Object fg, Lisp_Object bg, - Lisp_Object bg_pmap, Lisp_Object lwidth) -{ - if (!NILP (font)) - SelectObject(hdc, (XFONT_INSTANCE (font))->data); - - /* evil kludge! - XXX do we need this? */ - if (!NILP (fg) && !COLOR_INSTANCEP (fg)) - { - fprintf (stderr, "Help! w32_update_gc got a bogus fg value! fg = "); - debug_print (fg); - fg = Qnil; - } - - if (!NILP (fg)) - SetTextColor (hdc, COLOR_INSTANCE_W32_COLOR (XCOLOR_INSTANCE (fg))); - - if (!NILP (bg)) - SetBkColor (hdc, COLOR_INSTANCE_W32_COLOR (XCOLOR_INSTANCE (bg))); - -#if 0 /* XXX Implement me */ - /* I expect that the Lisp_Image_Instance's data will point to a brush */ - if (IMAGE_INSTANCEP (bg_pmap) - && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) - { - if (XIMAGE_INSTANCE_PIXMAP_DEPTH (bg_pmap) == 0) - { - gcv.fill_style = FillOpaqueStippled; - gcv.stipple = XIMAGE_INSTANCE_X_PIXMAP (bg_pmap); - mask |= (GCStipple | GCFillStyle); - } - else - { - gcv.fill_style = FillTiled; - gcv.tile = XIMAGE_INSTANCE_X_PIXMAP (bg_pmap); - mask |= (GCTile | GCFillStyle); - } - } -#endif - -#if 0 /* XXX FIXME */ - if (!NILP (lwidth)) - { - gcv.line_width = XINT (lwidth); - mask |= GCLineWidth; - } -#endif -} - - -/***************************************************************************** - w32_output_hline - - Output a horizontal line in the foreground of its face. - ****************************************************************************/ -static void -w32_output_hline (struct window *w, struct display_line *dl, struct rune *rb) -{ /* XXX Implement me */ -} - - -/***************************************************************************** - w32_output_blank - - Output a blank by clearing the area it covers in the background color - of its face. - ****************************************************************************/ -static void -w32_output_blank (struct window *w, struct display_line *dl, struct rune *rb) -{ - struct frame *f = XFRAME (w->frame); - RECT rect = { rb->xpos, dl->ypos-dl->ascent, - rb->xpos+rb->width, dl->ypos+dl->descent-dl->clip }; - struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, rb->findex); - - Lisp_Object bg_pmap = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, rb->findex); - - if (!IMAGE_INSTANCEP (bg_pmap) - || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) - bg_pmap = Qnil; - - FillRect (FRAME_W32_DC (f), &rect, - COLOR_INSTANCE_W32_BRUSH (XCOLOR_INSTANCE (cachel->background))); -} - - -/***************************************************************************** - w32_output_cursor - - Draw a normal or end-of-line cursor. The end-of-line cursor is - narrower than the normal cursor. - ****************************************************************************/ -static void -w32_output_cursor (struct window *w, struct display_line *dl, int xpos, - int width, struct rune *rb) -{ - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - struct face_cachel *cachel; - Lisp_Object font; - int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - HBRUSH brush; - HDC hdc = FRAME_W32_DC (f); - int real_char_p = (rb->type == RUNE_CHAR && rb->object.chr.ch != '\n'); - RECT rect = { xpos, - dl->ypos - dl->ascent, - xpos + width, - dl->ypos + dl->descent - dl->clip}; - -#if 0 /* XXX FIXME: Whar about the bar_cursor? */ - Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor, - WINDOW_BUFFER (w)); -#endif - - if (real_char_p) - { - /* Use the font from the underlying character */ - cachel = WINDOW_FACE_CACHEL (w, rb->findex); - - /* XXX MULE: Need to know the charset! */ - font = FACE_CACHEL_FONT (cachel, Vcharset_ascii); - } - - /* Clear the area */ - if (focus) - cachel = WINDOW_FACE_CACHEL (w, - get_builtin_face_cache_index (w, Vtext_cursor_face)); - else if (!real_char_p) - cachel = WINDOW_FACE_CACHEL (w, rb->findex); - - brush = COLOR_INSTANCE_W32_BRUSH (XCOLOR_INSTANCE (cachel->background)); - FillRect (hdc, &rect, brush); - - if (real_char_p) - { - /* XXX FIXME: Need to clip if dl->clip!=0. How rare is this case? */ - /* Output the underlying character */ - w32_update_gc (hdc, font, cachel->foreground, - cachel->background, Qnil, Qnil); - TextOut(hdc, xpos, dl->ypos, (char*) &rb->object.chr.ch, 1); - } - - if (!focus) - { - /* Draw hollow rectangle in cursor's background color */ - cachel = WINDOW_FACE_CACHEL (w, - get_builtin_face_cache_index (w, Vtext_cursor_face)); - brush = COLOR_INSTANCE_W32_BRUSH (XCOLOR_INSTANCE (cachel->background)); - FrameRect (hdc, &rect, brush); - } -} - - -/***************************************************************************** - w32_output_string - - Given a string and a starting position, output that string in the - given face. - Correctly handles multiple charsets in the string. - - The meaning of the parameters is something like this: - - W Window that the text is to be displayed in. - DL Display line that this text is on. The values in the - structure are used to determine the vertical position and - clipping range of the text. - BUF Dynamic array of Emchars specifying what is actually to be - drawn. - XPOS X position in pixels where the text should start being drawn. - XOFFSET Number of pixels to be chopped off the left side of the - text. The effect is as if the text were shifted to the - left this many pixels and clipped at XPOS. - CLIP_START Clip everything left of this X position. - WIDTH Clip everything right of XPOS + WIDTH. - FINDEX Index for the face cache element describing how to display - the text. - ****************************************************************************/ -void -w32_output_string (struct window *w, struct display_line *dl, - Emchar_dynarr *buf, int xpos, int xoffset, int clip_start, - int width, face_index findex) -{ - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - Lisp_Object window = Qnil; - HDC hdc; - int clip_end; - Lisp_Object bg_pmap; - int len = Dynarr_length (buf); - unsigned char *text_storage = (unsigned char *) alloca (2 * len); - textual_run *runs = alloca_array (textual_run, len); - int nruns; - int i; - struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex); - - XSETWINDOW (window, w); - hdc = FRAME_W32_DC(f); - -#if 0 /* XXX: FIXME? */ - /* We can't work out the width before we've set the font in the DC */ - if (width < 0) - width = w32_text_width (cachel, Dynarr_atp (buf, 0), Dynarr_length (buf)); -#else - assert(width>=0); -#endif - - /* Regularize the variables passed in. */ - if (clip_start < xpos) - clip_start = xpos; - clip_end = xpos + width; - if (clip_start >= clip_end) - /* It's all clipped out. */ - return; - - xpos -= xoffset; - - nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), - Dynarr_length (buf)); - - bg_pmap = cachel->background_pixmap; - if (!IMAGE_INSTANCEP (bg_pmap) - || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) - bg_pmap = Qnil; - - for (i = 0; i < nruns; i++) - { - Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset); - struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font); - int this_width; - int need_clipping; - RECT rect = { clip_start, dl->ypos - dl->ascent, - clip_end, dl->ypos + dl->descent - dl->clip }; - HRGN region; - - if (EQ (font, Vthe_null_font_instance)) - continue; - - w32_update_gc (hdc, font, cachel->foreground, - cachel->background, Qnil, Qnil); - - this_width = w32_text_width_single_run (hdc, cachel, runs + i); - need_clipping = (dl->clip || clip_start > xpos || - clip_end < xpos + this_width); - - if (need_clipping) - { - region = CreateRectRgn (rect.left, rect.top, - rect.right, rect.bottom); - SelectClipRgn (hdc, region); - } - - /* TextOut only clears the area equal to the height of - the given font. It is possible that a font is being displayed - on a line taller than it is, so this would cause us to fail to - clear some areas. */ - if (fi->ascent < dl->ascent || fi->descent < dl->descent-dl->clip) - FillRect (hdc, &rect, - COLOR_INSTANCE_W32_BRUSH (XCOLOR_INSTANCE (cachel->background))); - - assert (runs[i].dimension == 1); /* XXX FIXME */ - TextOut(hdc, xpos, dl->ypos, (char *) runs[i].ptr, runs[i].len); - - /* XXX FIXME? X does underline/strikethrough here - we will do it as part of face's font */ - - if (need_clipping) - { - SelectClipRgn (hdc, NULL); - DeleteObject (region); - } - - xpos += this_width; - } -} - -/***************************************************************************** - w32_redraw_exposed_window - - Given a bounding box for an area that needs to be redrawn, determine - what parts of what lines are contained within and re-output their - contents. - Copied from redisplay-x.c - ****************************************************************************/ -static void -w32_redraw_exposed_window (struct window *w, int x, int y, int width, - int height) -{ - struct frame *f = XFRAME (w->frame); - int line; - int start_x, start_y, end_x, end_y; - int orig_windows_structure_changed; - - display_line_dynarr *cdla = window_display_lines (w, CURRENT_DISP); - - if (!NILP (w->vchild)) - { - w32_redraw_exposed_windows (w->vchild, x, y, width, height); - return; - } - else if (!NILP (w->hchild)) - { - w32_redraw_exposed_windows (w->hchild, x, y, width, height); - return; - } - - /* If the window doesn't intersect the exposed region, we're done here. */ - if (x >= WINDOW_RIGHT (w) || (x + width) <= WINDOW_LEFT (w) - || y >= WINDOW_BOTTOM (w) || (y + height) <= WINDOW_TOP (w)) - { - return; - } - else - { - start_x = max (WINDOW_LEFT (w), x); - end_x = min (WINDOW_RIGHT (w), (x + width)); - start_y = max (WINDOW_TOP (w), y); - end_y = min (WINDOW_BOTTOM (w), y + height); - - /* We do this to make sure that the 3D modelines get redrawn if - they are in the exposed region. */ - orig_windows_structure_changed = f->windows_structure_changed; - f->windows_structure_changed = 1; - } - - if (window_needs_vertical_divider (w)) - { - w32_output_vertical_divider (w, 0); - } - - for (line = 0; line < Dynarr_length (cdla); line++) - { - struct display_line *cdl = Dynarr_atp (cdla, line); - int top_y = cdl->ypos - cdl->ascent; - int bottom_y = cdl->ypos + cdl->descent; - - if (bottom_y >= start_y) - { - if (top_y > end_y) - { - if (line == 0) - continue; - else - break; - } - else - { - output_display_line (w, 0, cdla, line, start_x, end_x); - } - } - } - - f->windows_structure_changed = orig_windows_structure_changed; - - /* If there have never been any face cache_elements created, then this - expose event doesn't actually have anything to do. */ - if (Dynarr_largest (w->face_cachels)) - redisplay_clear_bottom_of_window (w, cdla, start_y, end_y); -} - -/***************************************************************************** - w32_redraw_exposed_windows - - For each window beneath the given window in the window hierarchy, - ensure that it is redrawn if necessary after an Expose event. - ****************************************************************************/ -static void -w32_redraw_exposed_windows (Lisp_Object window, int x, int y, int width, - int height) -{ - for (; !NILP (window); window = XWINDOW (window)->next) - w32_redraw_exposed_window (XWINDOW (window), x, y, width, height); -} - -/***************************************************************************** - w32_redraw_exposed_area - - For each window on the given frame, ensure that any area in the - Exposed area is redrawn. - ****************************************************************************/ -void -w32_redraw_exposed_area (struct frame *f, int x, int y, int width, int height) -{ - /* If any window on the frame has had its face cache reset then the - redisplay structures are effectively invalid. If we attempt to - use them we'll blow up. We mark the frame as changed to ensure - that redisplay will do a full update. This probably isn't - necessary but it can't hurt. */ - - if (!f->window_face_cache_reset) - w32_redraw_exposed_windows (f->root_window, x, y, width, height); - else - MARK_FRAME_CHANGED (f); -} - - -/***************************************************************************** - w32_bevel_modeline - - Draw a 3d border around the modeline on window W. - ****************************************************************************/ -static void -w32_bevel_modeline (struct window *w, struct display_line *dl) -{ - struct frame *f = XFRAME (w->frame); - Lisp_Object color; - RECT rect = { WINDOW_MODELINE_LEFT (w), - dl->ypos - dl->ascent, - WINDOW_MODELINE_RIGHT (w), - dl->ypos + dl->descent}; - - - color = WINDOW_FACE_CACHEL_BACKGROUND (w, MODELINE_INDEX); - w32_update_gc(FRAME_W32_DC(f), Qnil, Qnil, color, Qnil, Qnil); - -#if 0 /* XXX Eh? */ - if (XINT (w->modeline_shadow_thickness) < 0) - { - GC temp; - - temp = top_shadow_gc; - top_shadow_gc = bottom_shadow_gc; - bottom_shadow_gc = temp; - } -#endif - - DrawEdge (FRAME_W32_DC(f), &rect, BDR_RAISEDINNER, BF_RECT); -} - - -/***************************************************************************** - #### Display methods -/***************************************************************************** - -/***************************************************************************** - w32_divider_width - - Return the width of the vertical divider. - ****************************************************************************/ -static int -w32_divider_width (void) -{ - return W32_DIVIDER_WIDTH; -} - -/***************************************************************************** - w32_divider_height - - Return the height of the horizontal divider. - ****************************************************************************/ -static int -w32_divider_height (void) -{ - return 1; /* XXX Copied from redisplay-X.c. What is this? */ -} - -/***************************************************************************** - w32_eol_cursor_width - - Return the width of the end-of-line cursor. - ****************************************************************************/ -static int -w32_eol_cursor_width (void) -{ - return W32_EOL_CURSOR_WIDTH; -} - -/***************************************************************************** - w32_output_begin - - Perform any necessary initialization prior to an update. - ****************************************************************************/ -static void -w32_output_begin (struct device *d) -{ -} - -/***************************************************************************** - w32_output_end - - Perform any necessary flushing of queues when an update has completed. - ****************************************************************************/ -static void -w32_output_end (struct device *d) -{ -} - -static int -w32_flash (struct device *d) -{ - struct frame *f = device_selected_frame (d); - - /* XXX FIXME: Do something more visible here, maybe involving a timer */ - FlashWindow (FRAME_W32_HANDLE (f), TRUE); - FlashWindow (FRAME_W32_HANDLE (f), FALSE); -} - -static void -w32_ring_bell (struct device *d, int volume, int pitch, int duration) -{ - /* XXX FIXME: I'm guessing pitch=Hz and duration is milliseconds */ - - if ((pitch|duration) == -1) /* Pitch and/or duration may be bogus */ - MessageBeep(-1); /* Default system sound via speaker */ - else - Beep(pitch, duration); -} - - -/***************************************************************************** - w32_output_display_block - - Given a display line, a block number for that start line, output all - runes between start and end in the specified display block. - Ripped off with mininmal thought from the corresponding X routine. - ****************************************************************************/ -static void -w32_output_display_block (struct window *w, struct display_line *dl, int block, - int start, int end, int start_pixpos, int cursor_start, - int cursor_width, int cursor_height) -{ - struct frame *f = XFRAME (w->frame); - Emchar_dynarr *buf = Dynarr_new (Emchar); - Lisp_Object window; - - struct display_block *db = Dynarr_atp (dl->display_blocks, block); - rune_dynarr *rba = db->runes; - struct rune *rb; - - int elt = start; - face_index findex; - int xpos, width; - Lisp_Object charset = Qunbound; /* Qnil is a valid charset when - MULE is not defined */ - XSETWINDOW (window, w); - rb = Dynarr_atp (rba, start); - - if (!rb) - { - /* Nothing to do so don't do anything. */ - return; - } - else - { - findex = rb->findex; - xpos = rb->xpos; - width = 0; - if (rb->type == RUNE_CHAR) - charset = CHAR_CHARSET (rb->object.chr.ch); - } - - if (end < 0) - end = Dynarr_length (rba); - Dynarr_reset (buf); - - while (elt < end) - { - rb = Dynarr_atp (rba, elt); - - if (rb->findex == findex && rb->type == RUNE_CHAR - && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON - && EQ (charset, CHAR_CHARSET (rb->object.chr.ch))) - { - Dynarr_add (buf, rb->object.chr.ch); - width += rb->width; - elt++; - } - else - { - if (Dynarr_length (buf)) - { - w32_output_string (w, dl, buf, xpos, 0, start_pixpos, width, - findex); - xpos = rb->xpos; - width = 0; - } - Dynarr_reset (buf); - width = 0; - - if (rb->type == RUNE_CHAR) - { - findex = rb->findex; - xpos = rb->xpos; - charset = CHAR_CHARSET (rb->object.chr.ch); - - if (rb->cursor_type == CURSOR_ON) - { - if (rb->object.chr.ch == '\n') - { - w32_output_cursor (w, dl, xpos, cursor_width, rb); - } - else - { - Dynarr_add (buf, rb->object.chr.ch); -#if 0 - w32_output_string (w, dl, buf, xpos, 0, start_pixpos, - rb->width, findex, 1, - cursor_start, cursor_width, - cursor_height); -#else - w32_output_cursor (w, dl, xpos, cursor_width, rb); -#endif - Dynarr_reset (buf); - } - - xpos += rb->width; - elt++; - } - else if (rb->object.chr.ch == '\n') - { - /* Clear in case a cursor was formerly here. */ - int height = dl->ascent + dl->descent - dl->clip; - - w32_clear_region (window, findex, xpos, dl->ypos - dl->ascent, - rb->width, height); - elt++; - } - } - else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE) - { - if (rb->type == RUNE_BLANK) - w32_output_blank (w, dl, rb); - else - { - /* #### Our flagging of when we need to redraw the - modeline shadows sucks. Since RUNE_HLINE is only used - by the modeline at the moment it is a good bet - that if it gets redrawn then we should also - redraw the shadows. This won't be true forever. - We borrow the shadow_thickness_changed flag for - now. */ - w->shadow_thickness_changed = 1; - w32_output_hline (w, dl, rb); - } - - if (rb->cursor_type == CURSOR_ON) - w32_output_cursor (w, dl, xpos, cursor_width, rb); - - elt++; - if (elt < end) - { - rb = Dynarr_atp (rba, elt); - - findex = rb->findex; - xpos = rb->xpos; - } - } - else if (rb->type == RUNE_DGLYPH) - { - Lisp_Object instance; - - XSETWINDOW (window, w); - instance = glyph_image_instance (rb->object.dglyph.glyph, - window, ERROR_ME_NOT, 1); - findex = rb->findex; - - if (IMAGE_INSTANCEP (instance)) - switch (XIMAGE_INSTANCE_TYPE (instance)) - { - case IMAGE_TEXT: - { - /* #### This is way losing. See the comment in - add_glyph_rune(). */ - Lisp_Object string = - XIMAGE_INSTANCE_TEXT_STRING (instance); - convert_bufbyte_string_into_emchar_dynarr - (XSTRING_DATA (string), XSTRING_LENGTH (string), buf); - - if (rb->cursor_type == CURSOR_ON) - w32_output_cursor (w, dl, xpos, cursor_width, rb); - else - w32_output_string (w, dl, buf, xpos, - rb->object.dglyph.xoffset, - start_pixpos, -1, findex); - Dynarr_reset (buf); - } - break; - - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: -#if 0 - w32_output_pixmap (w, dl, instance, xpos, - rb->object.dglyph.xoffset, start_pixpos, - rb->width, findex, cursor_start, - cursor_width, cursor_height); -#endif - break; - - case IMAGE_POINTER: - abort (); - - case IMAGE_SUBWINDOW: - /* #### implement me */ - break; - - case IMAGE_NOTHING: - /* nothing is as nothing does */ - break; - - default: - abort (); - } - - xpos += rb->width; - elt++; - } - else - abort (); - } - } - - if (Dynarr_length (buf)) - w32_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex); - - if (dl->modeline - && !EQ (Qzero, w->modeline_shadow_thickness) -#if 1 /* Writing to the modeline overwrites the bevels */ - ) -#else - && (f->clear - || f->windows_structure_changed - || w->shadow_thickness_changed)) -#endif - w32_bevel_modeline (w, dl); - - Dynarr_free (buf); - -} - - -/***************************************************************************** - w32_output_vertical_divider - - Draw a vertical divider down the left side of the given window. - ****************************************************************************/ -static void -w32_output_vertical_divider (struct window *w, int clear) -{ - struct frame *f = XFRAME (w->frame); - Lisp_Object color; - RECT rect; - HBRUSH brush; - - /* We don't use the normal gutter measurements here because the - horizontal scrollbars and toolbars do not stretch completely over - to the right edge of the window. Only the modeline does. */ - int modeline_height = window_modeline_height (w); - - assert(!W32_DIVIDER_SPACING); /* This code doesn't handle this */ - - /* XXX Not sure about this */ -#ifdef HAVE_SCROLLBARS - if (f->scrollbar_on_left) - rect.left = WINDOW_LEFT (w); - else - rect.left = WINDOW_RIGHT (w) - W32_DIVIDER_WIDTH; -#else - rect.left = WINDOW_LEFT (w); -#endif - rect.right = rect.left + W32_DIVIDER_WIDTH; - -#ifdef HAVE_SCROLLBARS - if (f->scrollbar_on_top) - rect.top = WINDOW_TOP (w); - else -#endif - rect.top = WINDOW_TEXT_TOP (w); - rect.bottom = WINDOW_BOTTOM (w) - modeline_height; - - /* Draw the divider line */ - color = WINDOW_FACE_CACHEL_BACKGROUND (w, MODELINE_INDEX); - w32_update_gc(FRAME_W32_DC(f), Qnil, Qnil, color, Qnil, Qnil); - brush = COLOR_INSTANCE_W32_BRUSH (XCOLOR_INSTANCE (color)); - FillRect (FRAME_W32_DC(f), &rect, brush); - DrawEdge (FRAME_W32_DC(f), &rect, BDR_RAISEDINNER, BF_RECT); -} - - -/**************************************************************************** - w32_text_width - - Given a string and a face, return the string's length in pixels when - displayed in the font associated with the face. - XXX FIXME: get redisplay_text_width_emchar_string() etc to pass in the - window so we can get hold of the window's frame's gc - ****************************************************************************/ -static int -w32_text_width (struct face_cachel *cachel, CONST Emchar *str, - Charcount len) -{ - int width_so_far = 0; - unsigned char *text_storage = (unsigned char *) alloca (2 * len); - textual_run *runs = alloca_array (textual_run, len); - int nruns; - int i; - HDC hdc=NULL; /* XXXXX FIXME! only works for non-proportional fonts! */ - - nruns = separate_textual_runs (text_storage, runs, str, len); - - for (i = 0; i < nruns; i++) - width_so_far += w32_text_width_single_run (hdc, cachel, runs + i); - - return width_so_far; -} - - -/**************************************************************************** - w32_clear_region - - Clear the area in the box defined by the given parameters using the - given face. - ****************************************************************************/ -static void -w32_clear_region (Lisp_Object locale, face_index findex, int x, int y, - int width, int height) -{ - struct window *w; - struct frame *f; - Lisp_Object background_pixmap = Qunbound; - Lisp_Object temp; - RECT rect = { x, y, x+width, y+height }; - HBRUSH brush; - - if (!(width && height)) /* We often seem to get called with width==0 */ - return; - - if (WINDOWP (locale)) - { - w = XWINDOW (locale); - f = XFRAME (w->frame); - } - else if (FRAMEP (locale)) - { - w = NULL; - f = XFRAME (locale); - } - else - abort (); - - if (w) - { - temp = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, findex); - - if (IMAGE_INSTANCEP (temp) - && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) - { - /* #### maybe we could implement such that a string - can be a background pixmap? */ - background_pixmap = temp; - } - } - else - { - temp = FACE_BACKGROUND_PIXMAP (Vdefault_face, locale); - - if (IMAGE_INSTANCEP (temp) - && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) - { - background_pixmap = temp; - } - } - - if (!UNBOUNDP (background_pixmap)) - { - if (XIMAGE_INSTANCE_PIXMAP_DEPTH (background_pixmap) == 0) - { - Lisp_Object fcolor, bcolor; - - if (w) - { - fcolor = WINDOW_FACE_CACHEL_FOREGROUND (w, findex); - bcolor = WINDOW_FACE_CACHEL_BACKGROUND (w, findex); - } - else - { - fcolor = FACE_FOREGROUND (Vdefault_face, locale); - bcolor = FACE_BACKGROUND (Vdefault_face, locale); - } - - w32_update_gc (FRAME_W32_DC(f), Qnil, fcolor, bcolor, background_pixmap, Qnil); - } - - /* XX FIXME: Get brush from background_pixmap here */ - assert(0); - } - else - { - Lisp_Object color = (w ? WINDOW_FACE_CACHEL_BACKGROUND (w, findex) : - FACE_BACKGROUND (Vdefault_face, locale)); - brush = COLOR_INSTANCE_W32_BRUSH (XCOLOR_INSTANCE (color)); - } - - FillRect (FRAME_W32_DC(f), &rect, brush); -} - - -/***************************************************************************** - w32_clear_to_window_end - - Clear the area between ypos1 and ypos2. Each margin area and the - text area is handled separately since they may each have their own - background color. - ****************************************************************************/ -static void -w32_clear_to_window_end (struct window *w, int ypos1, int ypos2) -{ - int height = ypos2 - ypos1; - - if (height) - { - struct frame *f = XFRAME (w->frame); - Lisp_Object window; - int bflag = (window_needs_vertical_divider (w) ? 0 : 1); - layout_bounds bounds; - - bounds = calculate_display_line_boundaries (w, bflag); - XSETWINDOW (window, w); - - if (window_is_leftmost (w)) - w32_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); - - if (bounds.left_in - bounds.left_out > 0) - w32_clear_region (window, - get_builtin_face_cache_index (w, Vleft_margin_face), - bounds.left_out, ypos1, - bounds.left_in - bounds.left_out, height); - - if (bounds.right_in - bounds.left_in > 0) - w32_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1, - bounds.right_in - bounds.left_in, height); - - if (bounds.right_out - bounds.right_in > 0) - w32_clear_region (window, - get_builtin_face_cache_index (w, Vright_margin_face), - bounds.right_in, ypos1, - bounds.right_out - bounds.right_in, height); - - if (window_is_rightmost (w)) - w32_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); - } - -} - - -static void -w32_clear_frame (struct frame *f) -{ -} - - - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -console_type_create_redisplay_w32 (void) -{ - /* redisplay methods */ - CONSOLE_HAS_METHOD (w32, text_width); - CONSOLE_HAS_METHOD (w32, output_display_block); - CONSOLE_HAS_METHOD (w32, divider_width); - CONSOLE_HAS_METHOD (w32, divider_height); - CONSOLE_HAS_METHOD (w32, eol_cursor_width); - CONSOLE_HAS_METHOD (w32, output_vertical_divider); - CONSOLE_HAS_METHOD (w32, clear_to_window_end); - CONSOLE_HAS_METHOD (w32, clear_region); - CONSOLE_HAS_METHOD (w32, clear_frame); - CONSOLE_HAS_METHOD (w32, output_begin); - CONSOLE_HAS_METHOD (w32, output_end); - CONSOLE_HAS_METHOD (w32, flash); - CONSOLE_HAS_METHOD (w32, ring_bell); -} diff -r d8688acf4c5b -r 78f53ef88e17 src/redisplay-x.c --- a/src/redisplay-x.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/redisplay-x.c Mon Aug 13 10:06:47 2007 +0200 @@ -48,6 +48,7 @@ #include "sysproc.h" /* for select() */ #ifdef MULE +#include "mule-ccl.h" #include "mule-coding.h" /* for CCL conversion */ #endif @@ -184,7 +185,7 @@ Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset); need_ccl_conversion = !NILP (ccl_prog); if (need_ccl_conversion) - set_ccl_program (&char_converter, ccl_prog, 0, 0, 0); + setup_ccl_program (&char_converter, ccl_prog); } #endif } @@ -202,12 +203,12 @@ #ifdef MULE if (need_ccl_conversion) { - char_converter.reg[0] = byte1; - char_converter.reg[1] = byte2; - char_converter.ic = 0; /* start at beginning each time */ + char_converter.reg[0] = XCHARSET_ID (charset); + char_converter.reg[1] = byte1; + char_converter.reg[2] = byte2; ccl_driver (&char_converter, 0, 0, 0, 0); - byte1 = char_converter.reg[0]; - byte2 = char_converter.reg[1]; + byte1 = char_converter.reg[1]; + byte2 = char_converter.reg[2]; } #endif *text_storage++ = (unsigned char) byte1; diff -r d8688acf4c5b -r 78f53ef88e17 src/redisplay.c --- a/src/redisplay.c Mon Aug 13 10:05:53 2007 +0200 +++ b/src/redisplay.c Mon Aug 13 10:06:47 2007 +0200 @@ -8117,16 +8117,17 @@ } #endif /* HAVE_X_WINDOWS */ -#ifdef HAVE_W32GUI - if (!strcmp (display_use, "w32")) +#ifdef HAVE_MS_WINDOWS + if (!strcmp (display_use, "mswindows")) { /* Some stuff checks this way early. */ - Vwindow_system = Qw32; - Vinitial_window_system = Qw32; + Vwindow_system = Qmswindows; + Vinitial_window_system = Qmswindows; return; } -#endif /* HAVE_W32GUI */ - +#endif /* HAVE_MS_WINDOWS */ + +#ifdef HAVE_TTY /* If no window system has been specified, try to use the terminal. */ if (!isatty (0)) { @@ -8142,6 +8143,14 @@ } Vinitial_window_system = Qtty; + return; +#else /* not HAVE_TTY */ + /* No DISPLAY specified, and no TTY support. */ + stderr_out ("XEmacs: Cannot open display.\n\ +Please set the environmental variable DISPLAY to an appropriate value.\n"); + exit (1); +#endif + /* Unreached. */ } void diff -r d8688acf4c5b -r 78f53ef88e17 src/s/freebsd.h --- a/src/s/freebsd.h Mon Aug 13 10:05:53 2007 +0200 +++ b/src/s/freebsd.h Mon Aug 13 10:06:47 2007 +0200 @@ -100,10 +100,3 @@ /* Needed to avoid hanging when child process writes an error message and exits -- enami tsugutomo . */ #define vfork fork - -/* To avoid a failure of configure's check for timezone ... - FreeBSD actualy has `extern long timezone'. */ -#ifndef HAVE_TIMEZONE_DECL -#define HAVE_TIMEZONE_DECL 1 -#endif - diff -r d8688acf4c5b -r 78f53ef88e17 src/symsinit.h --- a/src/symsinit.h Mon Aug 13 10:05:53 2007 +0200 +++ b/src/symsinit.h Mon Aug 13 10:06:47 2007 +0200 @@ -55,13 +55,13 @@ void syms_of_cmdloop (void); void syms_of_cmds (void); void syms_of_console_tty (void); -void syms_of_console_w32 (void); +void syms_of_console_mswindows (void); void syms_of_console (void); void syms_of_data (void); void syms_of_dbm (void); void syms_of_debug (void); void syms_of_device_tty (void); -void syms_of_device_w32 (void); +void syms_of_device_mswindows (void); void syms_of_device_x (void); void syms_of_device (void); void syms_of_dialog_x (void); @@ -74,7 +74,7 @@ void syms_of_energize (void); void syms_of_eval (void); void syms_of_event_stream (void); -void syms_of_event_w32 (void); +void syms_of_event_mswindows (void); void syms_of_event_Xt (void); void syms_of_events (void); void syms_of_extents (void); @@ -85,7 +85,7 @@ void syms_of_fns (void); void syms_of_font_lock (void); void syms_of_frame (void); -void syms_of_frame_w32 (void); +void syms_of_frame_mswindows (void); void syms_of_frame_x (void); void syms_of_free_hook (void); void syms_of_general (void); @@ -111,7 +111,7 @@ void syms_of_mule_wnn (void); void syms_of_objects_tty (void); void syms_of_objects_x (void); -void syms_of_objects_w32 (void); +void syms_of_objects_mswindows (void); void syms_of_objects (void); void syms_of_print (void); void syms_of_process (void); @@ -195,13 +195,13 @@ void vars_of_cmds (void); void vars_of_console (void); void vars_of_console_stream (void); -void vars_of_console_w32 (void); +void vars_of_console_mswindows (void); void vars_of_console_tty (void); void vars_of_data (void); void vars_of_dbm (void); void vars_of_debug (void); void vars_of_device (void); -void vars_of_device_w32 (void); +void vars_of_device_mswindows (void); void vars_of_device_x (void); void vars_of_dialog (void); void vars_of_dialog_x (void); @@ -214,7 +214,7 @@ void vars_of_eval (void); void vars_of_event_stream (void); void vars_of_event_tty (void); -void vars_of_event_w32 (void); +void vars_of_event_mswindows (void); void vars_of_event_Xt (void); void vars_of_events (void); void vars_of_extents (void); @@ -224,7 +224,7 @@ void vars_of_floatfns (void); void vars_of_font_lock (void); void vars_of_frame_tty (void); -void vars_of_frame_w32 (void); +void vars_of_frame_mswindows (void); void vars_of_frame_x (void); void vars_of_frame (void); void vars_of_glyphs_x (void); @@ -251,7 +251,7 @@ void vars_of_mule_wnn (void); void vars_of_objects (void); void vars_of_objects_tty (void); -void vars_of_objects_w32 (void); +void vars_of_objects_mswindows (void); void vars_of_objects_x (void); void vars_of_print (void); void vars_of_process (void); @@ -326,7 +326,7 @@ void init_event_Xt_late (void); void init_event_stream (void); void init_event_tty_late (void); -void init_event_w32_late (void); +void init_event_mswindows_late (void); void init_event_unixoid (void); void init_gif_err (void); void init_lread (void); diff -r d8688acf4c5b -r 78f53ef88e17 src/systime.h --- a/src/systime.h Mon Aug 13 10:05:53 2007 +0200 +++ b/src/systime.h Mon Aug 13 10:06:47 2007 +0200 @@ -50,11 +50,6 @@ #endif #endif -/* SVr4 and some friends don't actually declare this in its #include files. */ -#ifndef HAVE_TIMEZONE_DECL -extern long timezone; -#endif - /* On some configurations (hpux8.0, X11R4), sys/time.h and X11/Xos.h disagree about the name of the guard symbol. */ #ifdef HPUX diff -r d8688acf4c5b -r 78f53ef88e17 src/w32-proc.c --- a/src/w32-proc.c Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,602 +0,0 @@ -/* Win32 specific event-handling. - Copyright (C) 1997 Jonathan Harris. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Authorship: - - Jonathan Harris, November 1997 for 20.4. - */ - -/* - * Comment: - * - * Windows user-input type events are stored in a per-thread message queue - * and retrieved using GetMessage(). It is not possible to wait on this - * queue and on other events (eg process input) simultaneously. Also, the - * main event-handling code in windows (the "windows procedure") is called - * asynchronously when windows has certain other types of events ("nonqueued - * messages") to deliver. The documentation doesn't appear to specify the - * context in which the windows procedure is called, but I assume that the - * thread that created the window is temporarily highjacked for this purpose. - * - * We spawn off a single thread to deal with both kinds of messages. The - * thread turns the windows events into emacs_events and stuffs them in a - * queue which XEmacs reads at its leisure. This file contains the code for - * the thread. This scheme also helps to prevent weird synchronisation and - * deadlock problems that might occur if the windows procedure was called - * when XEmacs was already in the middle of processing an event. - * - * Unfortunately, only the thread that created a window can retrieve messages - * destined for that window ("GetMessage does not retrieve messages for - * windows that belong to other threads..."). This means that our message- - * processing thread also has to do all window creation. We handle this - * bogosity by getting the main XEmacs thread to send special user-defined - * messages to the message-processing thread to instruct it to create windows. - */ - - -#include -#include "lisp.h" - -#include "console-w32.h" -#include "device.h" -#include "frame.h" -#include "events.h" -#include "event-w32.h" - -#define W32_FRAME_STYLE WS_CLIPCHILDREN|WS_CLIPSIBLINGS|WS_TILEDWINDOW -#define W32_POPUP_STYLE WS_CLIPCHILDREN|WS_CLIPSIBLINGS|WS_CAPTION|WS_POPUP - -static LRESULT WINAPI w32_wnd_proc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam); -static Lisp_Object w32_find_console (HWND hwnd); -static Lisp_Object w32_find_frame (HWND hwnd); -static Lisp_Object w32_key_to_emacs_keysym(int w32_key); - -/* - * Entry point for the "windows" message-processing thread - */ -DWORD w32_win_thread() -{ - WNDCLASS wc; - MSG msg; - w32_waitable_info_type info; - - /* Register the main window class */ - wc.style = /* CS_HREDRAW | CS_VREDRAW | */ CS_OWNDC; /* One DC per window */ - wc.lpfnWndProc = (WNDPROC) w32_wnd_proc; - wc.cbClsExtra = 0; - wc.cbWndExtra = 0; /* ? */ - wc.hInstance = NULL; /* ? */ - wc.hIcon = LoadIcon (NULL, XEMACS_CLASS); - wc.hCursor = LoadCursor (NULL, IDC_ARROW); - wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */ - wc.lpszMenuName = NULL; /* XXX FIXME? Add a menu? */ - wc.lpszClassName = XEMACS_CLASS; - RegisterClass(&wc); /* XXX FIXME: Should use RegisterClassEx */ - - info.type = w32_waitable_type_dispatch; - w32_add_waitable(&info); - - /* Ensure our message queue is created XXX FIXME: Is this necessary? */ - PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE); - - /* Notify the main thread that we're ready */ - assert(PostThreadMessage (w32_main_thread_id, WM_XEMACS_ACK, 0, 0)); - - /* Main windows loop */ - while (1) - { - GetMessage (&msg, NULL, 0, 0); - - /* - * Process things that don't have an associated window, so wouldn't - * get sent to w32_wnd_proc - */ - - /* Request from main thread */ - if (msg.message>=WM_XEMACS_BASE && msg.message<=WM_XEMACS_END) - w32_handle_request(&msg); - - /* Timeout */ - else if (msg.message == WM_TIMER) - { - Lisp_Object emacs_event; - struct Lisp_Event *event; - - KillTimer(NULL, msg.wParam); - EnterCriticalSection (&w32_dispatch_crit); - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - event->channel = Qnil; - event->timestamp = msg.time; - event->event_type = timeout_event; - event->event.timeout.interval_id = msg.wParam; - w32_enqueue_dispatch_event (emacs_event); - LeaveCriticalSection (&w32_dispatch_crit); - } - else - /* Pass on to w32_wnd_proc */ - DispatchMessage (&msg); - } -} - -/* - * The windows procedure for the window class XEMACS_CLASS - * Stuffs messages in the w32 event queue - */ -static LRESULT WINAPI w32_wnd_proc(HWND hwnd, UINT message, WPARAM wParam, - LPARAM lParam) -{ - /* Note: Remember to initialise these before use */ - Lisp_Object emacs_event; - struct Lisp_Event *event; - - static int mods = 0; - MSG msg = { hwnd, message, wParam, lParam, 0, {0,0} }; - msg.time = GetMessageTime(); - -#if 0 /* XXX */ - stderr_out("Message %04x, wParam=%04x, lParam=%08lx\n", message, wParam, lParam); -#endif - switch (message) - { - case WM_KEYDOWN: - case WM_SYSKEYDOWN: - switch(wParam) - { - case VK_SHIFT: - mods |= MOD_SHIFT; - break; - case VK_CONTROL: - mods |= MOD_CONTROL; - break; - case VK_MENU: - mods |= MOD_META; - break; - default: - /* Handle those keys that TranslateMessage won't generate a WM_CHAR for */ - { - Lisp_Object keysym; - if (!NILP (keysym = w32_key_to_emacs_keysym(wParam))) - { - EnterCriticalSection (&w32_dispatch_crit); - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - event->channel = w32_find_console(hwnd); - event->timestamp = msg.time; - event->event_type = key_press_event; - event->event.key.keysym = keysym; - event->event.key.modifiers = mods; - w32_enqueue_dispatch_event (emacs_event); - LeaveCriticalSection (&w32_dispatch_crit); - return (0); - } - } - } - TranslateMessage (&msg); /* Maybe generates WM_[SYS]CHAR in message queue */ - goto defproc; - - case WM_KEYUP: - case WM_SYSKEYUP: - switch(wParam) - { - case VK_SHIFT: - mods &= ~MOD_SHIFT; - break; - case VK_CONTROL: - mods &= ~MOD_CONTROL; - break; - case VK_MENU: - mods &= ~MOD_META; - break; - } - TranslateMessage (&msg); - goto defproc; - - case WM_CHAR: - case WM_SYSCHAR: - { - EnterCriticalSection (&w32_dispatch_crit); - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - event->channel = w32_find_console(hwnd); - event->timestamp = msg.time; - event->event_type = key_press_event; - event->event.key.modifiers = mods; - event->event.key.modifiers = lParam & 0x20000000 ? MOD_META : 0; /* redundant? */ - if (wParam<' ') /* Control char not handled under WM_KEYDOWN */ - { - event->event.key.keysym = make_char(wParam+'@'); - event->event.key.modifiers |= MOD_CONTROL; /* redundant? */ - } - else - { - /* Assumes that emacs keysym == ASCII code */ - event->event.key.keysym = make_char(wParam); - } - w32_enqueue_dispatch_event (emacs_event); - LeaveCriticalSection (&w32_dispatch_crit); - } - break; - - case WM_LBUTTONDOWN: - case WM_MBUTTONDOWN: - case WM_RBUTTONDOWN: - case WM_LBUTTONUP: - case WM_MBUTTONUP: - case WM_RBUTTONUP: - { - /* XXX FIXME: Do middle button emulation */ - EnterCriticalSection (&w32_dispatch_crit); - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - event->channel = w32_find_frame(hwnd); - event->timestamp = msg.time; - event->event_type = - (message==WM_LBUTTONDOWN || message==WM_MBUTTONDOWN || - message==WM_RBUTTONDOWN) ? - button_press_event : button_release_event; -#if 0 - ((wParam & MK_CONTROL) ? MOD_CONTROL : 0) | - ((wParam & MK_SHIFT) ? MOD_SHIFT : 0); -#endif - event->event.button.button = - (message==WM_LBUTTONDOWN || message==WM_LBUTTONUP) ? 1 : - ((message==WM_RBUTTONDOWN || message==WM_RBUTTONUP) ? 3 : 2); - event->event.button.x = LOWORD(lParam); - event->event.button.y = HIWORD(lParam); - event->event.button.modifiers = mods; - - w32_enqueue_dispatch_event (emacs_event); - LeaveCriticalSection (&w32_dispatch_crit); - } - break; - - case WM_MOUSEMOVE: - { - EnterCriticalSection (&w32_dispatch_crit); - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - event->channel = w32_find_frame(hwnd); - event->timestamp = msg.time; - event->event_type = pointer_motion_event; - event->event.motion.x = LOWORD(lParam); - event->event.motion.y = HIWORD(lParam); - event->event.motion.modifiers = mods; - - w32_enqueue_dispatch_event (emacs_event); - LeaveCriticalSection (&w32_dispatch_crit); - } - break; - - case WM_PAINT: - if (GetUpdateRect(hwnd, NULL, FALSE)) - { - PAINTSTRUCT paintStruct; - - EnterCriticalSection (&w32_dispatch_crit); - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - event->channel = w32_find_frame(hwnd); - event->timestamp = msg.time; - event->event_type = magic_event; - BeginPaint (hwnd, &paintStruct); - EVENT_W32_MAGIC_TYPE(event) = message; - EVENT_W32_MAGIC_DATA(event) = paintStruct.rcPaint; - EndPaint (hwnd, &paintStruct); - - w32_enqueue_dispatch_event (emacs_event); - LeaveCriticalSection (&w32_dispatch_crit); - } - break; - - case WM_SIZE: - /* We only care about this message if our size has really changed */ - if (wParam==SIZE_RESTORED || wParam==SIZE_MAXIMIZED || wParam==SIZE_MINIMIZED) - { - RECT rect; - EnterCriticalSection (&w32_dispatch_crit); - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - event->channel = w32_find_frame(hwnd); - event->timestamp = msg.time; - event->event_type = magic_event; - if (wParam==SIZE_MINIMIZED) - rect.left = rect.top = rect.right = rect.bottom = -1; - else - GetClientRect(hwnd, &rect); - EVENT_W32_MAGIC_TYPE(event) = message; - EVENT_W32_MAGIC_DATA(event) = rect; - - w32_enqueue_dispatch_event (emacs_event); - LeaveCriticalSection (&w32_dispatch_crit); - } - break; - - case WM_SETFOCUS: - case WM_KILLFOCUS: - { - EnterCriticalSection (&w32_dispatch_crit); - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - event->channel = w32_find_frame(hwnd); - event->timestamp = msg.time; - event->event_type = magic_event; - EVENT_W32_MAGIC_TYPE(event) = message; - - w32_enqueue_dispatch_event (emacs_event); - LeaveCriticalSection (&w32_dispatch_crit); - } - break; - - case WM_QUIT: - /* XXX FIXME: Should do something here! */ - defproc: - default: - return DefWindowProc (hwnd, message, wParam, lParam); - } - return (0); -} - - -/* - * Make a request to the message-processing thread to do things that - * can't be done in the main thread. - */ -LPARAM -w32_make_request(UINT message, WPARAM wParam, w32_request_type *request) -{ - MSG msg; - assert(PostThreadMessage (w32_win_thread_id, message, wParam, - (LPARAM) request)); - GetMessage (&msg, NULL, WM_XEMACS_ACK, WM_XEMACS_ACK); - return (msg.lParam); -} - - -/* - * Handle a request from the main thread to do things that have to be - * done in the message-processing thread. - */ -static void -w32_handle_request (MSG *msg) -{ - w32_request_type *request = (w32_request_type *) msg->lParam; - - switch (msg->message) - { - case WM_XEMACS_CREATEWINDOW: - { - struct frame *f = request->thing1; - Lisp_Object *props = request->thing2; - Lisp_Object name, height, width, popup, top, left; - RECT rect; - DWORD style; - HWND hwnd; - - name = Fplist_get (*props, Qname, Qnil); - height = Fplist_get (*props, Qheight, Qnil); - width = Fplist_get (*props, Qwidth, Qnil); - popup = Fplist_get (*props, Qpopup, Qnil); - top = Fplist_get (*props, Qtop, Qnil); - left = Fplist_get (*props, Qleft, Qnil); - - style = (NILP(popup)) ? W32_FRAME_STYLE : W32_POPUP_STYLE; - - rect.left = rect.top = 0; - rect.right = INTP(width) ? XINT(width) : 640; - rect.bottom = INTP(height) ? XINT(height) : 480; -#ifdef HAVE_MENUBARS - AdjustWindowRect(&rect, style, TRUE); -#else - AdjustWindowRect(&rect, style, FALSE); -#endif - - hwnd = CreateWindow (XEMACS_CLASS, - STRINGP(f->name) ? XSTRING_DATA(f->name) : - (STRINGP(name) ? XSTRING_DATA(name) : XEMACS_CLASS), - style, - INTP(left) ? XINT(left) : CW_USEDEFAULT, - INTP(top) ? XINT(top) : CW_USEDEFAULT, - rect.right-rect.left, rect.bottom-rect.top, - NULL, NULL, NULL, NULL); - assert(PostThreadMessage (w32_main_thread_id, WM_XEMACS_ACK, 0, (LPARAM) hwnd)); - } - return; - - case WM_XEMACS_SETTIMER: - { - UINT id; - id=SetTimer (NULL, 0, (UINT) request->thing1, NULL); - assert(PostThreadMessage (w32_main_thread_id, WM_XEMACS_ACK, 0, id)); - } - break; - - case WM_XEMACS_KILLTIMER: - { - KillTimer (NULL, (UINT) request->thing1); - assert(PostThreadMessage (w32_main_thread_id, WM_XEMACS_ACK, 0, 0)); - } - break; - - default: - assert(0); - } -} - - -/* - * Translate a win32 virtual key to a keysym. - * Only returns non-Qnil for keys that don't generate WM_CHAR messages - * or whose ASCII codes (like space) xemacs doesn't like. - * Virtual key values are defined in winresrc.h - * XXX I'm not sure that KEYSYM("name") is the best thing to use here. - */ -Lisp_Object w32_key_to_emacs_keysym(int w32_key) -{ - switch (w32_key) - { - /* First the predefined ones */ - case VK_BACK: return QKbackspace; - case VK_TAB: return QKtab; - case '\n': return QKlinefeed; /* No VK_LINEFEED in winresrc.h */ - case VK_RETURN: return QKreturn; - case VK_ESCAPE: return QKescape; - case VK_SPACE: return QKspace; - case VK_DELETE: return QKdelete; - - /* The rest */ - case VK_PRIOR: return KEYSYM ("prior"); - case VK_NEXT: return KEYSYM ("next"); - case VK_END: return KEYSYM ("end"); - case VK_HOME: return KEYSYM ("home"); - case VK_LEFT: return KEYSYM ("left"); - case VK_UP: return KEYSYM ("up"); - case VK_RIGHT: return KEYSYM ("right"); - case VK_DOWN: return KEYSYM ("down"); - case VK_INSERT: return KEYSYM ("insert"); - case VK_HELP: return KEYSYM ("help"); - case VK_F1: return KEYSYM ("F1"); - case VK_F2: return KEYSYM ("F2"); - case VK_F3: return KEYSYM ("F3"); - case VK_F4: return KEYSYM ("F4"); - case VK_F5: return KEYSYM ("F5"); - case VK_F6: return KEYSYM ("F6"); - case VK_F7: return KEYSYM ("F7"); - case VK_F8: return KEYSYM ("F8"); - case VK_F9: return KEYSYM ("F9"); - case VK_F10: return KEYSYM ("F10"); - case VK_F11: return KEYSYM ("F11"); - case VK_F12: return KEYSYM ("F12"); - case VK_F13: return KEYSYM ("F13"); - case VK_F14: return KEYSYM ("F14"); - case VK_F15: return KEYSYM ("F15"); - case VK_F16: return KEYSYM ("F16"); - case VK_F17: return KEYSYM ("F17"); - case VK_F18: return KEYSYM ("F18"); - case VK_F19: return KEYSYM ("F19"); - case VK_F20: return KEYSYM ("F20"); - case VK_F21: return KEYSYM ("F21"); - case VK_F22: return KEYSYM ("F22"); - case VK_F23: return KEYSYM ("F23"); - case VK_F24: return KEYSYM ("F24"); - } - return Qnil; -} - - -/* - * Find the console that matches the supplied win32 window handle - */ -static Lisp_Object -w32_find_console (HWND hwnd) -{ - Lisp_Object concons; - - CONSOLE_LOOP (concons) - { - Lisp_Object console = XCAR (concons); - /* We only support one console so this must be it */ - return console; - } - - return Qnil; -} - -/* - * Find the frame that matches the supplied win32 window handle - */ -static Lisp_Object -w32_find_frame (HWND hwnd) -{ - Lisp_Object frmcons, devcons, concons; - - FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) - { - struct frame *f; - Lisp_Object frame = XCAR (frmcons); - f = XFRAME (frame); - if (FRAME_TYPE_P(f, w32)) /* Might be a stream-type frame */ - if (FRAME_W32_HANDLE(f)==hwnd) - return frame; - } - assert(0); /* XXX Can't happen! we only get messages for our windows */ - return Qnil; -} - -/* - * Random helper functions for debugging. - * Intended for use in the MSVC "Watch" window which doesn't like - * the aborts that the error_check_foo() functions can make. - */ -struct lrecord_header *DHEADER(Lisp_Object obj) -{ - return LRECORDP(obj) ? XRECORD_LHEADER(obj) : NULL; - /* (lrecord_header*)(obj & 0xfffffff) */ -} - -struct Lisp_Event *DEVENT(Lisp_Object obj) -{ - return (EVENTP (obj)) ? XEVENT(obj) : NULL; -} - -struct Lisp_Cons *DCONS(Lisp_Object obj) -{ - return (CONSP (obj)) ? XCONS(obj) : NULL; -} - -Lisp_Object DCAR(Lisp_Object obj) -{ - return (CONSP (obj)) ? XCAR(obj) : 0; -} - -Lisp_Object DCDR(Lisp_Object obj) -{ - return (CONSP (obj)) ? XCDR(obj) : 0; -} - -struct Lisp_String *DSTRING(Lisp_Object obj) -{ - return (STRINGP (obj)) ? XSTRING(obj) : NULL; -} - -struct Lisp_Vector *DVECTOR(Lisp_Object obj) -{ - return (VECTORP (obj)) ? XVECTOR(obj) : NULL; -} - -struct Lisp_Symbol *DSYMBOL(Lisp_Object obj) -{ - return (SYMBOLP (obj)) ? XSYMBOL(obj) : NULL; -} - -char *DSYMNAME(Lisp_Object obj) -{ - return (SYMBOLP (obj)) ? XSYMBOL(obj)->name->_data : NULL; -} diff -r d8688acf4c5b -r 78f53ef88e17 version.sh --- a/version.sh Mon Aug 13 10:05:53 2007 +0200 +++ b/version.sh Mon Aug 13 10:06:47 2007 +0200 @@ -1,5 +1,5 @@ #!/bin/sh emacs_major_version=20 emacs_minor_version=4 -emacs_beta_version=4 -xemacs_codename="American Cashmere" +emacs_beta_version=5 +xemacs_codename="Anglo-Nubian" diff -r d8688acf4c5b -r 78f53ef88e17 w32/ChangeLog --- a/w32/ChangeLog Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,140 +0,0 @@ -Thu September 25 23:06:44 1997 davidh - - * xemacs.mak updated to make the build as simple as typing - nmake -f xemacs.mak. Also support for native gui included - which should mean the w32 directory is no longer required. - - * config.h synced with config.h.in from 20.3-b2 - - * synced in changes to support native gui. - -Thu September 25 23:06:44 1997 davidh - - * August Hill provided a patch to xemacs.mak to greatly simplify - the build - the DOC file gets created correctly. - -Tue September 22 23:06:44 1997 davidh - - * August Hill provided some more patches - to expand ~ correctly - and to correctly deal with drive letters in the path. - - * emacs.c patched to call init_ntproc() - - -Tue July 15 19:32:21 1997 davidh - - * August Hill provided some more patches to make things better - - there is a workaround for dired to make the ^M's disappear - - a patch to fix shell-command - -Tue July 08 22:01:36 1997 davidh - - * #ifdef'd call to vfork and replaced with spawn as per GNU Emacs; - as a result, removed /force - XEmacs now links normally. - -Thu June 31 21:16:21 1997 davidh - - * nt/TODO created. - - * nt/X11.patch created to help with the X build. - - * August Hill provided: - a patch to fix the _WRETCODE undefined symbol, - a patch to fix a problem with dired - - and generally helped clarify the build instructions. - - * Synced with 20.3b10 (Athens). - - * Made DIRECTORY_SEP be '\\'. Until I can change all code to - use the macro, I decided this would be easiest. - - * Modified src/fileio.c to only open files in O_BINARY. This - causes files to be opened and written without automatically - writing ^M 's to the end of each line. MULE ought to sort this - in theory, but I am less than convinced. - - * Updated the nt/README to provide a little more help. - -Thu May 29 23:11:21 1997 davidh - - * Synced with 20.3b2. - - * Removed nt/README.src, nt/src.m.windowsnt.h nt/src.s.windowsnt.h. - - * Updated README from marcpa. - - * Added example Win32.cf and site.def files for X. - - * Added sed.exe into nt/. - - * Modified nt/xemacs.mak to pass correct flags to lwlib compile. - - * Added extra .elc files to ensure make-docfile gets all symbols. - - * Modified balloon_help.c to compile (#if'd max definition) - - * Modified src/event-Xt.c so as not to add signal_event_pipe to - be selected on - this is a hack until I can work out a better - way. Thanks to Ben Wing for help on this. - -Thu Mar 27 20:56:21 1997 marcpa (marcpa at MARCPA) - - * Synced with 20.1b9. - -Sun Mar 16 00:32:15 1997 marcpa (marcpa at MARCPA) - - * lisp/eterm/README.term is truncated: is it just me (because - I'm on NT) or everyone else sees this ? - Answer: it is because it contains a ^Z embedded in it, therefore - it needs to be inserted in binary mode in CVS. - -Thu Mar 13 00:19:25 1997 marcpa (marcpa at MARCPA) - - * At end of compilation, there are some unresolved symbols: - -link.exe @C:\TEMP\nma00115. -sysdep.obj : error LNK2001: unresolved external symbol _vfork -../src/temacs.exe : warning LNK4088: image being generated due to /FORCE -option; image may not run - - -Wed Mar 12 23:18:53 1997 marcpa (marcpa at MARCPA) - - * Need to copy the nt/inc directory David originally submitted or - NT code won't compile. - - * Need to copy nt/{config.h,paths.h,ad2c.sed,xemacs.mak} in src. - - * Had to modify XEmacs sources here and there : see the diffs - between NT_FIRST_COMPILE and V20_1_beta9. - - * Needed to patch X11R6.3 sources: (include/x11/Xmd.h:155) BOOL is - already defined by Windows and is a long, while X wants it to be - an unsigned char. - ---- Xmd.h~ Thu Jun 08 23:20:40 1995 -+++ Xmd.h Sun Mar 16 13:09:10 1997 -@@ -150,8 +150,9 @@ - typedef CARD16 BITS16; - typedef CARD8 BYTE; - -+#ifndef WIN32 - typedef CARD8 BOOL; -- -+#endif - - * cpp.exe not used: cl.exe from VC++4.2 seems to handle everything - properly. - -NOTES: - -Compilation with nmake -f xemacs.mak. - -Using X11R6.3 for NT. - -Work started with 20.1b2. - -Local Variables: -mode: change-log -End: diff -r d8688acf4c5b -r 78f53ef88e17 w32/README --- a/w32/README Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,75 +0,0 @@ - Building and Installing XEmacs on Windows NT - - David Hobley - Marc Paquette - Jonathon Harris - -Currently XEmacs for Win32 is in an early stage of development. - -The port was made much easier by the groundbreaking work of Geoff Voelker -and others who worked on the GNU Emacs port to NT. Their version is available -from http://www.cs.washington.edu/homes/voelker/ntemacs.html - -To get it working you will need: - -1. You will need Visual C++ V4.2 or later to compile everything. Personally we - have tested V4.2 and V5.0. -2. Grab the latest XEmacs beta from ftp.xemacs.org if necessary. All Win32 - support is in the nt/ subdirectory. -3. Edit the xemacs.mak file and ensure variables point to the correct place. - Note that Visual C++ assumes a couple of environment variables INCLUDE and - LIB to be set which specify the location of the includes and libraries. - At this point you can select X or Win32 native support. -4. Run make. I simply use nmake -f xemacs.mak. This will build temacs, the - DOC file, if startup.elc does not exist it will update the elc's and - then it will dump xemacs. -5. The build process creates debugging and "Source Browser" information for - use with MS DevStudio. To use this create a new "console" project and set - the Project/Settings/Debug executable name to the full path of - src\xemacs.exe. Remember to close the Source Browser file in DevStudio - before rebuilding. -6. If you're going to edit sources I recommend that you first get a copy of - makedepend and make a list of dependencies in the makefile by doing - "nmake -f xemacs.mak depend". I (jhar) have a hacked-up copy of X11R5 - makedepend which I can distribute if anyone wants it. Is there a real - version anywhere which handles '\' as the path delimiter? - -If you want support for X you will need: - -1. An X server. MI/X is available on the Internet for free; It is - available from: http://www.microimages.com/www/html/freestuf/mixdlfrm.htm -2. The MIT X11R6.3 libraries available from: ftp.x.org -3. You'll need to compile the MIT libraries without multi-thread support. - To do this, there is an example Win32.cf and site.def provided which - set the relevant flags. You will also need to apply the patch in - nt/X11.patch in the xc/lib/X11 directory which will fix the DLL definition - file. Once compiled and installed, you will need to apply the following - patch to Xmd.h. This is messy and better solutions would be appreciated. - ---- Xmd.h~ Thu Jun 08 23:20:40 1995 -+++ Xmd.h Sun Mar 16 13:09:10 1997 -@@ -150,8 +150,9 @@ - typedef CARD16 BITS16; - typedef CARD8 BYTE; - -+#ifndef WIN32 - typedef CARD8 BOOL; -- -+#endif - -Known Problems: -Please look at the TODO list for the current list of problems and people -working on them. - -Any other problems you need clarified, please email us and we will endeavour -to provide any assistance we can: - -The XEmacs NT Mailing List: xemacs-nt@xemacs.org -Subscribe address: xemacs-nt-request@xemacs.org - -David Hobley -Marc Paquette -August Hill -Jonathon Harris - -and others. diff -r d8688acf4c5b -r 78f53ef88e17 w32/Todo --- a/w32/Todo Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,44 +0,0 @@ -# List of problems with XEmacs. If anyone wants to work on these, please -# mail me and I'll update the table below. - -# Core NT issues - 1. Subprocess support is completely broken. - 2. Networking support is completely broken. This is due to the fact that - the model relies on the subprocess support also working. - 4. No binary release. We know a binary release would be A Good Thing. - However we want to make things stable before producing one so we don't - have to field too many problems. Sorry. - 5. Support for dired is perhaps not quite there. We need to port ls-lisp.el - from FSF Emacs. - 6. Currently the backup files do not get the same permissions as the file - being edited. August Hill is looking at this one. - 7. Verify that CRLF issues are dealt with correctly. Marc Paquette is - looking at this. - -# X issues - 1. Redrawing on my (davidh) system seems fairly broken - I don't know if - this is the XEmacs redraw functionality, my X server or just something - strange with X under NT. Has anyone else experiences with this ? - -# Native GUI issues - 1. Mouse drags can cause aborts. I think this is because the timeout - implementation is broken and can cause the same timeout to go - off twice (especially during mouse drags?), which makes XEmacs abort. - Windows95 doesn't appear to provide any one-shot timers (NT does). - 2. XEmacs starts-up with "Arithmetic error". - 3. It might be a good idea if someone sanity-checked my (jhar) changes to - faces.el. - 4. w32-make-font-foo in w32/w32-faces.el need to be written. - 5. Calling mouse_[enter|leave]_frame_hook. - 6. Eliminate resizing funnies - 7. Scrollbar - 8. Menubar - 9. Palette handling - 10. Middle mouse button emulation. Dragging off-frame. - 11. Images - 12. Toolbar - -Old Issues. - - 1. For some reason, HOME is a required environment variable. - diff -r d8688acf4c5b -r 78f53ef88e17 w32/config.h --- a/w32/config.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,697 +0,0 @@ -/* XEmacs site configuration template file. -*- C -*- - Copyright (C) 1986, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: FSF 19.30 (more or less). */ - -/* No code in XEmacs #includes config.h twice, but some of the code - intended to work with other packages as well (like gmalloc.c) - think they can include it as many times as they like. */ -#ifndef _SRC_CONFIG_H_ -#define _SRC_CONFIG_H_ - -#define NTHEAP_PROBE_BASE 1 -#define LOSING_BYTECODE - -/* Use this to add code in a structured way to FSF-maintained source - files so as to make it obvious where XEmacs changes are. */ -#define XEMACS - -/* Allow s&m files to differentiate OS versions without having - multiple files to maintain. */ -#undef OS_RELEASE - -/* The configuration name. This is used as the install directory name - for the lib-src programs. */ -#undef EMACS_CONFIGURATION - -/* The configuration options. This is exported to Lisp. */ -#undef EMACS_CONFIG_OPTIONS - -/* The version info from xemacs.mak via version.sh. Used in #pragma ident - in emacs.c */ -#if 0 -#undef EMACS_MAJOR_VERSION -#undef EMACS_MINOR_VERSION -#undef EMACS_BETA_VERSION -#undef EMACS_VERSION -#undef XEMACS_CODENAME -#endif - -/* Make all functions available on AIX. See AC_AIX. */ -#undef _ALL_SOURCE - -/* Used to identify the XEmacs version in stack traces. */ -#undef STACK_TRACE_EYE_CATCHER - -/* Allow the configurer to specify (additional) package directories. */ -#undef PACKAGE_PATH - -/* Define LISP_FLOAT_TYPE if you want XEmacs to support floating-point - numbers. */ -#undef LISP_FLOAT_TYPE - -/* Define GNU_MALLOC if you want to use the *new* GNU memory allocator. */ -#define GNU_MALLOC - -/* Define USE_SYSTEM_MALLOC if you forcing the use of it. */ -#undef USE_SYSTEM_MALLOC - -/* Define HAVE_TTY if you want TTY support compiled in. */ -#undef HAVE_TTY - -/* Compile in support for the X window system? */ -/* #undef HAVE_X_WINDOWS -- defined in xemacs.mak */ - -/* Defines for building X applications */ -#ifdef HAVE_X_WINDOWS -/* The following will be defined if xmkmf thinks they are necessary */ -#undef SVR4 -#undef SYSV -#undef AIXV3 -#undef _POSIX_SOURCE -#undef _BSD_SOURCE -#undef _GNU_SOURCE -#undef X_LOCALE -#undef NARROWPROTO -/* The following should always be defined, no matter what xmkmf thinks. */ -#ifndef NeedFunctionPrototypes -#define NeedFunctionPrototypes 1 -#endif -#ifndef FUNCPROTO -#define FUNCPROTO 15 -#endif - -/* Define this if you're using XFree386. */ -#undef HAVE_XFREE386 - -#undef THIS_IS_X11R4 -#undef THIS_IS_X11R5 -#define THIS_IS_X11R6 - -/* Define HAVE_XPM if you have the `xpm' library and want XEmacs to use it. */ -#undef HAVE_XPM - -/* Define HAVE_XFACE if you have the `compface' library and want to use it. - This will permit X-face pixmaps in mail and news messages to display - quickly. */ -#undef HAVE_XFACE - -#define HAVE_IMAGEMAGICK - -/* Define HAVE_XMU if you have the Xmu library. This should always be - the case except on losing HPUX systems. */ -#define HAVE_XMU - -/* Define HAVE_XAUTH if the Xauth library is present. This will add - some extra functionality to gnuserv. */ -#undef HAVE_XAUTH - -/* Define HAVE_XLOCALE_H if X11/Xlocale.h is present. */ -#define HAVE_XLOCALE_H - -#endif /* HAVE_X_WINDOWS */ - -/* Define HAVE_WINDOW_SYSTEM if any windowing system is available. */ -#if defined (HAVE_X_WINDOWS) || defined (HAVE_NEXTSTEP) || defined (HAVE_W32GUI) -#define HAVE_WINDOW_SYSTEM -#endif - -/* Define HAVE_UNIXOID_EVENT_LOOP if we use select() to wait for events. */ -#if defined (HAVE_X_WINDOWS) || defined (HAVE_TTY) || defined (HAVE_W32GUI) -#define HAVE_UNIXOID_EVENT_LOOP -#endif - -/* Define USER_FULL_NAME to return a string - that is the user's full name. - It can assume that the variable `pw' - points to the password file entry for this user. - - At some sites, the pw_gecos field contains - the user's full name. If neither this nor any other - field contains the right thing, use pw_name, - giving the user's login name, since that is better than nothing. */ -#define USER_FULL_NAME pw->pw_gecos - -/* Define AMPERSAND_FULL_NAME if you use the convention - that & in the full name stands for the login id. */ -#undef AMPERSAND_FULL_NAME - -/* Some things figured out by the configure script, grouped as they are in - configure.in. */ -#undef HAVE_MACH_MACH_H -#undef HAVE_SYS_STROPTS_H -#undef HAVE_SYS_TIMEB_H -#undef HAVE_UNISTD_H -#undef HAVE_UTIME_H -#undef HAVE_SYS_WAIT_H -#undef HAVE_LIBGEN_H -#undef HAVE_LINUX_VERSION_H -#undef WORDS_BIGENDIAN -#undef TIME_WITH_SYS_TIME - -#define HAVE_SYS_TIME_H -#define HAVE_LOCALE_H -#ifdef HAVE_X_WINDOWS -#define HAVE_X11_LOCALE_H -#endif -#define STDC_HEADERS -#define HAVE_LIMITS_H -#define HAVE_GETCWD - -#define HAVE_LONG_FILE_NAMES - -#ifdef HAVE_LONG_FILE_NAMES -#define CLASH_DETECTION -#endif - -#undef HAVE_LIBKSTAT -#undef HAVE_LIBINTL -#undef HAVE_LIBDNET -#undef HAVE_LIBRESOLV - -/* Define if `sys_siglist' is declared by . */ -#undef SYS_SIGLIST_DECLARED - -/* Define if `struct utimbuf' is declared by . */ -#undef HAVE_STRUCT_UTIMBUF - -/* Define if `struct timeval' is declared by . */ -#define HAVE_TIMEVAL - -#undef TM_IN_SYS_TIME -#undef HAVE_TM_ZONE -#undef HAVE_TZNAME - -/* Define if netdb.h declares h_errno. */ -#undef HAVE_H_ERRNO - -/* Define if localtime caches TZ */ -#undef LOCALTIME_CACHE - -/* Define if gettimeofday can't accept two arguments */ -#ifdef HAVE_X_WINDOWS -#define GETTIMEOFDAY_ONE_ARGUMENT -#else -#undef GETTIMEOFDAY_ONE_ARGUMENT -#endif - -/* Is the timezone variable already declared in system headers? */ -#undef HAVE_TIMEZONE_DECL - -#undef HAVE_MMAP -#undef HAVE_STRCOLL -#undef HAVE_GETPGRP -#undef GETPGRP_VOID - -#undef SIZEOF_SHORT -#undef SIZEOF_INT -#undef SIZEOF_LONG -#undef SIZEOF_LONG_LONG -#undef SIZEOF_VOID_P - -#undef HAVE_ACOSH -#undef HAVE_ASINH -#undef HAVE_ATANH - -#if defined (HAVE_ACOSH) && defined (HAVE_ASINH) && defined (HAVE_ATANH) -#define HAVE_INVERSE_HYPERBOLIC -#endif - -#undef HAVE_CBRT -#define HAVE_CLOSEDIR -#undef HAVE_DUP2 -#undef HAVE_EACCESS -#undef HAVE_FMOD -#undef HAVE_FPATHCONF -#undef HAVE_FREXP -#undef HAVE_FTIME -#undef HAVE_GETHOSTNAME -#undef HAVE_GETPAGESIZE -#define HAVE_GETTIMEOFDAY -#define HAVE_GETWD -#undef HAVE_LOGB -#undef HAVE_LRAND48 -#undef HAVE_MATHERR -#undef HAVE_MKDIR -#undef HAVE_MKTIME -#undef HAVE_PERROR -#undef HAVE_POLL -#undef HAVE_RANDOM -#undef HAVE_REALPATH -#undef HAVE_RENAME -#undef HAVE_RES_INIT -#undef HAVE_RINT -#undef HAVE_RMDIR -#define HAVE_SELECT -#undef HAVE_SETITIMER -#undef HAVE_SETPGID -#undef HAVE_SETSID -#undef HAVE_SIGBLOCK -#undef HAVE_SIGHOLD -#undef HAVE_SIGPROCMASK -#undef HAVE_SIGSETJMP -#undef HAVE_STRCASECMP -#define HAVE_STRERROR -#undef HAVE_TZSET -#undef HAVE_UTIMES -#undef HAVE_WAITPID - -#define HAVE_SOCKETS -#undef HAVE_SOCKADDR_SUN_LEN -#undef HAVE_SYSVIPC - -#undef SYSV_SYSTEM_DIR -#undef NONSYSTEM_DIR_LIBRARY - -#undef HAVE_TERMIOS -#undef HAVE_TERMIO - -#undef NLIST_STRUCT - -/* Define HAVE_SOCKS if you have the `socks' library and want XEmacs to - use it. */ -#undef HAVE_SOCKS - -/* Define HAVE_TERM if you run the `term' program (e.g. under Linux) and - want XEmacs to use it. */ -#undef HAVE_TERM - -/* Define HAVE_DBM if you want to use the DBM libraries */ -#undef HAVE_DBM - -/* Define HAVE_BERKELEY_DB if you want to use the BerkDB libraries */ -#undef HAVE_BERKELEY_DB -/* Full #include file path for Berkeley DB's db.h */ -#undef DB_H_PATH - -#if defined (HAVE_DBM) || defined (HAVE_BERKELEY_DB) -# define HAVE_DATABASE -#endif - -/* Define HAVE_NCURSES if -lncurses is present. */ -#undef HAVE_NCURSES -/* Full #include file paths for ncurses' curses.h and term.h. */ -#undef CURSES_H_PATH -#undef TERM_H_PATH - -#define LOWTAGS - -/* Define USE_ASSERTIONS if you want the abort() to be changed to assert() - If the assertion fails, assert_failed() will be called. This is - recommended for general use because it gives more info about the crash - than just the abort() message. Too many people "Can't find the corefile" - or have limited core dumps out of existence. */ -#define USE_ASSERTIONS - -/* Define one or more of the following if you want lots of extra checks - (e.g. structure validation) compiled in. These should be turned - on during the beta-test cycle. */ - -/* Check the entire extent structure of a buffer each time an extent - change is done, and do other extent-related checks. */ -#define ERROR_CHECK_EXTENTS - -/* Make sure that all X... macros are dereferencing the correct type, - and that all XSET... macros (as much as possible) are setting the - correct type of structure. Highly recommended for all - development work. */ -#define ERROR_CHECK_TYPECHECK -/* Make sure valid buffer positions are passed to BUF_* macros. */ -#define ERROR_CHECK_BUFPOS -/* Attempt to catch bugs related to garbage collection (e.g. - insufficient GCPRO'ing). */ -#define ERROR_CHECK_GC -/* Attempt to catch freeing of a non-malloc()ed block, heap corruption, - etc. */ -#define ERROR_CHECK_MALLOC - -/* Define DEBUG_XEMACS if you want extra debugging code compiled in. - This is mainly intended for use by developers. */ -#define DEBUG_XEMACS 0 - -/* Define MEMORY_USAGE_STATS if you want extra code compiled in to - determine where XEmacs's memory is going. */ -#undef MEMORY_USAGE_STATS - -/* Define QUANTIFY if using Quantify from Pure Software. This adds - some additional calls to control data collection. This is only - intended for use by the developers. */ -#undef QUANTIFY - -/* Define EXTERNAL_WIDGET to compile support for using the editor as a - widget in another program. */ -#undef EXTERNAL_WIDGET - -/* There are some special-case defines for gcc and lcc. */ -#undef USE_GCC -#undef USE_LCC - -/* Allow the user to override the default value of PURESIZE at configure - time. This must come before we include the sys files in order for - it to be able to override any changes in them. */ -#undef RAW_PURESIZE - -/* Define this if you want level 2 internationalization compliance - (localized collation and formatting). Generally this should be - defined, unless your system doesn't have the strcoll() and - setlocale() library routines. This really should be (NOT! -mrb) - defined in the appropriate s/ or m/ file. */ -#undef I18N2 - -/* Define this if you want level 3 internationalization compliance - (localized messaging). This will cause a small runtime performance - penalty, as the strings are read from the message catalog(s). - For this you need the gettext() and dgetext() library routines. - WARNING, this code is under construction. */ -#undef I18N3 - -/* Compile in support for CDE (Common Desktop Environment) drag and drop? - Requires libDtSvc, which typically must be present at runtime. */ -#undef HAVE_CDE - -/* Compile in support for OffiX Drag and Drop? */ -#undef HAVE_OFFIX_DND - -/* Compile in support for proper session-management. */ -#undef HAVE_SESSION - -/* Define this if you want Mule support (multi-byte character support). - There may be some performance penalty, although it should be small - if you're working with ASCII files. */ -/* #undef MULE */ - -#ifdef MULE -/* Do we want to use X window input methods for use with Mule? (requires X11R5) - If so, use raw Xlib or higher level Motif interface? */ -#undef HAVE_XIM -#undef XIM_XLIB -#undef XIM_MOTIF - -/* Non-XIM input methods for use with Mule. */ -#undef HAVE_CANNA -#undef HAVE_WNN -#undef WNN6 - -#endif - -/* enable special GNU Make features in the Makefiles. */ -#undef USE_GNU_MAKE - -/* Undocumented debugging option: Don't automatically rebuild the DOC - file. This saves a lot of time when you're repeatedly - compiling-running-crashing. */ -#undef NO_DOC_FILE - - /* To eliminate use of `const' in the XEmacs sources, - do `#define CONST_IS_LOSING' */ -#define CONST_IS_LOSING - -# undef CONST -# ifdef CONST_IS_LOSING -# define CONST -# else -# define CONST const -# endif /* CONST */ - -/* If not defined, use unions instead of ints. A few systems (DEC Alpha) - seem to require this, probably because something with the int - definitions isn't right with 64-bit systems. - - (It's NO_UNION_TYPE instead of USE_UNION_TYPE for historical reasons.) -*/ -#undef NO_UNION_TYPE - -/* The configuration script defines opsysfile to be the name of the - s/...h file that describes the system type you are using. The file - is chosen based on the configuration name you give. - - See the file ../etc/MACHINES for a list of systems and the - configuration names to use for them. - - See s/template.h for documentation on writing s/...h files. */ -#include "s/windowsnt.h" - -/* The configuration script defines machfile to be the name of the - m/...h file that describes the machine you are using. The file is - chosen based on the configuration name you give. - - See the file ../etc/MACHINES for a list of machines and the - configuration names to use for them. - - See m/template.h for documentation on writing m/...h files. */ -#include "m/windowsnt.h" - -#if defined (USE_SYSTEM_MALLOC) && !defined (SYSTEM_MALLOC) -#define SYSTEM_MALLOC -#endif - -/* Define REL_ALLOC if you want to use the relocating allocator for - buffer space. */ -#undef REL_ALLOC - -/* Define the return type of signal handlers if the s-xxx file - did not already do so. */ -#define RETSIGTYPE void - -/* SIGTYPE is the macro we actually use. */ -#ifndef SIGTYPE -#define SIGTYPE RETSIGTYPE -#define SIGRETURN return -#endif - -/* Allow the source to use standard types */ -#undef size_t -#undef pid_t -#undef mode_t -#undef off_t -#undef uid_t -#undef gid_t - -/* Define DYNODUMP if it is necessary to properly dump on this system. - Currently this is only Solaris. */ -#undef DYNODUMP - -/* Define ENERGIZE to compile with support for the Energize Programming System. - If you do this, don't forget to define ENERGIZE in lwlib/Imakefile as well. - You will need to set your C_SWITCH_SITE and LD_SWITCH_SITE to point at the - Energize connection library (libconn.a) and associated header files. - */ -#undef ENERGIZE -#undef ENERGIZE_2 -#undef ENERGIZE_3 - -/* Define SUNPRO to compiled in support for Sun Sparcworks. */ -#undef SUNPRO - -/* Sun SparcStations, SGI machines, and HP9000s700s have support for playing - different sound files as beeps. If you are on a SparcStation but do not - have the sound option installed for some reason, then undefine - HAVE_NATIVE_SOUND. (It's usually found in /usr/demo/SOUND/ on SunOS 4 - and Solaris systems; on Solaris, you may need to install the "SUNWaudmo" - package.) - */ -#undef HAVE_NATIVE_SOUND - -/* If you wish to compile with support for the Network Audio System - system define HAVE_NAS_SOUND. - NAS_NO_ERROR_JUMP means that the NAS libraries don't inlcude some - error handling changes. - */ -#undef HAVE_NAS_SOUND -#undef NAS_NO_ERROR_JUMP - -/* Compile in support for SunPro usage-tracking code. */ -#undef USAGE_TRACKING - -/* Define TOOLTALK if your site supports the ToolTalk library. */ -#undef TOOLTALK - -#ifdef HAVE_X_WINDOWS - -#undef LWLIB_USES_MOTIF -#define LWLIB_MENUBARS_LUCID -#undef LWLIB_MENUBARS_MOTIF -#define LWLIB_SCROLLBARS_LUCID -#undef LWLIB_SCROLLBARS_MOTIF -#undef LWLIB_SCROLLBARS_ATHENA -#undef LWLIB_DIALOGS_MOTIF -#define LWLIB_DIALOGS_ATHENA - -/* Other things that can be disabled by configure. */ -#define HAVE_MENUBARS -#define HAVE_SCROLLBARS -#define HAVE_DIALOGS -#undef HAVE_TOOLBARS - -#endif - -#if defined (HAVE_MENUBARS) || defined (HAVE_DIALOGS) -#define HAVE_POPUPS -#endif - -/* If you are using SunOS 4.1.1 and X11r5, then you need this patch. - There is a stupid bug in the SunOS libc.a: two functions which X11r5 - uses, mbstowcs() and wcstombs(), are unusable when programs are - statically linked (as XEmacs must be) because the static version of - libc.a contains the *dynamic* versions of these functions. These - functions don't seem to be called when XEmacs is running, so it's - enough to define stubs for them. - - This appears to be fixed in SunOS 4.1.2. - - Also, SunOS 4.1.1 contains buggy versions of strcmp and strcpy that - sometimes reference memory past the end of the string, which can segv. - I don't know whether this is has been fixed as of 4.1.2 or 4.1.3. - */ -#if defined (sparc) && !defined (USG) -#define OBJECTS_SYSTEM sunOS-fix.o strcmp.o strcpy.o -#endif - -/* If you turn this flag on, it forces encapsulation in all -circumstances; this can be used to make sure things compile OK -on various systems. */ -#undef DEBUG_ENCAPSULATION -#define DONT_ENCAPSULATE - -/* basic system calls */ - -#if defined (INTERRUPTIBLE_IO) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_READ -# define ENCAPSULATE_WRITE -#endif -#if defined (INTERRUPTIBLE_OPEN) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_OPEN -#endif -#if defined (INTERRUPTIBLE_CLOSE) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_CLOSE -#endif - -/* stdio calls */ - -#if defined (INTERRUPTIBLE_IO) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_FREAD -# define ENCAPSULATE_FWRITE -#endif -#if defined (INTERRUPTIBLE_OPEN) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_FOPEN -#endif -#if defined (INTERRUPTIBLE_CLOSE) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_FCLOSE -#endif - -/* directory calls */ - -#if defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_CHDIR -# define ENCAPSULATE_MKDIR -# define ENCAPSULATE_OPENDIR -# define ENCAPSULATE_READDIR -# define ENCAPSULATE_RMDIR -#endif - -/* file-information calls */ - -#if defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_ACCESS -# define ENCAPSULATE_LSTAT -# define ENCAPSULATE_READLINK -# define ENCAPSULATE_STAT -#endif - -/* file-manipulation calls */ - -#if defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_CHMOD -# define ENCAPSULATE_CREAT -# define ENCAPSULATE_LINK -# define ENCAPSULATE_RENAME -# define ENCAPSULATE_SYMLINK -# define ENCAPSULATE_UNLINK -#endif - -#if (defined (MSDOS) && defined (FEPCTRL)) || (defined (WIN32) && defined (USE_IME)) -#define HAVE_FEP -#endif - -#if defined (HAVE_SOCKS) && !defined (DO_NOT_SOCKSIFY) -#define accept Raccept -#define bind Rbind -#define connect Rconnect -#define getsockname Rgetsockname -#define listen Rlisten -#endif /* HAVE_SOCKS && !DO_NOT_SOCKSIFY */ - -#ifndef SHORTBITS -#define SHORTBITS (8 * SIZEOF_SHORT) -#endif -#ifndef INTBITS -#define INTBITS (8 * SIZEOF_INT) -#endif -#ifndef LONGBITS -#define LONGBITS (8 * SIZEOF_LONG) -#endif - -#ifdef HAVE_INLINE -# if defined (__GNUC__) -# if defined (DONT_EXTERN_INLINE_FUNCTIONS) -# define INLINE inline -# else -# define INLINE extern inline -# endif -# else -# define INLINE static inline -# endif -#else -# define INLINE static -#endif - -/* We want to avoid saving the signal mask if possible, because - that necessitates a system call. */ -#ifdef HAVE_SIGSETJMP -# define SETJMP(x) sigsetjmp (x, 0) -# define LONGJMP(x, y) siglongjmp (x, y) -# define JMP_BUF sigjmp_buf -#else -# define SETJMP(x) setjmp (x) -# define LONGJMP(x, y) longjmp (x, y) -# define JMP_BUF jmp_buf -#endif - -/* movemail options */ -/* Should movemail use POP3 for mail access? */ -#undef MAIL_USE_POP -/* Should movemail use kerberos for POP authentication? */ -#undef KERBEROS -/* Should movemail use hesiod for getting POP server host? */ -#undef HESIOD -/* Determine type of mail locking. */ -/* Play preprocessor games so that configure options override s&m files */ -#undef REAL_MAIL_USE_LOCKF -#undef REAL_MAIL_USE_FLOCK -#undef MAIL_USE_LOCKF -#undef MAIL_USE_FLOCK -#ifdef REAL_MAIL_USE_FLOCK -#define MAIL_USE_FLOCK -#endif -#ifdef REAL_MAIL_USE_LOCKF -#define MAIL_USE_LOCKF -#endif - -#endif /* _SRC_CONFIG_H_ */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/arpa/inet.h --- a/w32/inc/arpa/inet.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -/* null version of - has everything */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/netdb.h --- a/w32/inc/netdb.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -/* null version of - has everything */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/netinet/in.h --- a/w32/inc/netinet/in.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -/* null version of - has everything */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/pwd.h --- a/w32/inc/pwd.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -#ifndef _PWD_H_ -#define _PWD_H_ -/* - * pwd.h doesn't exist on NT, so we put together our own. - */ - -struct passwd { - char *pw_name; - char *pw_passwd; - int pw_uid; - int pw_gid; - int pw_quota; - char *pw_gecos; - char *pw_dir; - char *pw_shell; -}; - -#endif /* _PWD_H_ */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/sys/dir.h --- a/w32/inc/sys/dir.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,77 +0,0 @@ -/* This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs 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 General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: FSF 19.30. */ - -/* - -- definitions for 4.2BSD-compatible directory access - - last edit: 09-Jul-1983 D A Gwyn -*/ - -#ifdef VMS -#ifndef FAB$C_BID -#include -#endif -#ifndef NAM$C_BID -#include -#endif -#ifndef RMS$_SUC -#include -#endif -#include "vms-dir.h" -#endif /* VMS */ - -#define DIRBLKSIZ 512 /* size of directory block */ -#ifdef VMS -#define MAXNAMLEN (DIR$S_NAME + 7) /* 80 plus room for version #. */ -#define MAXFULLSPEC NAM$C_MAXRSS /* Maximum full spec */ -#else -#ifdef WINDOWSNT -#define MAXNAMLEN 255 -#else /* not WINDOWSNT */ -#define MAXNAMLEN 15 /* maximum filename length */ -#endif /* not WINDOWSNT */ -#endif /* VMS */ - /* NOTE: MAXNAMLEN must be one less than a multiple of 4 */ - -struct direct /* data from readdir() */ - { - long d_ino; /* inode number of entry */ - unsigned short d_reclen; /* length of this record */ - unsigned short d_namlen; /* length of string in d_name */ - char d_name[MAXNAMLEN+1]; /* name of file */ - }; - -typedef struct - { - int dd_fd; /* file descriptor */ - int dd_loc; /* offset in block */ - int dd_size; /* amount of valid data */ - char dd_buf[DIRBLKSIZ]; /* directory block */ - } DIR; /* stream data from opendir() */ - -#ifndef WINDOWSNT -extern DIR *opendir (CONST char *filename); -extern int closedir (DIR *dirp); -extern struct direct *readdir (DIR *dirp); -extern struct direct *readdirver (DIR *dirp); -extern long telldir (DIR *dirp); -extern void seekdir (DIR *dirp, long loc); - -#define rewinddir( dirp ) seekdir( dirp, 0L ) -#endif diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/sys/file.h --- a/w32/inc/sys/file.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -/* - * sys\file.h doesn't exist on NT - only needed for these constants - */ - -#define F_OK 0 -#define X_OK 1 -#define W_OK 2 -#define R_OK 4 diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/sys/ioctl.h --- a/w32/inc/sys/ioctl.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -/* - * sys\ioctl.h doesn't exist on NT...rather than including it conditionally - * in many of the source files, we just extend the include path so that the - * compiler will pick this up empty header instead. - */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/sys/param.h --- a/w32/inc/sys/param.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -#ifndef _PARAM_H_ -#define _PARAM_H_ - -/* - * sys\param.h doesn't exist on NT, so we'll make one. - */ - -#define NBPG 4096 - -#endif /* _PARAM_H_ */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/sys/socket.h --- a/w32/inc/sys/socket.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,119 +0,0 @@ -/* Workable version of based on winsock.h */ - -#ifndef _SOCKET_H_ -#define _SOCKET_H_ - -/* defeat the multiple include protection */ -#ifdef _WINSOCKAPI_ -#undef _WINSOCKAPI_ -#endif - -/* avoid confusion with our version of select */ -#ifdef select -#undef select -#define MUST_REDEF_SELECT -#endif - -/* avoid clashing with our version of FD_SET if already defined */ -#ifdef FD_SET -#undef FD_SET -#undef FD_CLR -#undef FD_ISSET -#undef FD_ZERO -#endif - -/* allow us to provide our own version of fd_set */ -#define fd_set ws_fd_set - -/* avoid duplicate definition of timeval */ -#ifdef HAVE_TIMEVAL -#define timeval ws_timeval -#endif - -#include - -/* redefine select to reference our version */ -#ifdef MUST_REDEF_SELECT -#define select sys_select -#undef MUST_REDEF_SELECT -#endif - -/* revert to our version of FD_SET */ -#undef FD_SET -#undef FD_CLR -#undef FD_ISSET -#undef FD_ZERO -#undef fd_set -#include "nt.h" - -#ifdef HAVE_TIMEVAL -#undef timeval -#endif - -/* shadow functions where we provide our own wrapper */ -#define socket sys_socket -#define bind sys_bind -#define connect sys_connect -#define htons sys_htons -#define ntohs sys_ntohs -#define inet_addr sys_inet_addr -#define gethostname sys_gethostname -#define gethostbyname sys_gethostbyname -#define getservbyname sys_getservbyname - -int sys_socket(int af, int type, int protocol); -int sys_bind (int s, const struct sockaddr *addr, int namelen); -int sys_connect (int s, const struct sockaddr *addr, int namelen); -u_short sys_htons (u_short hostshort); -u_short sys_ntohs (u_short netshort); -unsigned long sys_inet_addr (const char * cp); -int sys_gethostname (char * name, int namelen); -struct hostent * sys_gethostbyname(const char * name); -struct servent * sys_getservbyname(const char * name, const char * proto); - -/* we are providing a real h_errno variable */ -#undef h_errno -extern int h_errno; - -/* map winsock error codes to standard names */ -#define EWOULDBLOCK WSAEWOULDBLOCK -#define EINPROGRESS WSAEINPROGRESS -#define EALREADY WSAEALREADY -#define ENOTSOCK WSAENOTSOCK -#define EDESTADDRREQ WSAEDESTADDRREQ -#define EMSGSIZE WSAEMSGSIZE -#define EPROTOTYPE WSAEPROTOTYPE -#define ENOPROTOOPT WSAENOPROTOOPT -#define EPROTONOSUPPORT WSAEPROTONOSUPPORT -#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT -#define EOPNOTSUPP WSAEOPNOTSUPP -#define EPFNOSUPPORT WSAEPFNOSUPPORT -#define EAFNOSUPPORT WSAEAFNOSUPPORT -#define EADDRINUSE WSAEADDRINUSE -#define EADDRNOTAVAIL WSAEADDRNOTAVAIL -#define ENETDOWN WSAENETDOWN -#define ENETUNREACH WSAENETUNREACH -#define ENETRESET WSAENETRESET -#define ECONNABORTED WSAECONNABORTED -#define ECONNRESET WSAECONNRESET -#define ENOBUFS WSAENOBUFS -#define EISCONN WSAEISCONN -#define ENOTCONN WSAENOTCONN -#define ESHUTDOWN WSAESHUTDOWN -#define ETOOMANYREFS WSAETOOMANYREFS -#define ETIMEDOUT WSAETIMEDOUT -#define ECONNREFUSED WSAECONNREFUSED -#define ELOOP WSAELOOP -/* #define ENAMETOOLONG WSAENAMETOOLONG */ -#define EHOSTDOWN WSAEHOSTDOWN -#define EHOSTUNREACH WSAEHOSTUNREACH -/* #define ENOTEMPTY WSAENOTEMPTY */ -#define EPROCLIM WSAEPROCLIM -#define EUSERS WSAEUSERS -#define EDQUOT WSAEDQUOT -#define ESTALE WSAESTALE -#define EREMOTE WSAEREMOTE - -#endif /* _SOCKET_H_ */ - -/* end of socket.h */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/sys/time.h --- a/w32/inc/sys/time.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ -/* - * sys/time.h doesn't exist on NT - */ - -#include - -struct timeval - { - long tv_sec; /* seconds */ - long tv_usec; /* microseconds */ - }; - -struct timezone - { - int tz_minuteswest; /* minutes west of Greenwich */ - int tz_dsttime; /* type of dst correction */ - }; - -#ifndef HAVE_X_WINDOWS -/* X11R6 on NT provides the single parameter version of this command */ -void gettimeofday (struct timeval *, struct timezone *); -#endif - -/* end of sys/time.h */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/inc/unistd.h --- a/w32/inc/unistd.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -/* Fake unistd.h: config.h already provides most of the relevant things. */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/paths.h --- a/w32/paths.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,49 +0,0 @@ -/* Hey Emacs, this is -*- C -*- code! */ - -/* Synched up with: Not synched with FSF. */ - -/* Think twice before editing this file. Generated automatically by configure. - - The file startup.el guesses at reasonable values for load-path, exec-path, - and lock-directory. This means that if you move emacs and its associated - sub-tree to a different place in the filesystem, or to a different machine, - you won't have to do anything for it to work. - - If you define the paths in this file then they will take precedence over - any value generated by the heuristic in startup.el. The hardcoded paths - will be checked to see if they are valid, in which case they will be used. - Otherwise the editor will attempt to make its normal guess. - - See the NEWS file for a description of the heuristic used to locate the lisp - and exec directories at startup time. If you are looking at this file - because you are having trouble, then you would be much better off arranging - for those heuristics to succeed than defining the paths in this file. - - ** Let me say that again. If you're editing this file, you're making - ** a mistake. Re-read the section on installation in ../etc/NEWS. - - If it defines anything, this file should define some subset of the following: - - PATH_PREFIX The default value of `prefix-directory'. This is the - default root for everything. - - PATH_LOADSEARCH The default value of `load-path'. - - PATH_EXEC The default value of `exec-directory' and `exec-path'. - (exec-path also contains the value of whatever is in - the PATH environment variable.) - - PATH_DATA The default value of `data-directory'. This - is where architecture-independent files are - searched for. - - PATH_LOCK The name of the directory that contains lock files - with which we record what files are being modified in - Emacs. This directory should be writable by everyone. - If this is specified, the string must end with a slash! - - PATH_SUPERLOCK The name of the file !!!SuperLock!!! in the lock - directory. You probably should let this default... - - PATH_INFO The default value of `Info-directory-list'. - This is where info files are searched for. */ diff -r d8688acf4c5b -r 78f53ef88e17 w32/puresize-adjust.h --- a/w32/puresize-adjust.h Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3 +0,0 @@ -/* Do not edit this file! - Automatically generated by XEmacs */ -# define PURESIZE_ADJUSTMENT (-787836) diff -r d8688acf4c5b -r 78f53ef88e17 w32/runemacs.c --- a/w32/runemacs.c Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,130 +0,0 @@ -/* - Simple program to start Emacs with its console window hidden. - - This program is provided purely for convenience, since most users will - use Emacs in windowing (GUI) mode, and will not want to have an extra - console window lying around. */ - -/* - You may want to define this if you want to be able to install updated - emacs binaries even when other users are using the current version. - The problem with some file servers (notably Novell) is that an open - file cannot be overwritten, deleted, or even renamed. So if someone - is running emacs.exe already, you cannot install a newer version. - By defining CHOOSE_NEWEST_EXE, you can name your new emacs.exe - something else which matches "emacs*.exe", and runemacs will - automatically select the newest emacs executeable in the bin directory. - (So you'll probably be able to delete the old version some hours/days - later). -*/ - -/* #define CHOOSE_NEWEST_EXE */ - -#define WIN32 - -#include -#include -#include - -int WINAPI -WinMain (HINSTANCE hSelf, HINSTANCE hPrev, LPSTR cmdline, int nShow) -{ - STARTUPINFO start; - SECURITY_ATTRIBUTES sec_attrs; - SECURITY_DESCRIPTOR sec_desc; - PROCESS_INFORMATION child; - int wait_for_child = FALSE; - DWORD ret_code = 0; - char *new_cmdline; - char *p; - char modname[MAX_PATH]; - - if (!GetModuleFileName (NULL, modname, MAX_PATH)) - goto error; - if ((p = strrchr (modname, '\\')) == NULL) - goto error; - *p = 0; - - new_cmdline = alloca (MAX_PATH + strlen (cmdline) + 1); - strcpy (new_cmdline, modname); - -#ifdef CHOOSE_NEWEST_EXE - { - /* Silly hack to allow new versions to be installed on - server even when current version is in use. */ - - char * best_name = alloca (MAX_PATH + 1); - FILETIME best_time = {0,0}; - WIN32_FIND_DATA wfd; - HANDLE fh; - p = new_cmdline + strlen (new_cmdline); - strcpy (p, "\\xemacs*.exe "); - fh = FindFirstFile (new_cmdline, &wfd); - if (fh == INVALID_HANDLE_VALUE) - goto error; - do - { - if (wfd.ftLastWriteTime.dwHighDateTime > best_time.dwHighDateTime - || (wfd.ftLastWriteTime.dwHighDateTime == best_time.dwHighDateTime - && wfd.ftLastWriteTime.dwLowDateTime > best_time.dwLowDateTime)) - { - best_time = wfd.ftLastWriteTime; - strcpy (best_name, wfd.cFileName); - } - } - while (FindNextFile (fh, &wfd)); - FindClose (fh); - *p++ = '\\'; - strcpy (p, best_name); - strcat (p, " "); - } -#else - strcat (new_cmdline, "\\xemacs.exe "); -#endif - - /* Append original arguments if any; first look for -wait as first - argument, and apply that ourselves. */ - if (strncmp (cmdline, "-wait", 5) == 0) - { - wait_for_child = TRUE; - cmdline += 5; - } - strcat (new_cmdline, cmdline); - - /* Set emacs_dir variable if runemacs was in "%emacs_dir%\bin". */ - if ((p = strrchr (modname, '\\')) && stricmp (p, "\\bin") == 0) - { - *p = 0; - for (p = modname; *p; p++) - if (*p == '\\') *p = '/'; - SetEnvironmentVariable ("emacs_dir", modname); - } - - memset (&start, 0, sizeof (start)); - start.cb = sizeof (start); - start.dwFlags = STARTF_USESHOWWINDOW; - start.wShowWindow = SW_HIDE; - - sec_attrs.nLength = sizeof (sec_attrs); - sec_attrs.lpSecurityDescriptor = NULL; - sec_attrs.bInheritHandle = FALSE; - - if (CreateProcess (NULL, new_cmdline, &sec_attrs, NULL, TRUE, 0, - NULL, NULL, &start, &child)) - { - if (wait_for_child) - { - WaitForSingleObject (child.hProcess, INFINITE); - GetExitCodeProcess (child.hProcess, &ret_code); - } - CloseHandle (child.hThread); - CloseHandle (child.hProcess); - } - else - goto error; - return (int) ret_code; - -error: - MessageBox (NULL, "Could not start XEmacs.", "Error", MB_ICONSTOP); - return 1; -} diff -r d8688acf4c5b -r 78f53ef88e17 w32/xemacs.mak --- a/w32/xemacs.mak Mon Aug 13 10:05:53 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,547 +0,0 @@ -MSDEV=c:\msdev -XEMACS=.. -LISP=$(XEMACS)\lisp - -HAVE_X=0 -HAVE_W32=1 - -HAVE_MULE=0 - -OPT=-Od -Zi -#OPT=-O2 -G5 -Zi - -#------------------------------------------------------------------------------ - -!if $(HAVE_X) -MAGICK=e:\utils\ImageMagick -X11R6=e:\utils\X11R6 - -X_DEFINES=-DHAVE_X_WINDOWS -X_INCLUDES=-I$(X11R6)\include -I$(MAGICK)\Magick -X_LIBS=Magick.dll.lib Xaw.lib Xmu.lib Xt.lib SM.lib ICE.lib Xext.lib X11.lib -!endif - -!if $(HAVE_W32) -W32_DEFINES=-DHAVE_W32GUI -!endif - -!if $(HAVE_MULE) -MULE_DEFINES=-DMULE -!endif - -!include "..\version.sh" - -#------------------------------------------------------------------------------ - -# Generic variables - -INCLUDES=$(X_INCLUDES) -I$(XEMACS)\nt\inc -I$(XEMACS)\src -I$(XEMACS)\lwlib -DEFINES=$(X_DEFINES) $(W32_DEFINES) $(MULE_DEFINES) -DWIN32 -D_WIN32 \ - -D_M_IX86 -D_X86_ \ - -DWIN32_LEAN_AND_MEAN -DWINDOWSNT -Demacs -DHAVE_CONFIG_H \ - -D_MSC_VER=999 -D_DEBUG -DDEBUG_XEMACS - -OUTDIR=obj - -#------------------------------------------------------------------------------ - -default: $(OUTDIR)\nul all - -$(OUTDIR)\nul: - -@mkdir $(OUTDIR) - -XEMACS_INCLUDES=\ - $(XEMACS)\src\config.h \ - $(XEMACS)\src\Emacs.ad.h \ - $(XEMACS)\src\paths.h - -$(XEMACS_INCLUDES): - !copy *.h $(XEMACS)\src - -#------------------------------------------------------------------------------ - -# LASTFILE Library - -LASTFILE=$(OUTDIR)\lastfile.lib -LASTFILE_SRC=$(XEMACS)\src -LASTFILE_FLAGS=-nologo -w $(OPT) $(INCLUDES) -Fo$@ -c -LASTFILE_OBJS= \ - $(OUTDIR)\lastfile.obj - -$(LASTFILE): $(LASTFILE_OBJS) - link.exe -lib -nologo -out:$@ $(LASTFILE_OBJS) - -$(OUTDIR)\lastfile.obj: $(LASTFILE_SRC)\lastfile.c - $(CC) $(LASTFILE_FLAGS) $** - -#------------------------------------------------------------------------------ - -!if $(HAVE_X) - -# LWLIB Library - -LWLIB=$(OUTDIR)\lwlib.lib -LWLIB_SRC=$(XEMACS)\lwlib -LWLIB_FLAGS=-nologo -w $(OPT) $(INCLUDES) $(DEFINES) \ - -DNEED_ATHENA -DNEED_LUCID \ - -D_WINDOWS -DMENUBARS_LUCID -DSCROLLBARS_LUCID -DDIALOGS_ATHENA \ - -Fo$@ -c -LWLIB_OBJS= \ - $(OUTDIR)\lwlib-config.obj \ - $(OUTDIR)\lwlib-utils.obj \ - $(OUTDIR)\lwlib-Xaw.obj \ - $(OUTDIR)\lwlib-Xlw.obj \ - $(OUTDIR)\lwlib.obj \ - $(OUTDIR)\xlwmenu.obj \ - $(OUTDIR)\xlwscrollbar.obj - -$(LWLIB): $(XEMACS_INCLUDES) $(LWLIB_OBJS) - link.exe -lib -nologo -debugtype:both -out:$@ $(LWLIB_OBJS) - -$(OUTDIR)\lwlib-config.obj: $(LWLIB_SRC)\lwlib-config.c - $(CC) $(LWLIB_FLAGS) $** - -$(OUTDIR)\lwlib-utils.obj: $(LWLIB_SRC)\lwlib-utils.c - $(CC) $(LWLIB_FLAGS) $** - -$(OUTDIR)\lwlib-Xaw.obj: $(LWLIB_SRC)\lwlib-Xaw.c - $(CC) $(LWLIB_FLAGS) $** - -$(OUTDIR)\lwlib-Xlw.obj: $(LWLIB_SRC)\lwlib-Xlw.c - $(CC) $(LWLIB_FLAGS) $** - -$(OUTDIR)\lwlib.obj: $(LWLIB_SRC)\lwlib.c - $(CC) $(LWLIB_FLAGS) $** - -$(OUTDIR)\xlwmenu.obj: $(LWLIB_SRC)\xlwmenu.c - $(CC) $(LWLIB_FLAGS) $** - -$(OUTDIR)\xlwscrollbar.obj: $(LWLIB_SRC)\xlwscrollbar.c - $(CC) $(LWLIB_FLAGS) $** - -!endif -#------------------------------------------------------------------------------ - -# lib-src programs - -LIB_SRC=$(XEMACS)\lib-src -LIB_SRC_FLAGS=$(INCLUDES) $(DEFINES) -ML -LIB_SRC_LIBS= kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ - advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib \ - odbccp32.lib libc.lib -LIB_SRC_LFLAGS=-nologo $(LIB_SRC_LIBS) -base:0x1000000\ - -subsystem:console -pdb:none -debugtype:both -machine:I386\ - -nodefaultlib -out:$@ -debug:full - -DOC=$(LIB_SRC)\DOC -DOC_SRC1=\ - $(XEMACS)\src\abbrev.c \ - $(XEMACS)\src\alloc.c \ - $(XEMACS)\src\alloca.c \ - $(XEMACS)\src\blocktype.c \ - $(XEMACS)\src\buffer.c \ - $(XEMACS)\src\bytecode.c \ - $(XEMACS)\src\callint.c \ - $(XEMACS)\src\callproc.c \ - $(XEMACS)\src\casefiddle.c \ - $(XEMACS)\src\casetab.c \ - $(XEMACS)\src\chartab.c \ - $(XEMACS)\src\cmdloop.c \ - $(XEMACS)\src\cmds.c \ - $(XEMACS)\src\console-stream.c \ - $(XEMACS)\src\console.c \ - $(XEMACS)\src\data.c \ - $(XEMACS)\src\debug.c \ - $(XEMACS)\src\device.c \ - $(XEMACS)\src\dgif_lib.c -DOC_SRC2=\ - $(XEMACS)\src\dialog.c \ - $(XEMACS)\src\dired.c \ - $(XEMACS)\src\doc.c \ - $(XEMACS)\src\doprnt.c \ - $(XEMACS)\src\dynarr.c \ - $(XEMACS)\src\editfns.c \ - $(XEMACS)\src\elhash.c \ - $(XEMACS)\src\emacs.c \ - $(XEMACS)\src\eval.c \ - $(XEMACS)\src\event-stream.c \ - $(XEMACS)\src\event-unixoid.c \ - $(XEMACS)\src\events.c \ - $(XEMACS)\src\extents.c \ - $(XEMACS)\src\faces.c \ - $(XEMACS)\src\fileio.c \ - $(XEMACS)\src\filelock.c \ - $(XEMACS)\src\filemode.c \ - $(XEMACS)\src\floatfns.c \ - $(XEMACS)\src\fns.c -DOC_SRC3=\ - $(XEMACS)\src\font-lock.c \ - $(XEMACS)\src\frame.c \ - $(XEMACS)\src\free-hook.c \ - $(XEMACS)\src\general.c \ - $(XEMACS)\src\gif_err.c \ - $(XEMACS)\src\gifalloc.c \ - $(XEMACS)\src\glyphs.c \ - $(XEMACS)\src\gmalloc.c \ - $(XEMACS)\src\gui.c \ - $(XEMACS)\src\hash.c \ - $(XEMACS)\src\indent.c \ - $(XEMACS)\src\inline.c \ - $(XEMACS)\src\insdel.c \ - $(XEMACS)\src\intl.c \ - $(XEMACS)\src\keymap.c \ - $(XEMACS)\src\lread.c \ - $(XEMACS)\src\lstream.c \ - $(XEMACS)\src\macros.c \ - $(XEMACS)\src\marker.c -DOC_SRC4=\ - $(XEMACS)\src\md5.c \ - $(XEMACS)\src\minibuf.c \ - $(XEMACS)\src\nt.c \ - $(XEMACS)\src\ntheap.c \ - $(XEMACS)\src\ntproc.c \ - $(XEMACS)\src\objects.c \ - $(XEMACS)\src\opaque.c \ - $(XEMACS)\src\print.c \ - $(XEMACS)\src\process.c \ - $(XEMACS)\src\pure.c \ - $(XEMACS)\src\rangetab.c \ - $(XEMACS)\src\realpath.c \ - $(XEMACS)\src\redisplay-output.c \ - $(XEMACS)\src\redisplay.c \ - $(XEMACS)\src\regex.c \ - $(XEMACS)\src\scrollbar.c \ - $(XEMACS)\src\search.c \ - $(XEMACS)\src\signal.c \ - $(XEMACS)\src\sound.c -DOC_SRC5=\ - $(XEMACS)\src\specifier.c \ - $(XEMACS)\src\strftime.c \ - $(XEMACS)\src\symbols.c \ - $(XEMACS)\src\syntax.c \ - $(XEMACS)\src\sysdep.c \ - $(XEMACS)\src\termcap.c \ - $(XEMACS)\src\tparam.c \ - $(XEMACS)\src\undo.c \ - $(XEMACS)\src\unexnt.c \ - $(XEMACS)\src\vm-limit.c \ - $(XEMACS)\src\window.c \ - $(XEMACS)\src\xgccache.c \ - $(XEMACS)\src\xmu.c \ - $(XEMACS)\src\widget.c - -!if $(HAVE_X) -DOC_SRC6=\ - $(XEMACS)\src\balloon_help.c \ - $(XEMACS)\src\console-x.c \ - $(XEMACS)\src\device-x.c \ - $(XEMACS)\src\dialog-x.c \ - $(XEMACS)\src\EmacsFrame.c \ - $(XEMACS)\src\EmacsManager.c \ - $(XEMACS)\src\EmacsShell-sub.c\ - $(XEMACS)\src\EmacsShell.c \ - $(XEMACS)\src\event-Xt.c \ - $(XEMACS)\src\frame-x.c \ - $(XEMACS)\src\glyphs-x.c \ - $(XEMACS)\src\gui-x.c \ - $(XEMACS)\src\menubar.c \ - $(XEMACS)\src\menubar-x.c \ - $(XEMACS)\src\objects-x.c \ - $(XEMACS)\src\redisplay-x.c \ - $(XEMACS)\src\scrollbar-x.c \ - $(XEMACS)\src\balloon-x.c \ - $(XEMACS)\src\xselect.c -!endif - -!if $(HAVE_W32) -DOC_SRCS_7=\ - $(XEMACS)\src\console-w32.c \ - $(XEMACS)\src\device-w32.c \ - $(XEMACS)\src\event-w32.c \ - $(XEMACS)\src\frame-w32.c \ - $(XEMACS)\src\objects-w32.c \ - $(XEMACS)\src\redisplay-w32.c \ - $(XEMACS)\src\w32-proc.c -!endif - -!if $(HAVE_MULE) -DOC_SRCS_8=\ - $(XEMACS)\src\input-method-xlib.c \ - $(XEMACS)\src\mule.c \ - $(XEMACS)\src\mule-charset.c \ - $(XEMACS)\src\mule-ccl.c \ - $(XEMACS)\src\mule-coding.c -!endif - -MAKE_DOCFILE=$(LIB_SRC)\make-docfile.exe - -$(MAKE_DOCFILE): $(OUTDIR)\make-docfile.obj - link.exe -out:$@ $(LIB_SRC_LFLAGS) $** $(LIB_SRC_LIBS) - -$(OUTDIR)\make-docfile.obj: $(LIB_SRC)\make-docfile.c - $(CC) $(LIB_SRC_FLAGS) -c $** -Fo$@ - -RUNEMACS=$(XEMACS)\src\runemacs.exe - -$(RUNEMACS): $(OUTDIR)\runemacs.obj - link.exe -out:$@ -subsystem:windows -entry:WinMainCRTStartup \ - -pdb:none -release -incremental:no $** \ - kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib \ - advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib \ - odbccp32.lib libc.lib - -$(OUTDIR)\runemacs.obj: $(XEMACS)\nt\runemacs.c - $(CC) -nologo -ML -w $(OPT) -c \ - -D_DEBUG -DWIN32 -D_WIN32 -DWIN32_LEAN_AND_MEAN \ - -D_M_IX86 -D_X86_ -Demacs -DHAVE_CONFIG_H -D_MSC_VER=999 \ - $** -Fo$@ - -SUPPORT_PROGS=$(MAKE_DOCFILE) $(RUNEMACS) - -#------------------------------------------------------------------------------ - -# TEMACS Executable - -TEMACS_DIR=$(XEMACS)\src -TEMACS=$(TEMACS_DIR)\temacs.exe -TEMACS_SRC=$(XEMACS)\src -TEMACS_LIBS=$(LASTFILE) $(LWLIB) $(X_LIBS) kernel32.lib user32.lib gdi32.lib \ - winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib \ - uuid.lib odbc32.lib odbccp32.lib wsock32.lib libc.lib -TEMACS_LFLAGS=-nologo $(LIBRARIES) -base:0x1000000\ - -stack:0x800000 -entry:_start -subsystem:console\ - -pdb:$(TEMACS_DIR)\temacs.pdb -map:$(TEMACS_DIR)\temacs.map -debug:full\ - -heap:0x00100000 -out:$@\ - -TEMACS_CPP_FLAGS= $(INCLUDES) $(DEFINES) \ - -DEMACS_MAJOR_VERSION=$(emacs_major_version) \ - -DEMACS_MINOR_VERSION=$(emacs_minor_version) \ - -DXEMACS_CODENAME=\"$(xemacs_codename)\" \ - -DPATH_PREFIX=\"$(XEMACS)\" -TEMACS_FLAGS=-nologo -ML -w $(OPT) -c $(TEMACS_CPP_FLAGS) - -!if $(HAVE_X) -TEMACS_X_OBJS=\ - $(OUTDIR)\balloon-x.obj \ - $(OUTDIR)\balloon_help.obj \ - $(OUTDIR)\console-x.obj \ - $(OUTDIR)\device-x.obj \ - $(OUTDIR)\dialog-x.obj \ - $(OUTDIR)\EmacsFrame.obj \ - $(OUTDIR)\EmacsManager.obj \ - $(OUTDIR)\EmacsShell.obj \ - $(OUTDIR)\TopLevelEmacsShell.obj\ - $(OUTDIR)\TransientEmacsShell.obj\ - $(OUTDIR)\event-Xt.obj \ - $(OUTDIR)\frame-x.obj \ - $(OUTDIR)\glyphs-x.obj \ - $(OUTDIR)\gui-x.obj \ - $(OUTDIR)\menubar.obj \ - $(OUTDIR)\menubar-x.obj \ - $(OUTDIR)\objects-x.obj \ - $(OUTDIR)\redisplay-x.obj \ - $(OUTDIR)\scrollbar.obj \ - $(OUTDIR)\scrollbar-x.obj \ - $(OUTDIR)\xgccache.obj \ - $(OUTDIR)\xmu.obj \ - $(OUTDIR)\xselect.obj -!endif - -!if $(HAVE_W32) -TEMACS_W32_OBJS=\ - $(OUTDIR)\console-w32.obj \ - $(OUTDIR)\device-w32.obj \ - $(OUTDIR)\event-w32.obj \ - $(OUTDIR)\frame-w32.obj \ - $(OUTDIR)\objects-w32.obj \ - $(OUTDIR)\redisplay-w32.obj \ - $(OUTDIR)\w32-proc.obj -!endif - -!if $(HAVE_MULE) -TEMACS_MULE_OBJS=\ - $(OUTDIR)\input-method-xlib.obj \ - $(OUTDIR)\mule.obj \ - $(OUTDIR)\mule-charset.obj \ - $(OUTDIR)\mule-ccl.obj \ - $(OUTDIR)\mule-coding.obj \ -!endif - -TEMACS_OBJS= \ - $(TEMACS_X_OBJS)\ - $(TEMACS_W32_OBJS)\ - $(TEMACS_MULE_OBJS)\ - $(OUTDIR)\abbrev.obj \ - $(OUTDIR)\alloc.obj \ - $(OUTDIR)\alloca.obj \ - $(OUTDIR)\blocktype.obj \ - $(OUTDIR)\buffer.obj \ - $(OUTDIR)\bytecode.obj \ - $(OUTDIR)\callint.obj \ - $(OUTDIR)\callproc.obj \ - $(OUTDIR)\casefiddle.obj \ - $(OUTDIR)\casetab.obj \ - $(OUTDIR)\chartab.obj \ - $(OUTDIR)\cmdloop.obj \ - $(OUTDIR)\cmds.obj \ - $(OUTDIR)\console-stream.obj \ - $(OUTDIR)\console.obj \ - $(OUTDIR)\data.obj \ - $(OUTDIR)\debug.obj \ - $(OUTDIR)\device.obj \ - $(OUTDIR)\dgif_lib.obj \ - $(OUTDIR)\dialog.obj \ - $(OUTDIR)\dired.obj \ - $(OUTDIR)\doc.obj \ - $(OUTDIR)\doprnt.obj \ - $(OUTDIR)\dynarr.obj \ - $(OUTDIR)\editfns.obj \ - $(OUTDIR)\elhash.obj \ - $(OUTDIR)\emacs.obj \ - $(OUTDIR)\eval.obj \ - $(OUTDIR)\event-stream.obj \ - $(OUTDIR)\event-unixoid.obj \ - $(OUTDIR)\events.obj \ - $(OUTDIR)\extents.obj \ - $(OUTDIR)\faces.obj \ - $(OUTDIR)\fileio.obj \ - $(OUTDIR)\filelock.obj \ - $(OUTDIR)\filemode.obj \ - $(OUTDIR)\floatfns.obj \ - $(OUTDIR)\fns.obj \ - $(OUTDIR)\font-lock.obj \ - $(OUTDIR)\frame.obj \ - $(OUTDIR)\free-hook.obj \ - $(OUTDIR)\general.obj \ - $(OUTDIR)\gif_err.obj \ - $(OUTDIR)\gifalloc.obj \ - $(OUTDIR)\glyphs.obj \ - $(OUTDIR)\gmalloc.obj \ - $(OUTDIR)\gui.obj \ - $(OUTDIR)\hash.obj \ - $(OUTDIR)\indent.obj \ - $(OUTDIR)\inline.obj \ - $(OUTDIR)\insdel.obj \ - $(OUTDIR)\intl.obj \ - $(OUTDIR)\keymap.obj \ - $(OUTDIR)\lread.obj \ - $(OUTDIR)\lstream.obj \ - $(OUTDIR)\macros.obj \ - $(OUTDIR)\marker.obj \ - $(OUTDIR)\md5.obj \ - $(OUTDIR)\minibuf.obj \ - $(OUTDIR)\nt.obj \ - $(OUTDIR)\ntheap.obj \ - $(OUTDIR)\ntproc.obj \ - $(OUTDIR)\objects.obj \ - $(OUTDIR)\opaque.obj \ - $(OUTDIR)\print.obj \ - $(OUTDIR)\process.obj \ - $(OUTDIR)\pure.obj \ - $(OUTDIR)\rangetab.obj \ - $(OUTDIR)\realpath.obj \ - $(OUTDIR)\redisplay-output.obj \ - $(OUTDIR)\redisplay.obj \ - $(OUTDIR)\regex.obj \ - $(OUTDIR)\search.obj \ - $(OUTDIR)\signal.obj \ - $(OUTDIR)\sound.obj \ - $(OUTDIR)\specifier.obj \ - $(OUTDIR)\strftime.obj \ - $(OUTDIR)\symbols.obj \ - $(OUTDIR)\syntax.obj \ - $(OUTDIR)\sysdep.obj \ - $(OUTDIR)\tparam.obj \ - $(OUTDIR)\undo.obj \ - $(OUTDIR)\unexnt.obj \ - $(OUTDIR)\vm-limit.obj \ - $(OUTDIR)\widget.obj \ - $(OUTDIR)\window.obj - -# Rules - -.SUFFIXES: -.SUFFIXES: .c - -# nmake rule -{$(TEMACS_SRC)}.c{$(OUTDIR)}.obj: - $(CC) $(TEMACS_FLAGS) $< -Fo$@ -Fr$*.sbr - -$(OUTDIR)\TopLevelEmacsShell.obj: $(TEMACS_SRC)\EmacsShell-sub.c - $(CC) $(TEMACS_FLAGS) -DDEFINE_TOP_LEVEL_EMACS_SHELL $** -Fo$@ - -$(OUTDIR)\TransientEmacsShell.obj: $(TEMACS_SRC)\EmacsShell-sub.c - $(CC) $(TEMACS_FLAGS) -DDEFINE_TRANSIENT_EMACS_SHELL $** -Fo$@ - -#$(TEMACS_SRC)\Emacs.ad.h: $(XEMACS)\etc\Emacs.ad -# !"sed -f ad2c.sed < $(XEMACS)\etc\Emacs.ad > $(TEMACS_SRC)\Emacs.ad.h" - -#$(TEMACS_SRC)\paths.h: $(TEMACS_SRC)\paths.h.in -# !"cd $(TEMACS_SRC); cp paths.h.in paths.h" - -$(TEMACS): $(TEMACS_INCLUDES) $(TEMACS_OBJS) - link.exe @<< - $(TEMACS_LFLAGS) $(TEMACS_OBJS) $(TEMACS_LIBS) -<< - -#------------------------------------------------------------------------------ - -# LISP bits 'n bobs - -LOADPATH=$(LISP)\prim - -$(DOC): $(LOADPATH)\startup.elc $(LIB_SRC)\make-docfile.exe - !$(TEMACS) -batch -l make-docfile.el -- -o $(DOC) -i $(XEMACS)\site-packages - !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC1) - !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC2) - !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC3) - !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC4) - !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC5) - !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC6) - !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC7) - !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC8) - -$(LOADPATH)\startup.elc: $(LOADPATH)\startup.el - !$(TEMACS) -batch -l update-elc.el - -dump-xemacs: - cd $(TEMACS_DIR) - !$(TEMACS) -batch -l loadup.el dump - -#------------------------------------------------------------------------------ - -# use this rule to build the complete system -all: $(LASTFILE) $(LWLIB) $(SUPPORT_PROGS) $(TEMACS) $(DOC) dump-xemacs - -# use this rule to install the system -install: - -# The last line demands that you have a semi-decent shell -distclean: - del *.bak - del *.pdb - del *.tmp - cd $(OUTDIR) - del *.obj - del *.sbr - del *.lib - cd ..\$(TEMACS_DIR) - del config.h - del paths.h - del puresize-adjust.h - del *.bak - del *.exe - del *.map - del *.bsc - del *.pdb - cd $(LIB_SRC) - del DOC - del *.bak - del *.exe - cd $(LISP) - del /s /q *.elc - -depend: - mkdepend -f xemacs.mak -p$(OUTDIR)\ -o.obj -w9999 -- $(TEMACS_CPP_FLAGS) -- $(DOC_SRC1) $(DOC_SRC2) $(DOC_SRC3) $(DOC_SRC4) $(DOC_SRC5) $(DOC_SRC6) $(DOC_SRC7) $(LASTFILE_SRC)\lastfile.c $(LIB_SRC)\make-docfile.c .\runemacs.c - -# DO NOT DELETE THIS LINE -- make depend depends on it.