[AC21.4] Ben's sheap.c change
20 years, 2 months
Vin Shelton
Vin Shelton
src/ChangeLog addition:
2005-01-28 Vin Shelton <acs(a)xemacs.org>
* sheap.c (more_static_core): Applied Ben's version of the long
string patch.
21.4 source patch:
Diff command: cvs -q diff -u
Files affected: src/sheap.c
Index: src/sheap.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sheap.c,v
retrieving revision 1.12.2.1
diff -a -u -u -r1.12.2.1 sheap.c
--- src/sheap.c 2005/01/25 01:15:30 1.12.2.1
+++ src/sheap.c 2005/01/29 01:08:49
＠＠ -81,16 +81,16 ＠＠
if (static_heap_ptr + size >= static_heap_base + static_heap_size)
{
printf(
-"\nRequested %d bytes, static heap exhausted! base is %p, current ptr\n\
-is %p. You have exhausted the static heap.\n\
-\n\
-If you are simply trying to compile, remove sheap-adjust.h\n\
-and recompile from the top level. If this doesn't\n\
-work then STATIC_HEAP_SLOP (defined in this file) is too small.\n\
-\n\
-If you want to run temacs, change SHEAP_ADJUSTMENT in sheap-adjust.h\n\
-to 0 or a +ve number. Generally you should *not* try to run temacs\n\
-with a static heap, you should dump first.\n", size,
+"\nRequested %d bytes, static heap exhausted! base is %p, current ptr\n"
+"is %p. You have exhausted the static heap. \n"
+"\n"
+"If you are simply trying to compile, remove sheap-adjust.h\n"
+"and recompile from the top level. If this doesn't\n"
+"work then STATIC_HEAP_SLOP (defined in this file) is too small.\n"
+"\n"
+"If you want to run temacs, change SHEAP_ADJUSTMENT in sheap-adjust.h\n"
+"to 0 or a +ve number. Generally you should *not* try to run temacs\n"
+"with a static heap, you should dump first.\n", size,
static_heap_base, static_heap_ptr);
exit(-1);
- 1 participants
- 0 comments
(21.4) [COMMIT] Fixes to xemacs.mak
20 years, 2 months
Ben Wing
Ben Wing
NOTE: This patch has been committed.
Recommended for 21.4.
nt/ChangeLog addition:
2005-01-27 Ben Wing <ben(a)xemacs.org>
* xemacs.mak ({$(MANDIR)}.texi{$(INFODIR)}.info):
Use filename only when calling makeinfo, or it chokes on index
generation.
* xemacs.mak (TEMACS_COMMON_LFLAGS):
* xemacs.mak ( $(XEMACS_LFLAGS) -section):
Generate separate .pdb and .map files for temacs/xemacs; may
make profiling possible.
smallfix source patch:
Diff command: bash -ci "cvs-diff --show-c-function -no-changelog "
Files affected: nt/xemacs.mak
Index: nt/xemacs.mak
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/nt/xemacs.mak,v
retrieving revision 1.110
diff -u -p -r1.110 xemacs.mak
--- nt/xemacs.mak 2005/01/24 23:33:40 1.110
+++ nt/xemacs.mak 2005/01/28 01:52:51
＠＠ -962,7 +962,7 ＠＠ INFO_FILES= \
{$(MANDIR)}.texi{$(INFODIR)}.info:
cd $(MANDIR)
- $(MAKEINFO) $**
+ $(MAKEINFO) $(**F)
XEMACS_SRCS = \
$(MANDIR)\xemacs\abbrevs.texi \
＠＠ -1263,10 +1263,13 ＠＠ TEMACS_LIBS=$(LASTFILE) $(MSW_LIBS) \
oldnames.lib kernel32.lib user32.lib gdi32.lib comdlg32.lib advapi32.lib \
shell32.lib wsock32.lib netapi32.lib winmm.lib winspool.lib ole32.lib \
mpr.lib uuid.lib imm32.lib $(LIBC_LIB)
-TEMACS_LFLAGS=-nologo $(LIBRARIES) $(DEBUG_FLAGS_LINK) \
+TEMACS_COMMON_LFLAGS=-nologo $(LIBRARIES) $(DEBUG_FLAGS_LINK) \
-base:0x1000000 -stack:0x800000 $(TEMACS_ENTRYPOINT) -subsystem:windows \
- -pdb:$(BLDSRC)\temacs.pdb -map:$(BLDSRC)\temacs.map \
-heap:0x00100000 -nodefaultlib $(PROFILE_FLAGS) setargv.obj
+TEMACS_LFLAGS=$(TEMACS_COMMON_LFLAGS) \
+ -pdb:$(BLDSRC)\temacs.pdb -map:$(BLDSRC)\temacs.map
+XEMACS_LFLAGS=$(TEMACS_COMMON_LFLAGS) \
+ -pdb:$(BLDSRC)\xemacs.pdb -map:$(BLDSRC)\xemacs.map
########################### Definitions for running temacs.exe/xemacs.exe
＠＠ -1380,7 +1383,7 ＠＠ $(DUMP_TARGET): $(DOC) $(RAW_EXE) $(BLDS
# Make the resource section read/write since almost all of it is the dump
# data which needs to be writable. This avoids having to copy it.
link.exe ＠<<
- $(TEMACS_LFLAGS) -section:.rsrc,rw -out:$(BLDSRC)\xemacs.exe $(TEMACS_OBJS) $(OUTDIR)\xemacs.res $(TEMACS_LIBS) $(OUTDIR)\dump-id.obj
+ $(XEMACS_LFLAGS) -section:.rsrc,rw -out:$(BLDSRC)\xemacs.exe $(TEMACS_OBJS) $(OUTDIR)\xemacs.res $(TEMACS_LIBS) $(OUTDIR)\dump-id.obj
<<
-$(DEL) $(BLDSRC)\xemacs.dmp
!endif
- 2 participants
- 1 comments
[COMMIT] compface -> 1.5.1 in config.inc.samp
20 years, 2 months
Ben Wing
Ben Wing
NOTE: This patch has been committed.
nt/ChangeLog addition:
2005-01-28 Ben Wing <ben(a)xemacs.org>
* config.inc.samp (COMPFACE_DIR):
Change version to 1.5.1 in accordance with FTP site.
build source patch:
Diff command: bash -ci "cvs-diff --show-c-function -no-changelog "
Files affected: nt/config.inc.samp
Index: nt/config.inc.samp
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/nt/config.inc.samp,v
retrieving revision 1.17
diff -u -p -r1.17 config.inc.samp
--- nt/config.inc.samp 2005/01/24 23:33:39 1.17
+++ nt/config.inc.samp 2005/01/29 00:32:07
＠＠ -68,7 +68,7 ＠＠ TIFF_DIR=$(OPTIONAL_LIBRARY_DIR)\tiff-v3
# directory containing compface. Get the library from
# http://ftp.xemacs.org/aux/compface-1.5.tar.gz.
HAVE_XFACE=1
-COMPFACE_DIR=$(OPTIONAL_LIBRARY_DIR)\compface-1.5
+COMPFACE_DIR=$(OPTIONAL_LIBRARY_DIR)\compface-1.5.1
############################################################################
# Build settings #
- 1 participants
- 0 comments
Storefront FAQ Part 2
20 years, 2 months
HotWebsites.us
HotWebsites.us
eBay Store Frequently Asked Questions
Q. Where can I open an eBay Store at no cost?
A. http://pages.ebay.com/storefronts/start.html
Q. What is a Good 'Til Cancelled (GTC) listing duration?
A. Good 'Til Cancelled (GTC) is Stores fixed price listing duration that
allows you to list an item and have that listing automatically renew every
30 days as long as there is quantity available. This listing will recur
each 30-day period until you choose to end this listing and will maintain
the same listing number for the entire life of the listing. eBay will not
end this listing for you.
Q. What fees are associated with GTC listings?
A. There are no additional fees for using the GTC duration option.
Q. What does the Cross-Promotions tool do?
A. eBay Stores' Cross Promotion tool gives Store sellers complete control
over which products are cross-promoted to their buyers, thereby allowing
Store sellers to show the right product at the right time to the right
buyer. Cross-promotions help sellers sell more because they prominently
display the other items they're offering, thereby encouraging buyers to
purchase additional items or higher-value items. To see how it works,
visit the Cross-Promotions tutorial at
http://www.ebay.com/stores/cross-promotions/tutorial/index.html
Q. What is email marketing?
A. Email Marketing is a tool for eBay Stores sellers that allows them to
send email to interested buyers who have opted-in to their email mailing
lists.
Q. How will I know that my email is reaching anyone?
A. The email marketing tool has a powerful tracking mechanism built in
which allows the sender to see the number of recipients who opened the
email, clicked on links, and bid or bought directly from the email. This
is extremely helpful to sellers in understanding which messages or product
offers are most effective, and helps sellers fine-tune their marketing
strategy.
Q. What's Export Seller Listings?
A. Store sellers can opt to have eBay make an XML file of their listings
available for pickup by other search engines or shopping comparison sites.
Learn more about Export Seller Listings at
http://pages.ebay.com/help/sell/contextual/export-listings.html
Q. How does the Selling Manager Pro Credit work for Featured and Anchor
Stores?
A. Featured and Anchor Stores will not be charged for Selling Manager Pro
as long as they maintain their Featured or Anchor Store subscription.
Sellers who are already Selling Manager Pro users who subscribe to a
Featured or Anchor Store will begin receiving the free Selling Manager Pro
subscription on the invoice after they subscribed to a Featured or Anchor
Store.
Open an eBay Store at no cost
http://pages.ebay.com/storefronts/start.html
If you are not yet an authorized reseller today is the perfect time for
you to get started. Please log in to your member account at
http://66.34.230.9/login.php and click on the "Sell our websites" Help
Pages link. You should also check out the "Sell using online auctions" and
"Selling on eBay.com" pages. These pages will give you almost all of the
information you need regarding reselling our websites and they will also
get you started with the online auctions. Also remember to email us so
that we can add your information to our list of authorized resellers. If
you have any specific questions after reading this information please ask
and we will do everything possible to assist you :)
http://66.34.230.9/login.php
username= xemacspatches
password= 208871
You are receiving this email because you are a member of HotWebsites.us.
If you would like to change your email preferences please contact customer
service at Help(a)HotWebsites.us
- 1 participants
- 0 comments
[COMMIT] fix aliasing warning
20 years, 2 months
Ben Wing
Ben Wing
NOTE: This patch has been committed.
src/ChangeLog addition:
2005-01-26 Ben Wing <ben(a)xemacs.org>
* free-hook.c (check_free):
Fix aliasing warning.
symlink source patch:
Diff command: bash -ci "cvs-diff --show-c-function -no-changelog "
Files affected: src/free-hook.c
Index: src/free-hook.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/free-hook.c,v
retrieving revision 1.12
diff -u -p -r1.12 free-hook.c
--- src/free-hook.c 2005/01/24 23:33:56 1.12
+++ src/free-hook.c 2005/01/26 10:35:10
＠＠ -131,7 +131,8 ＠＠ check_free (void *ptr)
#endif
EMACS_INT present = (EMACS_INT) gethash (ptr, pointer_table,
- (const void **) &size);
+ (const void **)
+ (void *) &size);
if (!present)
{
- 2 participants
- 1 comments
[PATCH 21.4] sheap.c printf string patch for gcc-3.3.3 on Cygwin
20 years, 2 months
Vin Shelton
Vin Shelton
Without this fairly bogus patch, I cannot compile 21.4 on Cygwin (at
least using gcc-3.3.3).
Comments? Recommendations?
- Vin
src/ChangeLog addition:
2005-01-24 Vin Shelton <acs(a)xemacs.org>
* sheap.c (more_static_core): Reformatted printf string so
gcc-3.3.3 will compile this on Cygwin.
21.4 source patch:
Diff command: cvs -q diff -u
Files affected: src/sheap.c
Index: src/sheap.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sheap.c,v
retrieving revision 1.12
diff -a -u -u -r1.12 sheap.c
--- src/sheap.c 2001/04/12 18:24:19 1.12
+++ src/sheap.c 2005/01/24 20:58:38
＠＠ -82,17 +82,8 ＠＠
{
printf(
-"\nRequested %d bytes, static heap exhausted! base is %p, current ptr
-is %p. You have exhausted the static heap.
-
-If you are simply trying to compile, remove sheap-adjust.h
-and recompile from the top level. If this doesn't
-work then STATIC_HEAP_SLOP (defined in this file) is too small.
-
-If you want to run temacs, change SHEAP_ADJUSTMENT in sheap-adjust.h
-to 0 or a +ve number. Generally you should *not* try to run temacs
-with a static heap, you should dump first.\n", size,
-static_heap_base, static_heap_ptr);
+"\nRequested %d bytes, static heap exhausted! base is %p, current ptr\nis %p. You have exhausted the static heap.\n\nIf you are simply trying to compile, remove sheap-adjust.h\nand recompile from the top level. If this doesn't\nwork then STATIC_HEAP_SLOP (defined in this file) is too small.\n\nIf you want to run temacs, change SHEAP_ADJUSTMENT in sheap-adjust.h\nto 0 or a +ve number. Generally you should *not* try to run temacs\nwith a static heap, you should dump first.\n",
+size, static_heap_base, static_heap_ptr);
exit(-1);
return 0;
- 3 participants
- 6 comments
[COMMIT] Abstract font-list/color-list
20 years, 2 months
Ben Wing
Ben Wing
NOTE: This patch has been committed.
NOTE: I don't know if the GTK version of color-list is correct.
Please verify!
lisp/ChangeLog addition:
2005-01-27 Ben Wing <ben(a)xemacs.org>
* font-menu.el:
* font.el:
* font.el (internal-facep):
* font.el (x-font-build-cache):
* font.el (font-lookup-rgb-components):
* frame.el (set-frame-font):
* gtk-font-menu.el (gtk-reset-device-font-menus):
* minibuf.el (read-color-completion-table):
* minibuf.el (x-library-search-path): Removed.
* minibuf.el (x-read-color-completion-table)): Removed.
* msw-faces.el (mswindows-available-font-sizes):
* msw-font-menu.el (mswindows-reset-device-font-menus):
* obsolete.el:
* x-faces.el:
* x-faces.el (x-available-font-sizes):
* x-faces.el (x-library-search-path): New.
* x-faces.el (x-color-list-internal-cache)): New.
* x-faces.el (x-color-list-internal): New.
* x-font-menu.el (x-reset-device-font-menus):
list-fonts->font-list. Create color-list. Abstract out
x/msw-specific versions and obsolete the x/msw-specific Lisp
functions.
src/ChangeLog addition:
2005-01-27 Ben Wing <ben(a)xemacs.org>
* console-impl.h (struct console_methods):
* objects-gtk.c:
* objects-gtk.c (gtk_color_list):
* objects-gtk.c (gtk_font_list):
* objects-gtk.c (console_type_create_objects_gtk):
* objects-gtk.c (__gtk_font_list_internal):
* objects-msw.c:
* objects-msw.c (mswindows_font_list):
* objects-msw.c (mswindows_find_charset_font):
* objects-msw.c (mswindows_color_list):
* objects-msw.c (syms_of_objects_mswindows):
* objects-msw.c (console_type_create_objects_mswindows):
* objects-tty.c (tty_color_list):
* objects-tty.c (tty_font_list):
* objects-tty.c (syms_of_objects_tty):
* objects-tty.c (console_type_create_objects_tty):
* objects-x.c:
* objects-x.c (x_color_list):
* objects-x.c (x_font_list):
* objects-x.c (console_type_create_objects_x):
* objects.c:
* objects.c (Fcolor_list):
* objects.c (Ffont_list):
* objects.c (syms_of_objects):
list-fonts->font-list. Create color-list. Abstract out
x/msw-specific versions and obsolete the x/msw-specific Lisp
functions.
smallfix source patch:
Diff command: bash -ci "cvs-diff --show-c-function -no-changelog "
Files affected: src/objects.c src/objects-x.c src/objects-tty.c src/objects-msw.c src/objects-gtk.c src/console-impl.h lisp/x-font-menu.el lisp/x-faces.el lisp/obsolete.el lisp/msw-font-menu.el lisp/msw-faces.el lisp/minibuf.el lisp/gtk-font-menu.el lisp/frame.el lisp/font.el lisp/font-menu.el
cvs server: Diffing .
cvs server: Diffing dynodump
cvs server: Diffing dynodump/i386
cvs server: Diffing dynodump/ppc
cvs server: Diffing dynodump/sparc
cvs server: Diffing etc
cvs server: Diffing etc/custom
cvs server: Diffing etc/custom/example-themes
cvs server: Diffing etc/eos
cvs server: Diffing etc/idd
cvs server: Diffing etc/photos
cvs server: Diffing etc/sparcworks
cvs server: Diffing etc/tests
cvs server: Diffing etc/tests/external-widget
cvs server: Diffing etc/toolbar
cvs server: Diffing etc/unicode
cvs server: Diffing etc/unicode/ibm
cvs server: Diffing etc/unicode/mule-ucs
cvs server: Diffing etc/unicode/other
cvs server: Diffing etc/unicode/unicode-consortium
cvs server: Diffing info
cvs server: Diffing lib-src
cvs server: Diffing lisp
Index: lisp/font-menu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font-menu.el,v
retrieving revision 1.7
diff -u -p -r1.7 font-menu.el
--- lisp/font-menu.el 2004/09/22 02:05:50 1.7
+++ lisp/font-menu.el 2005/01/28 02:54:15
＠＠ -113,7 +113,7 ＠＠
;;; ==>
;;; "-morisawa-ryumin light kl-light-r-normal--10-100-72-72-m-50-jisx0201.1976-0"
;;;
-;;; (list-fonts "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*")
+;;; (font-list "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*")
;;; ==>
;;; ("-dt-interface user-medium-r-normal-s sans-12-120-72-72-m-70-iso8859-1"
;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0"
Index: lisp/font.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font.el,v
retrieving revision 1.15
diff -u -p -r1.15 font.el
--- lisp/font.el 2003/03/09 02:27:33 1.15
+++ lisp/font.el 2005/01/28 02:54:15
＠＠ -2,7 +2,7 ＠＠
;; Copyright (c) 1995, 1996 by William M. Perry (wmperry(a)cs.indiana.edu)
;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 2002 Ben Wing.
+;; Copyright (C) 2002, 2004 Ben Wing.
;; Author: wmperry
;; Maintainer: XEmacs Development Team
＠＠ -32,8 +32,7 ＠＠
;;; Code:
(globally-declare-fboundp
- '(x-list-fonts
- mswindows-list-fonts ns-list-fonts internal-facep fontsetp get-font-info
+ '(internal-facep fontsetp get-font-info
get-fontset-info mswindows-define-rgb-color cancel-function-timers
mswindows-font-regexp mswindows-canonicalize-font-name
mswindows-parse-font-style mswindows-construct-font-style
＠＠ -60,13 +59,7 ＠＠
(defmacro defcustom (var value doc &rest args)
`(defvar ,var ,value ,doc))))
-(if (not (fboundp 'try-font-name))
- (defun try-font-name (fontname &rest args)
- (case window-system
- ((x pm) (car-safe (x-list-fonts fontname)))
- (mswindows (car-safe (mswindows-list-fonts fontname)))
- (ns (car-safe (ns-list-fonts fontname)))
- (otherwise nil))))
+; delete alternate defn of try-font-name
(if (not (fboundp 'facep))
(defun facep (face)
＠＠ -932,7 +925,7 ＠＠ for use in the 'weight' field of an mswi
(defun x-font-build-cache (&optional device)
(let ((hash-table (make-hash-table :test 'equal :size 15))
(fonts (mapcar 'x-font-create-object
- (x-list-fonts "-*-*-*-*-*-*-*-*-*-*-*-*-*-*")))
+ (font-list "-*-*-*-*-*-*-*-*-*-*-*-*-*-*")))
(plist nil)
(cur nil))
(while fonts
＠＠ -1064,7 +1057,7 ＠＠ for use in the 'weight' field of an mswi
(defun font-lookup-rgb-components (color)
"Lookup COLOR (a color name) in rgb.txt and return a list of RGB values.
The list (R G B) is returned, or an error is signaled if the lookup fails."
- (let ((lib-list (if (boundp 'x-library-search-path)
+ (let ((lib-list (if-boundp 'x-library-search-path
x-library-search-path
;; This default is from XEmacs 19.13 - hope it covers
;; everyone.
Index: lisp/frame.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/frame.el,v
retrieving revision 1.23
diff -u -p -r1.23 frame.el
--- lisp/frame.el 2005/01/26 09:53:32 1.23
+++ lisp/frame.el 2005/01/28 02:54:16
＠＠ -994,7 +994,7 ＠＠ pixels) is kept by adjusting the numbers
(completion-ignore-case t)
(font (completing-read "Font name: "
(mapcar #'list
- (list-fonts "*" frame))
+ (font-list "*" frame))
nil nil nil nil
(face-font-name 'default frame))))
(list font current-prefix-arg)))
Index: lisp/gtk-font-menu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/gtk-font-menu.el,v
retrieving revision 1.5
diff -u -p -r1.5 gtk-font-menu.el
--- lisp/gtk-font-menu.el 2004/09/22 02:05:50 1.5
+++ lisp/gtk-font-menu.el 2005/01/28 02:54:16
＠＠ -90,7 +90,7 ＠＠ when they are selected for the first tim
or if you change your font path, you can call this to re-initialize the menus."
;; by Stig(a)hackvan.com
;; #### - this should implement a `menus-only' option, which would
- ;; recalculate the menus from the cache w/o having to do list-fonts again.
+ ;; recalculate the menus from the cache w/o having to do font-list again.
(unless gtk-font-regexp-ascii
(setq gtk-font-regexp-ascii (if (featurep 'mule)
(declare-fboundp
＠＠ -102,7 +102,7 ＠＠ or if you change your font path, you can
family size weight entry monospaced-p
dev-cache cache families sizes weights)
(dolist (name (cond ((null debug) ; debugging kludge
- (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device))
+ (font-list "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device))
((stringp debug) (split-string debug "\n"))
(t debug)))
(when (and (string-match gtk-font-regexp-ascii name)
Index: lisp/minibuf.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/minibuf.el,v
retrieving revision 1.26
diff -u -p -r1.26 minibuf.el
--- lisp/minibuf.el 2004/04/17 09:59:24 1.26
+++ lisp/minibuf.el 2005/01/28 02:54:17
＠＠ -2181,75 +2181,8 ＠＠ whether it is a file(/result) or a direc
"Read the name of a face from the minibuffer and return it as a symbol."
(intern (completing-read prompt obarray 'find-face must-match)))
-;; #### - wrong place for this variable? Exactly. We probably want
-;; `color-list' to be a console method, so `tty-color-list' becomes
-;; obsolete, and `read-color-completion-table' conses (mapcar #'list
-;; (color-list)), optionally caching the results.
-
-;; Ben wanted all of the possibilities from the `configure' script used
-;; here, but I think this is way too many. I already trimmed the R4 variants
-;; and a few obvious losers from the list. --Stig
-(defvar x-library-search-path '("/usr/X11R6/lib/X11/"
- "/usr/X11R5/lib/X11/"
- "/usr/lib/X11R6/X11/"
- "/usr/lib/X11R5/X11/"
- "/usr/local/X11R6/lib/X11/"
- "/usr/local/X11R5/lib/X11/"
- "/usr/local/lib/X11R6/X11/"
- "/usr/local/lib/X11R5/X11/"
- "/usr/X11/lib/X11/"
- "/usr/lib/X11/"
- "/usr/local/lib/X11/"
- "/usr/X386/lib/X11/"
- "/usr/x386/lib/X11/"
- "/usr/XFree86/lib/X11/"
- "/usr/unsupported/lib/X11/"
- "/usr/athena/lib/X11/"
- "/usr/local/x11r5/lib/X11/"
- "/usr/lpp/Xamples/lib/X11/"
- "/usr/openwin/lib/X11/"
- "/usr/openwin/share/lib/X11/")
- "Search path used by `read-color' to find rgb.txt.")
-
-(defvar x-read-color-completion-table)
-
(defun read-color-completion-table ()
- (case (device-type)
- ;; #### Evil device-type dependency
- ((x gtk)
- (if (boundp 'x-read-color-completion-table)
- x-read-color-completion-table
- (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
- clist color p)
- (if (not rgb-file)
- ;; prevents multiple searches for rgb.txt if we can't find it
- (setq x-read-color-completion-table nil)
- (with-current-buffer (get-buffer-create " *colors*")
- (reset-buffer (current-buffer))
- (insert-file-contents rgb-file)
- (while (not (eobp))
- ;; skip over comments
- (while (looking-at "^!")
- (end-of-line)
- (forward-char 1))
- (skip-chars-forward "0-9 \t")
- (setq p (point))
- (end-of-line)
- (setq color (buffer-substring p (point))
- clist (cons (list color) clist))
- ;; Ugh. If we want to be able to complete the lowercase form
- ;; of the color name, we need to add it twice! Yuck.
- (let ((dcase (downcase color)))
- (or (string= dcase color)
- (push (list dcase) clist)))
- (forward-char 1))
- (kill-buffer (current-buffer))))
- (setq x-read-color-completion-table clist)
- x-read-color-completion-table)))
- (mswindows
- (mapcar #'list (declare-fboundp (mswindows-color-list))))
- (tty
- (mapcar #'list (declare-fboundp (tty-color-list))))))
+ (mapcar #'list (color-list)))
(defun read-color (prompt &optional must-match initial-contents)
"Read the name of a color from the minibuffer.
Index: lisp/msw-faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/msw-faces.el,v
retrieving revision 1.17
diff -u -p -r1.17 msw-faces.el
--- lisp/msw-faces.el 2003/03/09 02:27:33 1.17
+++ lisp/msw-faces.el 2005/01/28 02:54:17
＠＠ -271,7 +271,7 ＠＠ font. If it fails, it returns nil."
(and (string-match mswindows-font-regexp name)
(string-to-int (substring name (match-beginning 3)
(match-end 3)))))
- (list-fonts font device)))
+ (font-list font device)))
#'<))
(defun mswindows-frob-font-size (font up-p device)
Index: lisp/msw-font-menu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/msw-font-menu.el,v
retrieving revision 1.7
diff -u -p -r1.7 msw-font-menu.el
--- lisp/msw-font-menu.el 2002/06/20 21:18:04 1.7
+++ lisp/msw-font-menu.el 2005/01/28 02:54:17
＠＠ -74,7 +74,7 ＠＠ or if you change your font path, you can
family size weight entry
dev-cache cache families sizes weights)
(dolist (name (cond ((null debug) ; debugging kludge
- (list-fonts "::::" device))
+ (font-list "::::" device))
((stringp debug) (split-string debug "\n"))
(t debug)))
(when (and (string-match mswindows-font-regexp-ascii name)
Index: lisp/obsolete.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/obsolete.el,v
retrieving revision 1.17
diff -u -p -r1.17 obsolete.el
--- lisp/obsolete.el 2003/03/20 13:19:59 1.17
+++ lisp/obsolete.el 2005/01/28 02:54:17
＠＠ -3,7 +3,7 ＠＠
;; Copyright (C) 1985-1994, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995 Amdahl Corporation.
;; Copyright (C) 1995 Sun Microsystems.
-;; Copyright (C) 2002 Ben Wing.
+;; Copyright (C) 2002, 2004 Ben Wing.
;; Maintainer: XEmacs Development Team
;; Keywords: internal, dumped
＠＠ -371,6 +371,10 ＠＠ on the system; white is (65280 65280 652
If FRAME is omitted or nil, use the selected frame."
(color-instance-rgb-components (make-color-instance color)))
(make-compatible 'x-color-values 'color-instance-rgb-components)
+
+(make-obsolete 'mswindows-color-list 'color-list)
+(make-obsolete 'tty-color-list 'color-list)
+(make-compatible 'list-fonts 'font-list)
;; Two loser functions which shouldn't be used.
(make-obsolete 'following-char 'char-after)
Index: lisp/x-faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v
retrieving revision 1.19
diff -u -p -r1.19 x-faces.el
--- lisp/x-faces.el 2002/06/20 21:18:04 1.19
+++ lisp/x-faces.el 2005/01/28 02:54:18
＠＠ -1,7 +1,7 ＠＠
;;; x-faces.el --- X-specific face frobnication, aka black magic.
;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995, 1996, 2002 Ben Wing.
+;; Copyright (C) 1995, 1996, 2002, 2004 Ben Wing.
;; Author: Jamie Zawinski <jwz(a)jwz.org>
;; Maintainer: XEmacs Development Team
＠＠ -284,7 +284,7 ＠＠ X fonts can be specified (by the user) i
(string-to-int (substring name (match-beginning 6)
(match-end 6)))
name))))
- (list-fonts font device)))
+ (font-list font device)))
(function (lambda (x y) (if (= (nth 1 x) (nth 1 y))
(< (nth 0 x) (nth 0 y))
(< (nth 1 x) (nth 1 y)))))))
＠＠ -374,6 +374,71 ＠＠ Otherwise, it returns the next larger ve
(make-obsolete 'x-make-face-bold-italic 'make-face-bold-italic)
(make-obsolete 'x-make-face-unbold 'make-face-unbold)
(make-obsolete 'x-make-face-unitalic 'make-face-unitalic)
+
+
+
+;; #### - wrong place for this variable? Exactly. We probably want
+;; `color-list' to be a console method, so `tty-color-list' becomes
+;; obsolete, and `read-color-completion-table' conses (mapcar #'list
+;; (color-list)), optionally caching the results.
+
+;; Ben wanted all of the possibilities from the `configure' script used
+;; here, but I think this is way too many. I already trimmed the R4 variants
+;; and a few obvious losers from the list. --Stig
+(defvar x-library-search-path '("/usr/X11R6/lib/X11/"
+ "/usr/X11R5/lib/X11/"
+ "/usr/lib/X11R6/X11/"
+ "/usr/lib/X11R5/X11/"
+ "/usr/local/X11R6/lib/X11/"
+ "/usr/local/X11R5/lib/X11/"
+ "/usr/local/lib/X11R6/X11/"
+ "/usr/local/lib/X11R5/X11/"
+ "/usr/X11/lib/X11/"
+ "/usr/lib/X11/"
+ "/usr/local/lib/X11/"
+ "/usr/X386/lib/X11/"
+ "/usr/x386/lib/X11/"
+ "/usr/XFree86/lib/X11/"
+ "/usr/unsupported/lib/X11/"
+ "/usr/athena/lib/X11/"
+ "/usr/local/x11r5/lib/X11/"
+ "/usr/lpp/Xamples/lib/X11/"
+ "/usr/openwin/lib/X11/"
+ "/usr/openwin/share/lib/X11/")
+ "Search path used by `x-color-list-internal' to find rgb.txt.")
+
+(defvar x-color-list-internal-cache)
+
+(defun x-color-list-internal ()
+ (if (boundp 'x-color-list-internal-cache)
+ x-color-list-internal-cache
+ (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
+ clist color p)
+ (if (not rgb-file)
+ ;; prevents multiple searches for rgb.txt if we can't find it
+ (setq x-color-list-internal-cache nil)
+ (with-current-buffer (get-buffer-create " *colors*")
+ (reset-buffer (current-buffer))
+ (insert-file-contents rgb-file)
+ (while (not (eobp))
+ ;; skip over comments
+ (while (looking-at "^!")
+ (end-of-line)
+ (forward-char 1))
+ (skip-chars-forward "0-9 \t")
+ (setq p (point))
+ (end-of-line)
+ (setq color (buffer-substring p (point))
+ clist (cons (list color) clist))
+ ;; Ugh. If we want to be able to complete the lowercase form
+ ;; of the color name, we need to add it twice! Yuck.
+ (let ((dcase (downcase color)))
+ (or (string= dcase color)
+ (push (list dcase) clist)))
+ (forward-char 1))
+ (kill-buffer (current-buffer))))
+ (setq x-color-list-internal-cache clist)
+ x-color-list-internal-cache)))
;;; internal routines
Index: lisp/x-font-menu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v
retrieving revision 1.12
diff -u -p -r1.12 x-font-menu.el
--- lisp/x-font-menu.el 2004/09/22 02:05:51 1.12
+++ lisp/x-font-menu.el 2005/01/28 02:54:18
＠＠ -90,7 +90,7 ＠＠ when they are selected for the first tim
or if you change your font path, you can call this to re-initialize the menus."
;; by Stig(a)hackvan.com
;; #### - this should implement a `menus-only' option, which would
- ;; recalculate the menus from the cache w/o having to do list-fonts again.
+ ;; recalculate the menus from the cache w/o having to do font-list again.
(unless x-font-regexp-ascii
(setq x-font-regexp-ascii (if (featurep 'mule)
(charset-registry 'ascii)
＠＠ -101,7 +101,7 ＠＠ or if you change your font path, you can
family size weight entry monospaced-p
dev-cache cache families sizes weights)
(dolist (name (cond ((null debug) ; debugging kludge
- (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device
+ (font-list "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device
font-menu-max-number))
((stringp debug) (split-string debug "\n"))
(t debug)))
cvs server: Diffing lisp/mule
cvs server: Diffing lisp/term
cvs server: Diffing lock
cvs server: Diffing lwlib
cvs server: Diffing man
cvs server: Diffing man/internals
cvs server: Diffing man/lispref
cvs server: Diffing man/new-users-guide
cvs server: Diffing man/xemacs
cvs server: Diffing modules
cvs server: Diffing modules/base64
cvs server: Diffing modules/common
cvs server: Diffing modules/ldap
cvs server: Diffing modules/postgresql
cvs server: Diffing modules/sample
cvs server: Diffing modules/sample/external
cvs server: Diffing modules/sample/internal
cvs server: Diffing modules/zlib
cvs server: Diffing netinstall
cvs server: Diffing nt
cvs server: Diffing nt/installer
cvs server: Diffing nt/installer/Wise
cvs server: Diffing src
Index: src/console-impl.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-impl.h,v
retrieving revision 1.7
diff -u -p -r1.7 console-impl.h
--- src/console-impl.h 2004/11/04 23:06:18 1.7
+++ src/console-impl.h 2005/01/28 02:54:18
＠＠ -192,6 +192,7 ＠＠ struct console_methods
int depth);
Lisp_Object (*color_instance_rgb_components_method) (Lisp_Color_Instance *);
int (*valid_color_name_p_method) (struct device *, Lisp_Object color);
+ Lisp_Object (*color_list_method) (void);
/* font methods */
int (*initialize_font_instance_method) (Lisp_Font_Instance *,
＠＠ -206,7 +207,7 ＠＠ struct console_methods
Lisp_Object (*font_instance_truename_method) (Lisp_Font_Instance *,
Error_Behavior errb);
Lisp_Object (*font_instance_properties_method) (Lisp_Font_Instance *);
- Lisp_Object (*list_fonts_method) (Lisp_Object pattern,
+ Lisp_Object (*font_list_method) (Lisp_Object pattern,
Lisp_Object device,
Lisp_Object maxnumber);
Lisp_Object (*find_charset_font_method) (Lisp_Object device,
Index: src/objects-gtk.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-gtk.c,v
retrieving revision 1.15
diff -u -p -r1.15 objects-gtk.c
--- src/objects-gtk.c 2005/01/26 10:22:27 1.15
+++ src/objects-gtk.c 2005/01/28 02:54:19
＠＠ -206,6 +206,14 ＠＠ gtk_valid_color_name_p (struct device *U
return (1);
}
+static Lisp_Object
+gtk_color_list (void)
+{
+ /* #### BILL!!!
+ Is this correct? */
+ return call0 (intern ("x-color-list-internal"));
+}
+
/************************************************************************/
/* font instances */
＠＠ -330,7 +338,7 ＠＠ gtk_finalize_font_instance (struct Lisp_
/* Forward declarations for X specific functions at the end of the file */
Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp);
-static Lisp_Object __gtk_list_fonts_internal (const char *pattern);
+static Lisp_Object __gtk_font_list_internal (const char *pattern);
static Lisp_Object
gtk_font_instance_truename (struct Lisp_Font_Instance *f,
＠＠ -361,14 +369,14 ＠＠ gtk_font_instance_properties (struct Lis
}
static Lisp_Object
-gtk_list_fonts (Lisp_Object pattern, Lisp_Object UNUSED (device),
+gtk_font_list (Lisp_Object pattern, Lisp_Object UNUSED (device),
Lisp_Object UNUSED (maxnumber))
{
const char *patternext;
TO_EXTERNAL_FORMAT (LISP_STRING, pattern, C_STRING_ALLOCA, patternext, Qbinary);
- return (__gtk_list_fonts_internal (patternext));
+ return (__gtk_font_list_internal (patternext));
}
#ifdef MULE
＠＠ -454,13 +462,14 ＠＠ console_type_create_objects_gtk (void)
CONSOLE_HAS_METHOD (gtk, color_instance_hash);
CONSOLE_HAS_METHOD (gtk, color_instance_rgb_components);
CONSOLE_HAS_METHOD (gtk, valid_color_name_p);
+ CONSOLE_HAS_METHOD (gtk, color_list);
CONSOLE_HAS_METHOD (gtk, initialize_font_instance);
CONSOLE_HAS_METHOD (gtk, print_font_instance);
CONSOLE_HAS_METHOD (gtk, finalize_font_instance);
CONSOLE_HAS_METHOD (gtk, font_instance_truename);
CONSOLE_HAS_METHOD (gtk, font_instance_properties);
- CONSOLE_HAS_METHOD (gtk, list_fonts);
+ CONSOLE_HAS_METHOD (gtk, font_list);
#ifdef MULE
CONSOLE_HAS_METHOD (gtk, find_charset_font);
CONSOLE_HAS_METHOD (gtk, font_spec_matches_charset);
＠＠ -587,7 +596,7 ＠＠ __get_gtk_font_truename (GdkFont *gdk_fo
return (font_name);
}
-static Lisp_Object __gtk_list_fonts_internal (const char *pattern)
+static Lisp_Object __gtk_font_list_internal (const char *pattern)
{
char **names;
int count = 0;
Index: src/objects-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-msw.c,v
retrieving revision 1.46
diff -u -p -r1.46 objects-msw.c
--- src/objects-msw.c 2005/01/26 10:22:27 1.46
+++ src/objects-msw.c 2005/01/28 02:54:19
＠＠ -2,7 +2,7 ＠＠
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, 2000, 2001, 2002 Ben Wing.
+ Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing.
Copyright (C) 1995 Sun Microsystems, Inc.
Copyright (C) 1997 Jonathan Harris.
＠＠ -1926,7 +1926,7 ＠＠ mswindows_print_font_instance (Lisp_Font
}
static Lisp_Object
-mswindows_list_fonts (Lisp_Object pattern, Lisp_Object device,
+mswindows_font_list (Lisp_Object pattern, Lisp_Object device,
Lisp_Object UNUSED (maxnumber))
{
struct device *d = XDEVICE (device);
＠＠ -2188,7 +2188,7 ＠＠ mswindows_find_charset_font (Lisp_Object
/* If FONT specifies a particular charset, this will only list fonts with
that charset; otherwise, it will list fonts with all charsets. */
- fontlist = mswindows_list_fonts (font, device, Qnil);
+ fontlist = mswindows_font_list (font, device, Qnil);
if (!stage)
{
＠＠ -2219,10 +2219,8 ＠＠ mswindows_find_charset_font (Lisp_Object
/* non-methods */
/************************************************************************/
-DEFUN ("mswindows-color-list", Fmswindows_color_list, 0, 0, 0, /*
-Return a list of the colors available on mswindows devices.
-*/
- ())
+static Lisp_Object
+mswindows_color_list (void)
{
Lisp_Object result = Qnil;
int i;
＠＠ -2233,7 +2231,6 ＠＠ Return a list of the colors available on
return Fnreverse (result);
}
-
/************************************************************************/
/* initialization */
＠＠ -2242,7 +2239,6 ＠＠ Return a list of the colors available on
void
syms_of_objects_mswindows (void)
{
- DEFSUBR (Fmswindows_color_list);
}
void
＠＠ -2257,13 +2253,14 ＠＠ console_type_create_objects_mswindows (v
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, color_list);
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);
+ CONSOLE_HAS_METHOD (mswindows, font_list);
#ifdef MULE
CONSOLE_HAS_METHOD (mswindows, font_spec_matches_charset);
CONSOLE_HAS_METHOD (mswindows, find_charset_font);
＠＠ -2280,13 +2277,14 ＠＠ console_type_create_objects_mswindows (v
CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_hash);
CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_rgb_components);
CONSOLE_INHERITS_METHOD (msprinter, mswindows, valid_color_name_p);
+ CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_list);
CONSOLE_HAS_METHOD (msprinter, initialize_font_instance);
/* CONSOLE_INHERITS_METHOD (msprinter, mswindows, mark_font_instance); */
CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_font_instance);
CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_font_instance);
CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_instance_truename);
- CONSOLE_INHERITS_METHOD (msprinter, mswindows, list_fonts);
+ CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_list);
#ifdef MULE
CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_spec_matches_charset);
CONSOLE_INHERITS_METHOD (msprinter, mswindows, find_charset_font);
Index: src/objects-tty.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-tty.c,v
retrieving revision 1.15
diff -u -p -r1.15 objects-tty.c
--- src/objects-tty.c 2005/01/26 10:22:27 1.15
+++ src/objects-tty.c 2005/01/28 02:54:19
＠＠ -106,10 +106,8 ＠＠ If it is not found, return nil.
return Qnil;
}
-DEFUN ("tty-color-list", Ftty_color_list, 0, 0, 0, /*
-Return a list of the registered TTY colors.
-*/
- ())
+static Lisp_Object
+tty_color_list (void)
{
Lisp_Object result = Qnil;
Lisp_Object rest;
＠＠ -293,7 +291,7 ＠＠ tty_finalize_font_instance (Lisp_Font_In
}
static Lisp_Object
-tty_list_fonts (Lisp_Object UNUSED (pattern), Lisp_Object UNUSED (device),
+tty_font_list (Lisp_Object UNUSED (pattern), Lisp_Object UNUSED (device),
Lisp_Object UNUSED (maxnumber))
{
return list1 (build_string ("normal"));
＠＠ -368,7 +366,6 ＠＠ syms_of_objects_tty (void)
DEFSUBR (Fregister_tty_color);
DEFSUBR (Funregister_tty_color);
DEFSUBR (Ffind_tty_color);
- DEFSUBR (Ftty_color_list);
#if 0
DEFSUBR (Fset_tty_dynamic_color_specs);
DEFSUBR (Ftty_dynamic_color_specs);
＠＠ -386,12 +383,13 ＠＠ console_type_create_objects_tty (void)
CONSOLE_HAS_METHOD (tty, color_instance_equal);
CONSOLE_HAS_METHOD (tty, color_instance_hash);
CONSOLE_HAS_METHOD (tty, valid_color_name_p);
+ CONSOLE_HAS_METHOD (tty, color_list);
CONSOLE_HAS_METHOD (tty, initialize_font_instance);
CONSOLE_HAS_METHOD (tty, mark_font_instance);
CONSOLE_HAS_METHOD (tty, print_font_instance);
CONSOLE_HAS_METHOD (tty, finalize_font_instance);
- CONSOLE_HAS_METHOD (tty, list_fonts);
+ CONSOLE_HAS_METHOD (tty, font_list);
#ifdef MULE
CONSOLE_HAS_METHOD (tty, font_spec_matches_charset);
CONSOLE_HAS_METHOD (tty, find_charset_font);
Index: src/objects-x.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v
retrieving revision 1.27
diff -u -p -r1.27 objects-x.c
--- src/objects-x.c 2005/01/26 10:22:27 1.27
+++ src/objects-x.c 2005/01/28 02:54:20
＠＠ -355,6 +355,12 ＠＠ x_valid_color_name_p (struct device *d,
return XParseColor (dpy, cmap, extname, &c);
}
+static Lisp_Object
+x_color_list (void)
+{
+ return call0 (intern ("x-color-list-internal"));
+}
+
/************************************************************************/
/* font instances */
＠＠ -853,7 +859,7 ＠＠ x_font_instance_properties (Lisp_Font_In
}
static Lisp_Object
-x_list_fonts (Lisp_Object pattern, Lisp_Object device, Lisp_Object maxnumber)
+x_font_list (Lisp_Object pattern, Lisp_Object device, Lisp_Object maxnumber)
{
Extbyte **names;
int count = 0;
＠＠ -1005,13 +1011,14 ＠＠ console_type_create_objects_x (void)
CONSOLE_HAS_METHOD (x, color_instance_hash);
CONSOLE_HAS_METHOD (x, color_instance_rgb_components);
CONSOLE_HAS_METHOD (x, valid_color_name_p);
+ CONSOLE_HAS_METHOD (x, color_list);
CONSOLE_HAS_METHOD (x, initialize_font_instance);
CONSOLE_HAS_METHOD (x, print_font_instance);
CONSOLE_HAS_METHOD (x, finalize_font_instance);
CONSOLE_HAS_METHOD (x, font_instance_truename);
CONSOLE_HAS_METHOD (x, font_instance_properties);
- CONSOLE_HAS_METHOD (x, list_fonts);
+ CONSOLE_HAS_METHOD (x, font_list);
#ifdef MULE
CONSOLE_HAS_METHOD (x, find_charset_font);
CONSOLE_HAS_METHOD (x, font_spec_matches_charset);
Index: src/objects.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v
retrieving revision 1.25
diff -u -p -r1.25 objects.c
--- src/objects.c 2005/01/26 10:22:27 1.25
+++ src/objects.c 2005/01/28 02:54:20
＠＠ -1,7 +1,7 ＠＠
/* Generic Objects and Functions.
Copyright (C) 1995 Free Software Foundation, Inc.
Copyright (C) 1995 Board of Trustees, University of Illinois.
- Copyright (C) 1995, 1996, 2002 Ben Wing.
+ Copyright (C) 1995, 1996, 2002, 2004 Ben Wing.
This file is part of XEmacs.
＠＠ -248,6 +248,18 ＠＠ such as `blink'.
return MAYBE_INT_DEVMETH (d, valid_color_name_p, (d, color)) ? Qt : Qnil;
}
+DEFUN ("color-list", Fcolor_list, 0, 1, 0, /*
+Return a list of color names.
+DEVICE specifies which device to return names for, and defaults to the
+currently selected device.
+*/
+ (device))
+{
+ device = wrap_device (decode_device (device));
+
+ return MAYBE_LISP_DEVMETH (XDEVICE (device), color_list, ());
+}
+
/***************************************************************************
* Font-Instance Object *
＠＠ -506,7 +518,7 ＠＠ Return the properties (an alist or nil)
font_instance_properties, (f));
}
-DEFUN ("list-fonts", Flist_fonts, 1, 3, 0, /*
+DEFUN ("font-list", Ffont_list, 1, 3, 0, /*
Return a list of font names matching the given pattern.
DEVICE specifies which device to search for names, and defaults to the
currently selected device.
＠＠ -516,7 +528,7 ＠＠ currently selected device.
CHECK_STRING (pattern);
device = wrap_device (decode_device (device));
- return MAYBE_LISP_DEVMETH (XDEVICE (device), list_fonts, (pattern, device,
+ return MAYBE_LISP_DEVMETH (XDEVICE (device), font_list, (pattern, device,
maxnumber));
}
＠＠ -1121,6 +1133,7 ＠＠ syms_of_objects (void)
DEFSUBR (Fcolor_instance_name);
DEFSUBR (Fcolor_instance_rgb_components);
DEFSUBR (Fvalid_color_name_p);
+ DEFSUBR (Fcolor_list);
DEFSYMBOL_MULTIWORD_PREDICATE (Qfont_instancep);
DEFSUBR (Fmake_font_instance);
＠＠ -1132,7 +1145,7 ＠＠ syms_of_objects (void)
DEFSUBR (Ffont_instance_proportional_p);
DEFSUBR (Ffont_instance_truename);
DEFSUBR (Ffont_instance_properties);
- DEFSUBR (Flist_fonts);
+ DEFSUBR (Ffont_list);
/* Qcolor, Qfont defined in general.c */
DEFSYMBOL (Qface_boolean);
cvs server: Diffing src/m
cvs server: Diffing src/s
cvs server: Diffing tests
cvs server: Diffing tests/DLL
cvs server: Diffing tests/Dnd
cvs server: Diffing tests/automated
cvs server: Diffing tests/gtk
cvs server: Diffing tests/mule
cvs server: Diffing tests/tooltalk
- 1 participants
- 0 comments
[COMMIT] Support symlinks under Windows
20 years, 2 months
Ben Wing
Ben Wing
NOTE: This patch has been committed.
src/ChangeLog addition:
2005-01-27 Ben Wing <ben(a)xemacs.org>
* nt.c:
* fileio.c:
Fix sync comments.
* config.h.in:
* dired-msw.c (mswindows_get_files):
* emacs.c (main_1):
* event-msw.c (mswindows_wnd_proc):
* fileio.c:
* fileio.c (find_end_of_directory_component):
* fileio.c (Ffile_name_directory):
* fileio.c (Ffile_name_as_directory):
* fileio.c (if):
* fileio.c (Ffile_truename):
* fileio.c (Ffile_readable_p):
* fileio.c (Ffile_symlink_p):
* fileio.c (Ffile_accessible_directory_p):
* fileio.c (vars_of_fileio):
* glyphs.c:
* glyphs.c (pixmap_to_lisp_data):
* lisp.h:
* nt.c:
* nt.c (get_long_basename):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_readdir):
* nt.c (open_unc_volume):
* nt.c (mswindows_access):
* nt.c (mswindows_link):
* nt.c (mswindows_rename):
* nt.c (mswindows_unlink):
* nt.c (mswindows_stat):
* nt.c (mswindows_utime):
* nt.c (open_input_file):
* nt.c (open_output_file):
* nt.c (Fmswindows_short_file_name):
* nt.c (init_nt):
* process-nt.c (nt_create_process):
* realpath.c:
* realpath.c (readlink_or_correct_case):
* realpath.c (qxe_realpath):
* sound.c (Fplay_sound_file):
* symsinit.h:
* sysdep.c:
* sysdep.c (qxe_lstat):
* sysdep.c (qxe_stat):
* sysfile.h:
* syswindows.h:
* syswindows.h (LOCAL_FILE_FORMAT_TO_TSTR):
* syswindows.h (LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR):
* win32.c:
* win32.c (Fmswindows_shell_execute):
* win32.c (struct read_link_hash):
* win32.c (mswindows_read_link_1):
* win32.c (mswindows_read_link):
* win32.c (vars_of_win32):
* win32.c (init_win32):
Add support for treating shortcuts under Windows as symbolic links.
Enabled with mswindows-shortcuts-are-links (t by default). Rewrite
lots of places to use PATHNAME_CONVERT_OUT, which is moved to
sysfile.h. Add PATHNAME_RESOLVE_LINKS, which only does things
under Windows.
Add profiling section for expand_file_name calls.
* nt.c (mswindows_rename):
* nt.c (mswindows_unlink):
* sysdep.c (sys_subshell):
Unicode-ize.
* realpath.c (readlink_or_correct_case):
Renamed from readlink_and_correct_case. Fix some problems with
Windows implementation due to incorrect understanding of workings
of the function.
* sound.c (Fplay_sound_file):
* ntplay.c (nt_play_sound_file):
* sound.c:
* sound.h:
Rename play_sound_file to nt_play_sound_file and pass
internally-formatted data to it to avoid converting out and back
again.
* text.h:
is_c -> is_ascii.
symlink source patch:
Diff command: bash -ci "cvs-diff --show-c-function -no-changelog "
Files affected: src/win32.c src/text.h src/syswindows.h src/sysfile.h src/sysdep.c src/symsinit.h src/sound.h src/sound.c src/realpath.c src/process-nt.c src/ntplay.c src/nt.c src/lisp.h src/glyphs.c src/fileio.c src/event-msw.c src/emacs.c src/dired-msw.c
cvs server: Diffing .
Index: src/dired-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/dired-msw.c,v
retrieving revision 1.18
diff -u -p -r1.18 dired-msw.c
--- src/dired-msw.c 2004/12/06 03:52:03 1.18
+++ src/dired-msw.c 2005/01/28 02:31:48
＠＠ -192,7 +192,7 ＠＠ mswindows_get_files (Lisp_Object dirfile
int findex;
DECLARE_EISTRING (win32pattern);
HANDLE fh;
- int errm;
+ int errm;
while (1)
{
＠＠ -206,8 +206,13 ＠＠ mswindows_get_files (Lisp_Object dirfile
/* Now *bufp is the compiled form of PATTERN; don't call anything
which might compile a new regexp until we're done with the loop! */
+ {
+ Ibyte *dir2;
+ LISP_PATHNAME_RESOLVE_LINKS (dirfile, dir2);
+ eicpy_rawz (win32pattern, dir2);
+ }
+
/* for Win32, we need to insure that the pathname ends with "\*". */
- eicpy_lstr (win32pattern, dirfile);
if (!nowild)
{
Charcount len = eicharlen (win32pattern) - 1;
Index: src/emacs.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/emacs.c,v
retrieving revision 1.152
diff -u -p -r1.152 emacs.c
--- src/emacs.c 2005/01/26 10:27:57 1.152
+++ src/emacs.c 2005/01/28 02:31:49
＠＠ -2085,6 +2085,7 ＠＠ main_1 (int argc, Wexttext **argv, Wextt
#if defined (HAVE_MMAP) && defined (REL_ALLOC) && !defined (DOUG_LEA_MALLOC)
vars_of_ralloc ();
#endif /* HAVE_MMAP && REL_ALLOC */
+ vars_of_realpath ();
vars_of_redisplay ();
vars_of_regex ();
#ifdef HAVE_SCROLLBARS
Index: src/event-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-msw.c,v
retrieving revision 1.102
diff -u -p -r1.102 event-msw.c
--- src/event-msw.c 2005/01/24 23:33:52 1.102
+++ src/event-msw.c 2005/01/28 02:31:51
＠＠ -3712,6 +3712,7 ＠＠ mswindows_wnd_proc (HWND hwnd, UINT mess
Extbyte *fname_ext;
Bytecount fnamelen;
Charcount len = qxeDragQueryFile ((HDROP) wParam, i, NULL, 0);
+ int freeme = 0;
/* The URLs that we make here aren't correct according to section
* 3.10 of rfc1738 because they're missing the //<host>/ part and
* because they may contain reserved characters. But that's OK -
＠＠ -3723,156 +3724,20 ＠＠ mswindows_wnd_proc (HWND hwnd, UINT mess
ALLOCA, (fname, fnamelen),
Qmswindows_tstr);
+
/* May be a shell link aka "shortcut" - replace fname if so */
-#if !defined (NO_CYGWIN_COM_SUPPORT)
if (!qxestrcasecmp_ascii (fname + fnamelen - 4, ".LNK"))
{
- /* ####
-
- Note the following in the docs:
-
- Note: The IShellLink interface has an ANSI version
- (IShellLinkA) and a Unicode version (IShellLinkW). The
- version that will be used depends on whether you compile
- for ANSI or Unicode. However, Microsoft® Windows 95 and
- Microsoft® Windows 98 only support IShellLinkA.
-
- We haven't yet implemented COM support in the
- Unicode-splitting library. I don't quite understand how
- COM works yet, but it looks like what's happening is
- that the ShellLink class implements both the IShellLinkA
- and IShellLinkW interfaces. To make this work at
- run-time, we have to do something like this:
-
- -- define a new interface qxeIShellLink that uses
- Extbyte * instead of LPSTR or LPWSTR. (not totally
- necessary since Extbyte * == LPSTR).
-
- -- define a new class qxeShellLink that implements
- qxeIShellLink. the methods on this class need to create
- a shadow ShellLink object to do all the real work, and
- call the corresponding function from either the
- IShellLinkA or IShellLinkW interfaces on this object,
- depending on whether XEUNICODE_P is defined.
-
- -- with appropriate preprocessor magic, of course, we
- could make things appear transparent; but we've decided
- not to do preprocessor magic for the moment.
- */
-
- /* #### Not Unicode-split for the moment; we have to do it
- ourselves. */
- if (XEUNICODE_P)
- {
- IShellLinkW *psl;
-
- if (CoCreateInstance (
- XECOMID (CLSID_ShellLink),
- NULL,
- CLSCTX_INPROC_SERVER,
- XECOMID (IID_IShellLinkW),
- &VOIDP_CAST (psl)) == S_OK)
- {
- IPersistFile *ppf;
-
- if (XECOMCALL2 (psl, QueryInterface,
- XECOMID (IID_IPersistFile),
- &VOIDP_CAST (ppf)) == S_OK)
- {
- Extbyte *fname_unicode;
- WIN32_FIND_DATAW wfd;
- LPWSTR resolved =
- alloca_array (WCHAR, PATH_MAX_EXTERNAL + 1);
-
- TO_EXTERNAL_FORMAT (DATA, (fname, fnamelen),
- C_STRING_ALLOCA,
- fname_unicode,
- Qmswindows_unicode);
-
- if (XECOMCALL2 (ppf, Load,
- (LPWSTR) fname_unicode,
- STGM_READ) == S_OK &&
- /* #### YUCK! Docs read
-
- cchMaxPath
-
- Maximum number of bytes to copy to the buffer pointed to by the
- pszFile parameter.
-
- But "cch" means "count of characters", not bytes. I'll assume the doc
- writers messed up and the programmer was correct. Also, this approach
- is safe even if it's actually the other way around. */
-#if defined (CYGWIN_HEADERS) && W32API_INSTALLED_VER < W32API_VER(2,2)
- /* Another Cygwin prototype error,
- fixed in v2.2 of w32api */
- XECOMCALL4 (psl, GetPath, (LPSTR) resolved,
- PATH_MAX_EXTERNAL, &wfd, 0)
-#else
- XECOMCALL4 (psl, GetPath, resolved,
- PATH_MAX_EXTERNAL, &wfd, 0)
-#endif
- == S_OK)
- TO_INTERNAL_FORMAT (C_STRING, resolved,
- ALLOCA, (fname, fnamelen),
- Qmswindows_tstr);
-
- XECOMCALL0 (ppf, Release);
- }
-
- XECOMCALL0 (psl, Release);
- }
- }
- else
- {
- IShellLinkA *psl;
-
- if (CoCreateInstance (
- XECOMID (CLSID_ShellLink),
- NULL,
- CLSCTX_INPROC_SERVER,
- XECOMID (IID_IShellLinkA),
- &VOIDP_CAST (psl)) == S_OK)
- {
- IPersistFile *ppf;
-
- if (XECOMCALL2 (psl, QueryInterface,
- XECOMID (IID_IPersistFile),
- &VOIDP_CAST (ppf)) == S_OK)
- {
- Extbyte *fname_unicode;
- WIN32_FIND_DATAA wfd;
- LPSTR resolved =
- alloca_array (CHAR, PATH_MAX_EXTERNAL + 1);
-
- /* Always Unicode. Not obvious from the
- IPersistFile documentation, but look under
- "Shell Link" for example code. */
- TO_EXTERNAL_FORMAT (DATA, (fname, fnamelen),
- C_STRING_ALLOCA,
- fname_unicode,
- Qmswindows_unicode);
-
- if (XECOMCALL2 (ppf, Load,
- (LPWSTR) fname_unicode,
- STGM_READ) == S_OK
- && XECOMCALL4 (psl, GetPath, resolved,
- PATH_MAX_EXTERNAL, &wfd, 0) == S_OK)
- TO_INTERNAL_FORMAT (C_STRING, resolved,
- ALLOCA, (fname, fnamelen),
- Qmswindows_tstr);
-
- XECOMCALL0 (ppf, Release);
- }
-
- XECOMCALL0 (psl, Release);
- }
- }
+ fname = mswindows_read_link (fname);
+ freeme = 1;
}
-#endif /* !defined (NO_CYGWIN_COM_SUPPORT) */
+
{
- fname = urlify_filename (fname);
- l_item = build_intstring (fname);
- xfree (fname, Ibyte *);
+ Ibyte *fname2 = urlify_filename (fname);
+ l_item = build_intstring (fname2);
+ xfree (fname2, Ibyte *);
+ if (freeme)
+ xfree (fname, Ibyte *);
l_dndlist = Fcons (l_item, l_dndlist);
}
}
Index: src/fileio.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/fileio.c,v
retrieving revision 1.103
diff -u -p -r1.103 fileio.c
--- src/fileio.c 2005/01/24 23:33:55 1.103
+++ src/fileio.c 2005/01/28 02:31:53
＠＠ -23,6 +23,7 ＠＠ Boston, MA 02111-1307, USA. */
/* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa(a)cam.org>
(Note: Sync messages from Marc Paquette may indicate
incomplete synching, so beware.) */
+/* Some functions synched with FSF 21.0.103. */
/* Mule-ized completely except for the #if 0-code including decrypt-string
and encrypt-string. --ben 7-2-00 */
/* #if 0-code Mule-ized, 2-22-03. --ben */
＠＠ -38,6 +39,7 ＠＠ Boston, MA 02111-1307, USA. */
#include "frame.h"
#include "insdel.h"
#include "lstream.h"
+#include "profile.h"
#include "process.h"
#include "redisplay.h"
#include "sysdep.h"
＠＠ -129,6 +131,8 ＠＠ Lisp_Object Qcar_less_than_car;
Lisp_Object Qcompute_buffer_file_truename;
+Lisp_Object QSin_expand_file_name;
+
EXFUN (Frunning_temacs_p, 0);
/* DATA can be anything acceptable to signal_error ().
＠＠ -325,6 +329,25 ＠＠ call3_check_string (Lisp_Object fn, Lisp
}
+
+Ibyte *
+find_end_of_directory_component (const Ibyte *path, Bytecount len)
+{
+ const Ibyte *p = path + len;
+
+ while (p != path && !IS_DIRECTORY_SEP (p[-1])
+#ifdef WIN32_FILENAMES
+ /* only recognise drive specifier at the beginning */
+ && !(p[-1] == ':'
+ /* handle the "/:d:foo" and "/:foo" cases correctly */
+ && ((p == path + 2 && !IS_DIRECTORY_SEP (*path))
+ || (p == path + 4 && IS_DIRECTORY_SEP (*path))))
+#endif
+ ) p--;
+
+ return (Ibyte *) p;
+}
+
DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
Return the directory component in file name FILENAME.
Return nil if FILENAME does not include a directory.
＠＠ -352,17 +375,7 ＠＠ Given a Unix syntax file name, returns a
#endif
beg = XSTRING_DATA (filename);
/* XEmacs: no need to alloca-copy here */
- p = beg + XSTRING_LENGTH (filename);
-
- while (p != beg && !IS_DIRECTORY_SEP (p[-1])
-#ifdef WIN32_FILENAMES
- /* only recognise drive specifier at the beginning */
- && !(p[-1] == ':'
- /* handle the "/:d:foo" and "/:foo" cases correctly */
- && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
- || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
-#endif
- ) p--;
+ p = find_end_of_directory_component (beg, XSTRING_LENGTH (filename));
if (p == beg)
return Qnil;
＠＠ -522,7 +535,11 ＠＠ except for (file-name-as-directory \"\")
return call2_check_string (handler, Qfile_name_as_directory, filename);
buf = alloca_ibytes (XSTRING_LENGTH (filename) + 10);
- return build_intstring (file_name_as_directory (buf, XSTRING_DATA (filename)));
+ file_name_as_directory (buf, XSTRING_DATA (filename));
+ if (qxestrcmp (buf, XSTRING_DATA (filename)))
+ return build_intstring (buf);
+ else
+ return filename;
}
/*
＠＠ -735,7 +752,10 ＠＠ See also the function `substitute-in-fil
int length;
Lisp_Object handler = Qnil;
struct gcpro gcpro1, gcpro2, gcpro3;
+ PROFILE_DECLARE ();
+ PROFILE_RECORD_ENTERING_SECTION (QSin_expand_file_name);
+
/* both of these get set below */
GCPRO3 (name, default_directory, handler);
＠＠ -745,8 +765,10 ＠＠ See also the function `substitute-in-fil
call the corresponding file handler. */
handler = Ffind_file_name_handler (name, Qexpand_file_name);
if (!NILP (handler))
- RETURN_UNGCPRO (call3_check_string (handler, Qexpand_file_name,
- name, default_directory));
+ RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name,
+ call3_check_string
+ (handler, Qexpand_file_name,
+ name, default_directory));
/* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
if (NILP (default_directory))
＠＠ -762,8 +784,9 ＠＠ See also the function `substitute-in-fil
{
handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
if (!NILP (handler))
- RETURN_UNGCPRO (call3 (handler, Qexpand_file_name,
- name, default_directory));
+ RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name,
+ call3 (handler, Qexpand_file_name,
+ name, default_directory));
}
o = XSTRING_DATA (default_directory);
＠＠ -927,13 +950,14 ＠＠ See also the function `substitute-in-fil
}
}
xfree (newnm, Ibyte *);
- RETURN_UNGCPRO (name);
+ RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, name);
}
#endif /* WIN32_FILENAMES */
#ifndef WIN32_NATIVE
if (nm == XSTRING_DATA (name))
- RETURN_UNGCPRO (name);
- RETURN_UNGCPRO (build_intstring (nm));
+ RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, name);
+ RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name,
+ build_intstring (nm));
#endif /* not WIN32_NATIVE */
}
}
＠＠ -1301,10 +1325,11 ＠＠ See also the function `substitute-in-fil
Lisp_Object result = build_intstring (newtarget);
xfree (newtarget, Ibyte *);
- RETURN_UNGCPRO (result);
+ RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, result);
}
#else /* not WIN32_FILENAMES */
- RETURN_UNGCPRO (make_string (target, o - target));
+ RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name,
+ make_string (target, o - target));
#endif /* not WIN32_FILENAMES */
}
＠＠ -1360,7 +1385,7 ＠＠ No component of the resulting pathname w
p = path;
/* Try doing it all at once. */
- if (!qxe_realpath (path, resolved_path))
+ if (!qxe_realpath (path, resolved_path, 0))
{
/* Didn't resolve it -- have to do it one component at a time. */
/* "realpath" is a typically useless, stupid un*x piece of crap.
＠＠ -1379,7 +1404,11 ＠＠ No component of the resulting pathname w
resolved_name are undefined."
Since we depend on undocumented semantics of various system
- realpath()s, we just use our own version in realpath.c. */
+ realpath()s, we just use our own version in realpath.c.
+
+ Note also that our own version differs in its semantics from any
+ standard version, since it accepts and returns internal-format
+ text, not external-format. */
for (;;)
{
Ibyte *pos;
＠＠ -1402,7 +1431,7 ＠＠ No component of the resulting pathname w
if (p != pos)
p = 0;
- if (qxe_realpath (path, resolved_path))
+ if (qxe_realpath (path, resolved_path, 0))
{
if (p)
*p = DIRECTORY_SEP;
＠＠ -2338,7 +2367,7 ＠＠ See also `file-exists-p' and `file-attri
if (!NILP (handler))
RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
-#if defined(WIN32_FILENAMES)
+#if defined (WIN32_FILENAMES)
/* Under MS-DOS and Windows, open does not work for directories. */
UNGCPRO;
if (qxe_access (XSTRING_DATA (abspath), 0) == 0)
＠＠ -2443,9 +2472,42 ＠＠ Otherwise returns nil.
val = make_string (buf, valsize);
xfree (buf, Ibyte *);
return val;
-#else /* not HAVE_READLINK */
+#elif defined (WIN32_NATIVE)
+ if (mswindows_shortcuts_are_symlinks)
+ {
+ /* We want to resolve the directory component and leave the rest
+ alone. */
+ Ibyte *path = XSTRING_DATA (filename);
+ Ibyte *dirend =
+ find_end_of_directory_component (path, XSTRING_LENGTH (filename));
+ Ibyte *fname;
+ DECLARE_EISTRING (dir);
+
+ if (dirend != path)
+ {
+ Ibyte *resdir;
+ DECLARE_EISTRING (resname);
+
+ eicpy_raw (dir, path, dirend - path);
+ PATHNAME_RESOLVE_LINKS (eidata (dir), resdir);
+ eicpy_rawz (resname, resdir);
+ eicat_rawz (resname, dirend);
+ path = eidata (resname);
+ }
+
+ fname = mswindows_read_link (path);
+ if (!fname)
+ return Qnil;
+ {
+ Lisp_Object val = build_intstring (fname);
+ xfree (fname, Ibyte *);
+ return val;
+ }
+ }
+ return Qnil;
+#else
return Qnil;
-#endif /* not HAVE_READLINK */
+#endif
}
DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
＠＠ -2499,7 +2561,7 ＠＠ searchable directory.
return call2 (handler, Qfile_accessible_directory_p,
filename);
-#if !defined(WIN32_NATIVE)
+#if !defined (WIN32_NATIVE)
if (NILP (Ffile_directory_p (filename)))
return (Qnil);
else
＠＠ -4300,6 +4362,10 ＠＠ syms_of_fileio (void)
void
vars_of_fileio (void)
{
+ QSin_expand_file_name =
+ build_msg_string ("(in expand-file-name)");
+ staticpro (&QSin_expand_file_name);
+
DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
*Format in which to write auto-save files.
Should be a list of symbols naming formats that are defined in `format-alist'.
Index: src/glyphs.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs.c,v
retrieving revision 1.49
diff -u -p -r1.49 glyphs.c
--- src/glyphs.c 2005/01/24 23:33:58 1.49
+++ src/glyphs.c 2005/01/28 02:31:54
＠＠ -1,7 +1,7 ＠＠
/* Generic glyph/image implementation + display tables
Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
Copyright (C) 1995 Tinker Systems
- Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing
+ Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing
Copyright (C) 1995 Sun Microsystems
Copyright (C) 1998, 1999, 2000 Andy Piper
＠＠ -2917,11 +2917,13 ＠＠ pixmap_to_lisp_data (Lisp_Object name, i
Lisp_Object
pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
{
- char **data;
+ Ascbyte **data;
int result;
- char *fname = 0;
+ Extbyte *fname = 0;
+ Ibyte *resolved;
- LISP_STRING_TO_EXTERNAL (name, fname, Qfile_name);
+ LISP_PATHNAME_RESOLVE_LINKS (name, resolved);
+ C_STRING_TO_EXTERNAL (resolved, fname, Qfile_name);
result = XpmReadFileToData (fname, &data);
if (result == XpmSuccess)
Index: src/lisp.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.119
diff -u -p -r1.119 lisp.h
--- src/lisp.h 2005/01/26 10:25:05 1.119
+++ src/lisp.h 2005/01/28 02:31:56
＠＠ -4305,6 +4305,8 ＠＠ DECLARE_DOESNT_RETURN (report_file_error
Lisp_Object lisp_strerror (int);
Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
int internal_delete_file (Lisp_Object);
+Ibyte *find_end_of_directory_component (const Ibyte *path,
+ Bytecount len);
/* Defined in filelock.c */
EXFUN (Funlock_buffer, 0);
Index: src/nt.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/nt.c,v
retrieving revision 1.45
diff -u -p -r1.45 nt.c
--- src/nt.c 2004/12/06 03:52:14 1.45
+++ src/nt.c 2005/01/28 02:31:57
＠＠ -30,7 +30,7 ＠＠ Software Foundation, Inc., 59 Temple Pla
incomplete synching, so beware.)
Synched (completely!) with Emacs 20.6 by Ben Wing, 6-23-00.
Largely rewritten by Ben Wing for XEmacs Mule support.
- Synched (completely!) with Emacs 21.1.103 by Ben Wing, 6-13-01.
+ Synched (completely!) with Emacs 21.0.103 by Ben Wing, 6-13-01.
*/
/* This file Mule-ized by Ben Wing, 6-23-00. */
＠＠ -295,7 +295,7 ＠＠ get_long_basename (Ibyte *name)
if (qxestrpbrk (name, "*?|<>\""))
return 0;
- C_STRING_TO_TSTR (name, nameext);
+ PATHNAME_CONVERT_OUT (name, nameext);
dir_handle = qxeFindFirstFile (nameext, &find_data);
if (dir_handle != INVALID_HANDLE_VALUE)
{
＠＠ -663,7 +663,7 ＠＠ get_cached_volume_information (Ibyte *ro
Ibyte drive[3] = { root_dir[0], ':' };
Extbyte *driveext;
- C_STRING_TO_TSTR (drive, driveext);
+ PATHNAME_CONVERT_OUT (drive, driveext);
if (qxeWNetGetConnection (driveext, remote_name,
sizeof (remote_name) / XETCHAR_SIZE)
== NO_ERROR)
＠＠ -682,7 +682,7 ＠＠ get_cached_volume_information (Ibyte *ro
Extbyte type[256 * MAX_XETCHAR_SIZE];
Extbyte *rootdirext;
- C_STRING_TO_TSTR (root_dir, rootdirext);
+ PATHNAME_CONVERT_OUT (root_dir, rootdirext);
/* Info is not cached, or is stale. */
if (!qxeGetVolumeInformation (rootdirext,
＠＠ -869,16 +869,16 ＠＠ mswindows_readdir (DIR *UNUSED (dirp))
{
DECLARE_EISTRING (filename);
Ichar lastch;
+ Extbyte *fileext;
eicpy_rawz (filename, dir_pathname);
lastch = eigetch_char (filename, eicharlen (filename) - 1);
if (!IS_DIRECTORY_SEP (lastch))
eicat_ch (filename, '\\');
eicat_ch (filename, '*');
- eito_external (filename, Qmswindows_tstr);
+ PATHNAME_CONVERT_OUT (eidata (filename), fileext);
- dir_find_handle = qxeFindFirstFile (eiextdata (filename),
- &dir_find_data);
+ dir_find_handle = qxeFindFirstFile (fileext, &dir_find_data);
if (dir_find_handle == INVALID_HANDLE_VALUE)
return NULL;
＠＠ -902,6 +902,33 ＠＠ mswindows_readdir (DIR *UNUSED (dirp))
DECLARE_EISTRING (found);
Bytecount namlen;
+ if (mswindows_shortcuts_are_symlinks)
+ {
+ int len = qxestrlen (val);
+ if (len > 4 && !qxestrcasecmp_ascii (val + len - 4, ".LNK"))
+ {
+ /* If we've found a valid link, then chop off the .LNK ending */
+ DECLARE_EISTRING (linkname);
+ Ichar lastch;
+ Ibyte *resolved;
+
+ /* First check if link is valid */
+ PATHNAME_RESOLVE_LINKS (dir_pathname, resolved);
+ eicpy_rawz (linkname, resolved);
+ lastch = eigetch_char (linkname, eicharlen (linkname) - 1);
+ if (!IS_DIRECTORY_SEP (lastch))
+ eicat_ch (linkname, '\\');
+ eicat_rawz (linkname, val);
+ resolved = mswindows_read_link (eidata (linkname));
+ if (resolved)
+ {
+ xfree (resolved, Ibyte *);
+ len -= 4;
+ val[len] = '\0';
+ }
+ }
+ }
+
eicpy_rawz (found, val);
if (need_to_free)
xfree (val, Ibyte *);
＠＠ -930,7 +957,7 ＠＠ open_unc_volume (const Ibyte *path)
nr.dwDisplayType = RESOURCEDISPLAYTYPE_SERVER;
nr.dwUsage = RESOURCEUSAGE_CONTAINER;
nr.lpLocalName = NULL;
- C_STRING_TO_TSTR (path, nr.lpRemoteName);
+ PATHNAME_CONVERT_OUT (path, nr.lpRemoteName);
nr.lpComment = NULL;
nr.lpProvider = NULL;
＠＠ -1023,7 +1050,7 ＠＠ mswindows_access (const Ibyte *path, int
{
Extbyte *pathext;
- C_STRING_TO_TSTR (path, pathext);
+ PATHNAME_CONVERT_OUT (path, pathext);
if ((attributes = qxeGetFileAttributes (pathext)) == -1)
{
/* Should try mapping GetLastError to errno; for now just indicate
＠＠ -1066,7 +1093,7 ＠＠ mswindows_link (const Ibyte *old, const
return -1;
}
- C_STRING_TO_TSTR (old, oldext);
+ PATHNAME_CONVERT_OUT (old, oldext);
fileh = qxeCreateFile (oldext, 0, 0, NULL, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (fileh != INVALID_HANDLE_VALUE)
＠＠ -1175,8 +1202,8 ＠＠ mswindows_rename (const Ibyte *oldname,
seems to make the second rename work properly. */
qxesprintf (p, "_.%s.%u", o, i);
i++;
- C_STRING_TO_EXTERNAL (oldname, oldext, Qfile_name);
- C_STRING_TO_EXTERNAL (temp, tempext, Qfile_name);
+ PATHNAME_CONVERT_OUT (oldname, oldext);
+ PATHNAME_CONVERT_OUT (temp, tempext);
result = rename (oldext, tempext);
}
/* This loop must surely terminate! */
＠＠ -1198,15 +1225,28 ＠＠ mswindows_rename (const Ibyte *oldname,
{
Extbyte *newext, *tempext;
- C_STRING_TO_EXTERNAL (newname, newext, Qfile_name);
- C_STRING_TO_EXTERNAL (temp, tempext, Qfile_name);
- result = rename (tempext, newext);
-
- if (result < 0
- && (errno == EEXIST || errno == EACCES)
- && _chmod (newext, 0666) == 0
- && _unlink (newext) == 0)
- result = rename (tempext, newext);
+ PATHNAME_CONVERT_OUT (newname, newext);
+ PATHNAME_CONVERT_OUT (temp, tempext);
+ if (XEUNICODE_P)
+ {
+ result = _wrename ((const wchar_t *) tempext,
+ (const wchar_t *) newext);
+ if (result < 0
+ && (errno == EEXIST || errno == EACCES)
+ && _wchmod ((const wchar_t *) newext, 0666) == 0
+ && _wunlink ((const wchar_t *) newext) == 0)
+ result = _wrename ((const wchar_t *) tempext,
+ (const wchar_t *) newext);
+ }
+ else
+ {
+ result = rename (tempext, newext);
+ if (result < 0
+ && (errno == EEXIST || errno == EACCES)
+ && _chmod (newext, 0666) == 0
+ && _unlink (newext) == 0)
+ result = rename (tempext, newext);
+ }
}
return result;
＠＠ -1217,10 +1257,18 ＠＠ mswindows_unlink (const Ibyte *path)
{
Extbyte *pathout;
- C_STRING_TO_EXTERNAL (path, pathout, Qfile_name);
+ PATHNAME_CONVERT_OUT (path, pathout);
/* On Unix, unlink works without write permission. */
- _chmod (pathout, 0666);
- return _unlink (pathout);
+ if (XEUNICODE_P)
+ {
+ _wchmod ((const wchar_t *) pathout, 0666);
+ return _wunlink ((const wchar_t *) pathout);
+ }
+ else
+ {
+ _chmod (pathout, 0666);
+ return _unlink (pathout);
+ }
}
static FILETIME utc_base_ft;
＠＠ -1510,6 +1558,8 ＠＠ mswindows_stat (const Ibyte *path, struc
{
if (!IS_DIRECTORY_SEP (name[len-1]))
qxestrcat (name, (Ibyte *) "\\");
+ /* File has already been resolved and we don't want to do it again
+ in case of lstat() */
C_STRING_TO_TSTR (name, nameext);
if (qxeGetDriveType (nameext) < 2)
{
＠＠ -1574,13 +1624,15 ＠＠ mswindows_stat (const Ibyte *path, struc
else
{
if (!NILP (Vmswindows_get_true_file_attributes))
+ /* File has already been resolved and we don't want to do it again
+ in case of lstat() */
C_STRING_TO_TSTR (name, nameext);
if (!NILP (Vmswindows_get_true_file_attributes)
/* No access rights required to get info. */
&& (fh = qxeCreateFile (nameext, 0, 0, NULL, OPEN_EXISTING, 0, NULL))
!= INVALID_HANDLE_VALUE)
{
- /* This is more accurate in terms of gettting the correct number
+ /* This is more accurate in terms of getting the correct number
of links, but is quite slow (it is noticable when Emacs is
making a list of file name completions). */
BY_HANDLE_FILE_INFORMATION info;
＠＠ -1623,6 +1675,22 ＠＠ mswindows_stat (const Ibyte *path, struc
buf->st_nlink = 1;
fake_inode = 0;
}
+
+ if (mswindows_shortcuts_are_symlinks &&
+ buf->st_mode == _S_IFREG)
+ {
+ len = qxestrlen (name);
+ if (len > 4 && !qxestrcasecmp_ascii (name + len - 4, ".LNK"))
+ {
+ /* check if link is valid */
+ Ibyte *resolved = mswindows_read_link (name);
+ if (resolved)
+ {
+ xfree (resolved, Ibyte *);
+ buf->st_mode = S_IFLNK;
+ }
+ }
+ }
}
SetErrorMode (errm);
＠＠ -1698,7 +1766,7 ＠＠ mswindows_utime (Lisp_Object path, struc
times = &deftime;
}
- LISP_STRING_TO_TSTR (path, filename);
+ LISP_PATHNAME_CONVERT_OUT (path, filename);
/* APA: SetFileTime fails to set mtime correctly (always 1-Jan-1970) */
#if 0
/* Need write access to set times. */
＠＠ -1768,7 +1836,7 ＠＠ open_input_file (file_data *p_file, cons
DWORD size, upper_size;
Extbyte *fileext;
- C_STRING_TO_TSTR (filename, fileext);
+ PATHNAME_CONVERT_OUT (filename, fileext);
file = qxeCreateFile (fileext, GENERIC_READ, FILE_SHARE_READ, NULL,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
＠＠ -1804,7 +1872,7 ＠＠ open_output_file (file_data *p_file, con
void *file_base;
Extbyte *fileext;
- C_STRING_TO_TSTR (filename, fileext);
+ PATHNAME_CONVERT_OUT (filename, fileext);
file = qxeCreateFile (fileext, GENERIC_READ | GENERIC_WRITE, 0, NULL,
CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
＠＠ -2007,7 +2075,7 ＠＠ All path elements in FILENAME are conver
/* first expand it. */
filename = Fexpand_file_name (filename, Qnil);
- LISP_STRING_TO_TSTR (filename, fileext);
+ LISP_PATHNAME_CONVERT_OUT (filename, fileext);
/* luckily, this returns the short version of each element in the path. */
if (qxeGetShortPathName (fileext, shortname,
sizeof (shortname) / XETCHAR_SIZE) == 0)
＠＠ -2121,7 +2189,7 ＠＠ init_nt (void)
{
Extbyte *driveext;
- C_STRING_TO_TSTR (drive, driveext);
+ PATHNAME_CONVERT_OUT (drive, driveext);
/* Record if this drive letter refers to a fixed drive. */
fixed_drives[DRIVE_INDEX (*drive)] =
Index: src/ntplay.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ntplay.c,v
retrieving revision 1.12
diff -u -p -r1.12 ntplay.c
--- src/ntplay.c 2004/11/04 23:06:45 1.12
+++ src/ntplay.c 2005/01/28 02:31:57
＠＠ -35,14 +35,12 ＠＠ static int play_sound_data_1 (Binbyte *d
int volume, int convert);
void
-play_sound_file (Extbyte *sound_file, int UNUSED (volume))
+nt_play_sound_file (Lisp_Object path, int UNUSED (volume))
{
DWORD flags = SND_ASYNC | SND_NODEFAULT | SND_FILENAME;
- Lisp_Object fname =
- Ffile_name_nondirectory (build_tstr_string (sound_file));
+ Lisp_Object fname = Ffile_name_nondirectory (path);
Extbyte *fnameext;
- CHECK_STRING (fname);
LISP_STRING_TO_TSTR (fname, fnameext);
if (qxeSearchPath (NULL, fnameext, NULL, 0, NULL, NULL) == 0)
＠＠ -50,9 +48,9 ＠＠ play_sound_file (Extbyte *sound_file, in
/* file isn't in the path so read it as data */
int size;
Binbyte *data;
- int ofd = qxe_open (XSTRING_DATA (fname), O_RDONLY | OPEN_BINARY, 0);
+ int ofd = qxe_open (XSTRING_DATA (path), O_RDONLY | OPEN_BINARY, 0);
- if (ofd <0)
+ if (ofd < 0)
return;
size = lseek (ofd, 0, SEEK_END);
Index: src/process-nt.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/process-nt.c,v
retrieving revision 1.37
diff -u -p -r1.37 process-nt.c
--- src/process-nt.c 2005/01/24 23:34:05 1.37
+++ src/process-nt.c 2005/01/28 02:31:57
＠＠ -764,13 +764,15 ＠＠ nt_create_process (Lisp_Process *p,
if (mswindows_is_executable (XSTRING_DATA (program)))
{
Extbyte *progext;
- LISP_STRING_TO_TSTR (program, progext);
+ LISP_PATHNAME_CONVERT_OUT (program, progext);
image_type = qxeSHGetFileInfo (progext, 0, NULL, 0, SHGFI_EXETYPE);
}
else
{
DECLARE_EISTRING (progext);
- eicpy_lstr (progext, program);
+ Ibyte *prog2;
+ LISP_PATHNAME_RESOLVE_LINKS (program, prog2);
+ eicpy_rawz (progext, prog2);
eicat_ascii (progext, ".exe");
eito_external (progext, Qmswindows_tstr);
image_type = qxeSHGetFileInfo (eiextdata (progext), 0, NULL, 0,
＠＠ -858,6 +860,7 ＠＠ nt_create_process (Lisp_Process *p,
("Bogus return value from `mswindows-construct-process-command-line'",
args_or_ret);
+ /* #### What about path names, which may be links? */
LISP_STRING_TO_TSTR (args_or_ret, command_line);
UNGCPRO; /* args_or_ret */
＠＠ -994,7 +997,7 ＠＠ nt_create_process (Lisp_Process *p,
{
Extbyte *curdirext;
- LISP_STRING_TO_TSTR (cur_dir, curdirext);
+ LISP_PATHNAME_CONVERT_OUT (cur_dir, curdirext);
err = (qxeCreateProcess (NULL, command_line, NULL, NULL, TRUE,
(XEUNICODE_P ?
Index: src/realpath.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/realpath.c,v
retrieving revision 1.20
diff -u -p -r1.20 realpath.c
--- src/realpath.c 2004/12/06 03:52:17 1.20
+++ src/realpath.c 2005/01/28 02:31:58
＠＠ -1,7 +1,7 ＠＠
/*
* realpath.c -- canonicalize pathname by removing symlinks
* Copyright (C) 1993 Rick Sladkey <jrs(a)world.std.com>
- * Copyright (C) 2001, 2002 Ben Wing.
+ * Copyright (C) 2001, 2002, 2004 Ben Wing.
*
This file is part of XEmacs.
＠＠ -31,6 +31,8 ＠＠ Boston, MA 02111-1307, USA. */
#include <config.h>
#include "lisp.h"
+#include "profile.h"
+
#include "sysfile.h"
#include "sysdir.h"
＠＠ -43,6 +45,8 ＠＠ Boston, MA 02111-1307, USA. */
#endif
#endif
+Lisp_Object QSin_qxe_realpath;
+
/* Length of start of absolute filename. */
static int
abs_start (const Ibyte *name)
＠＠ -59,25 +63,31 ＠＠ abs_start (const Ibyte *name)
return IS_DIRECTORY_SEP (*name) ? 1 : 0;
#endif
}
+
+/* Find real name of a file by resolving symbolic links and/or shortcuts
+ under Windows (.LNK links), if such support is enabled.
-/* Find real name of a file by resolving symbolic links and (under Windows)
- looking up the correct case of the file as it appears on the file
- system.
+ If no link found, and LINKS_ONLY is false, look up the correct case in
+ the file system of the last component.
Under Windows, UNC servers and shares are lower-cased. Directories must
be given without trailing '/'. One day, this could read Win2K's reparse
- points. */
+ points.
+ Returns length of characters copied info BUF.
+ DOES NOT ZERO TERMINATE!!!!!
+*/
+
static int
-readlink_and_correct_case (const Ibyte *name, Ibyte *buf,
- int size)
+readlink_or_correct_case (const Ibyte *name, Ibyte *buf, Bytecount size,
+ Boolint links_only)
{
#ifndef WIN32_ANY
- return qxe_readlink (name, buf, size);
+ return qxe_readlink (name, buf, (size_t) size);
#else
# ifdef CYGWIN
Ibyte *tmp;
- int n = qxe_readlink (name, buf, size);
+ int n = qxe_readlink (name, buf, (size_t) size);
if (n >= 0 || errno != EINVAL)
return n;
＠＠ -87,8 +97,33 ＠＠ readlink_and_correct_case (const Ibyte *
alloca_ibytes (cygwin_posix_to_win32_path_list_buf_size ((char *) name));
cygwin_posix_to_win32_path_list ((char *) name, (char *) tmp);
name = tmp;
+# else
+ if (mswindows_shortcuts_are_symlinks)
+ {
+ Ibyte *tmp = mswindows_read_link (name);
+
+ if (tmp != NULL)
+ {
+ /* Fucking fixed buffers. */
+ Bytecount len = qxestrlen (tmp);
+ if (len > size)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+ memcpy (buf, tmp, len);
+ xfree (tmp, Ibyte *);
+ return len;
+ }
+ }
# endif
+ if (links_only)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
{
int len = 0;
int err = 0;
＠＠ -144,16 +179,16 ＠＠ readlink_and_correct_case (const Ibyte *
FindClose (dir_handle);
}
- if ((len = eilen (result)) < size)
+ if ((len = eilen (result)) <= size)
{
DECLARE_EISTRING (eilastname);
eicpy_rawz (eilastname, lastname);
if (eicmp_ei (eilastname, result) == 0)
- /* Signal that the name is already OK. */
- err = EINVAL;
+ /* Signal that the name is already OK. */
+ err = EINVAL;
else
- memcpy (buf, eidata (result), len + 1);
+ memcpy (buf, eidata (result), len);
}
else
err = ENAMETOOLONG;
＠＠ -165,14 +200,18 ＠＠ readlink_and_correct_case (const Ibyte *
}
/* Mule Note: This function works with and returns
- internally-formatted strings. */
+ internally-formatted strings.
+
+ if LINKS_ONLY is true, don't do case canonicalization under
+ Windows. */
Ibyte *
-qxe_realpath (const Ibyte *path, Ibyte *resolved_path)
+qxe_realpath (const Ibyte *path, Ibyte *resolved_path, Boolint links_only)
{
Ibyte copy_path[PATH_MAX_INTERNAL];
Ibyte *new_path = resolved_path;
Ibyte *max_path;
+ Ibyte *retval = NULL;
#if defined (HAVE_READLINK) || defined (WIN32_ANY)
int readlinks = 0;
Ibyte link_path[PATH_MAX_INTERNAL];
＠＠ -180,6 +219,10 ＠＠ qxe_realpath (const Ibyte *path, Ibyte *
int abslen = abs_start (path);
#endif
+ PROFILE_DECLARE ();
+
+ PROFILE_RECORD_ENTERING_SECTION (QSin_qxe_realpath);
+
restart:
/* Make a copy of the source path since we may need to modify it. */
＠＠ -288,7 +331,7 ＠＠ qxe_realpath (const Ibyte *path, Ibyte *
if (path > max_path)
{
errno = ENAMETOOLONG;
- return NULL;
+ goto done;
}
*new_path++ = *path++;
}
＠＠ -297,7 +340,8 ＠＠ qxe_realpath (const Ibyte *path, Ibyte *
/* See if latest pathname component is a symlink or needs case
correction. */
*new_path = '\0';
- n = readlink_and_correct_case (resolved_path, link_path, PATH_MAX_INTERNAL - 1);
+ n = readlink_or_correct_case (resolved_path, link_path,
+ PATH_MAX_INTERNAL - 1, links_only);
if (n < 0)
{
＠＠ -308,7 +352,7 ＠＠ qxe_realpath (const Ibyte *path, Ibyte *
#else
if (errno != EINVAL)
#endif
- return NULL;
+ goto done;
}
else
{
＠＠ -316,7 +360,7 ＠＠ qxe_realpath (const Ibyte *path, Ibyte *
if (readlinks++ > MAX_READLINKS)
{
errno = ELOOP;
- return NULL;
+ goto done;
}
/* Note: readlink doesn't add the null byte. */
＠＠ -340,7 +384,7 ＠＠ qxe_realpath (const Ibyte *path, Ibyte *
if (qxestrlen (path) + n >= PATH_MAX_INTERNAL)
{
errno = ENAMETOOLONG;
- return NULL;
+ goto done;
}
/* Insert symlink contents into path. */
＠＠ -360,5 +404,16 ＠＠ qxe_realpath (const Ibyte *path, Ibyte *
/* Make sure it's null terminated. */
*new_path = '\0';
- return resolved_path;
+ retval = resolved_path;
+done:
+ PROFILE_RECORD_EXITING_SECTION (QSin_qxe_realpath);
+ return retval;
+}
+
+void
+vars_of_realpath (void)
+{
+ QSin_qxe_realpath =
+ build_msg_string ("(in qxe_realpath)");
+ staticpro (&QSin_qxe_realpath);
}
Index: src/sound.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sound.c,v
retrieving revision 1.22
diff -u -p -r1.22 sound.c
--- src/sound.c 2004/11/04 23:06:53 1.22
+++ src/sound.c 2005/01/28 02:31:58
＠＠ -1,7 +1,7 ＠＠
/* Sound functions.
Copyright (C) 1992, 1993, 1994 Lucid Inc.
Copyright (C) 1994, 1995 Free Software Foundation, Inc.
- Copyright (C) 2002 Ben Wing.
+ Copyright (C) 2002, 2004 Ben Wing.
This file is part of XEmacs.
＠＠ -161,20 +161,17 ＠＠ Windows the sound file must be in WAV fo
#ifdef HAVE_NATIVE_SOUND
if (NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
{
- Extbyte *fileext;
-
-#ifdef WIN32_NATIVE
- /* #### more garbage. we should be passing the internal file name
- to play_sound_file. */
- LISP_STRING_TO_EXTERNAL (file, fileext, Qmswindows_tstr);
+#ifdef WIN32_ANY
+ nt_play_sound_file (file, vol);
#else
- LISP_STRING_TO_EXTERNAL (file, fileext, Qfile_name);
-#endif
+ Extbyte *fileext;
+ LISP_PATHNAME_CONVERT_OUT (file, fileext);
/* The sound code doesn't like getting SIGIO interrupts.
Unix sucks! */
stop_interrupts ();
play_sound_file (fileext, vol);
start_interrupts ();
+#endif /* WIN32_NATIVE */
QUIT;
}
#endif /* HAVE_NATIVE_SOUND */
Index: src/sound.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sound.h,v
retrieving revision 1.9
diff -u -p -r1.9 sound.h
--- src/sound.h 2004/11/04 23:06:53 1.9
+++ src/sound.h 2005/01/28 02:31:58
＠＠ -27,6 +27,7 ＠＠ Boston, MA 02111-1307, USA. */
/* Defined in *play.c */
void play_sound_file (Extbyte *name, int volume);
+void nt_play_sound_file (Lisp_Object name, int volume);
int play_sound_data (Binbyte *data, int length, int volume);
# define sound_perror(string) \
Index: src/symsinit.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/symsinit.h,v
retrieving revision 1.50
diff -u -p -r1.50 symsinit.h
--- src/symsinit.h 2004/11/04 23:06:54 1.50
+++ src/symsinit.h 2005/01/28 02:31:58
＠＠ -406,6 +406,7 ＠＠ void vars_of_process_nt (void);
void vars_of_process_unix (void);
void vars_of_profile (void);
void vars_of_ralloc (void);
+void vars_of_realpath (void);
void vars_of_redisplay (void);
void vars_of_regex (void);
void vars_of_scrollbar_x (void);
Index: src/sysdep.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sysdep.c,v
retrieving revision 1.79
diff -u -p -r1.79 sysdep.c
--- src/sysdep.c 2005/01/24 23:34:11 1.79
+++ src/sysdep.c 2005/01/28 02:31:59
＠＠ -628,7 +628,7 ＠＠ sys_subshell (void)
if (sh == 0)
sh = (Ibyte *) "sh";
- C_STRING_TO_EXTERNAL (sh, shext, Qfile_name);
+ PATHNAME_CONVERT_OUT (sh, shext);
UNGCPRO;
＠＠ -638,7 +638,10 ＠＠ sys_subshell (void)
qxe_chdir (str);
/* Waits for process completion */
- if (_spawnlp (_P_WAIT, shext, shext, NULL) != 0)
+ if (XEUNICODE_P ?
+ _wspawnlp (_P_WAIT, (const wchar_t *) shext,
+ (const wchar_t *) shext, NULL) != 0 :
+ _spawnlp (_P_WAIT, shext, shext, NULL) != 0)
report_process_error ("Can't spawn subshell", Qunbound);
else
return; /* we're done, no need to wait for termination */
＠＠ -2537,18 +2540,6 ＠＠ strerror (int errnum)
/* Encapsulations of system calls */
/************************************************************************/
-/* The documentation in VC++ claims that the pathname library functions
- accept strings in the current locale-specific encoding, but that's
- false, because they just call the native Win32 routines directly, which
- always use the system-default encoding (which is what Qmswindows_tstr
- will give us when not XEUNICODE_P). */
-#ifdef WIN32_NATIVE
-#define PATHNAME_CONVERT_OUT(path, pathout) C_STRING_TO_TSTR (path, pathout)
-#else
-#define PATHNAME_CONVERT_OUT(path, pathout) \
- C_STRING_TO_EXTERNAL (path, pathout, Qfile_name)
-#endif
-
/***************** low-level calls ****************/
/*
＠＠ -3180,6 +3171,51 ＠＠ qxe_lstat (const Ibyte *path, struct sta
In that case, use ordinary stat instead. */
#ifndef S_IFLNK
return qxe_stat (path, buf);
+#elif defined (WIN32_NATIVE)
+ if (mswindows_shortcuts_are_symlinks)
+ {
+ /* We want to resolve the directory component and leave the rest
+ alone. */
+ Ibyte *dirend = find_end_of_directory_component (path, qxestrlen (path));
+ Bytecount len;
+
+ if (dirend != path)
+ {
+ Ibyte *resdir;
+ Ichar lastch;
+ DECLARE_EISTRING (resname);
+ DECLARE_EISTRING (dir);
+
+ eicpy_raw (dir, path, dirend - path);
+ PATHNAME_RESOLVE_LINKS (eidata (dir), resdir);
+ eicpy_rawz (resname, resdir);
+ lastch = eigetch_char (resname, eicharlen (resname) - 1);
+ if (!IS_DIRECTORY_SEP (lastch))
+ eicat_ch (resname, '\\');
+ eicat_rawz (resname, dirend);
+ path = eidata (resname);
+ }
+
+ /* However, if what we are trying to stat is a link, we need to add
+ the .LNK so that the actual file is statted. */
+ len = qxestrlen (path);
+ if (len > 4 && qxestrcasecmp_ascii (path + len - 4, ".LNK"))
+ {
+ DECLARE_EISTRING (name2);
+ Ibyte *resolved;
+
+ eicpy_rawz (name2, path);
+ eicat_ascii (name2, ".LNK");
+ resolved = mswindows_read_link (eidata (name2));
+ if (resolved)
+ {
+ xfree (resolved, Ibyte *);
+ return mswindows_stat (eidata (name2), buf);
+ }
+ }
+ }
+
+ return mswindows_stat (path, buf);
#else
Extbyte *pathout;
PATHNAME_CONVERT_OUT (path, pathout);
＠＠ -3227,7 +3263,9 ＠＠ int
qxe_stat (const Ibyte *path, struct stat *buf)
{
#ifdef WIN32_NATIVE
- return mswindows_stat (path, buf);
+ Ibyte *resolved;
+ PATHNAME_RESOLVE_LINKS (path, resolved);
+ return mswindows_stat (resolved, buf);
#else /* not WIN32_NATIVE */
Extbyte *pathout;
PATHNAME_CONVERT_OUT (path, pathout);
Index: src/sysfile.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sysfile.h,v
retrieving revision 1.19
diff -u -p -r1.19 sysfile.h
--- src/sysfile.h 2004/12/06 03:52:21 1.19
+++ src/sysfile.h 2005/01/28 02:32:00
＠＠ -238,6 +238,13 ＠＠ Boston, MA 02111-1307, USA. */
#undef S_ISSOCK
#endif /* STAT_MACROS_BROKEN. */
+#ifdef WIN32_NATIVE
+/* This is the standard value for S_IFLNK. All of the S_... flags that
+ exist in the MSVCRT have standard values, so their bit tests will
+ magically work. */
+#define S_IFLNK 0120000
+#endif
+
#if !defined(S_ISBLK) && defined(S_IFBLK)
#define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
#endif
＠＠ -376,7 +383,8 ＠＠ int qxe_lstat (const Ibyte *path, struct
int qxe_readlink (const Ibyte *path, Ibyte *buf, size_t bufsiz);
int qxe_fstat (int fd, struct stat *buf);
int qxe_stat (const Ibyte *path, struct stat *buf);
-Ibyte *qxe_realpath (const Ibyte *path, Ibyte resolved_path []);
+Ibyte *qxe_realpath (const Ibyte *path, Ibyte resolved_path [],
+ Boolint links_only);
/* encapsulations: file-manipulation calls */
＠＠ -399,6 +407,10 ＠＠ int qxe_unlink (const Ibyte *path);
on systems like SCO 3.2v5 */
void filemodestring (struct stat *, char *);
+#ifdef WIN32_ANY
+extern int mswindows_shortcuts_are_symlinks;
+#endif
+
#endif /* emacs */
＠＠ -506,6 +518,50 ＠＠ DECLARE_INLINE_HEADER (int IS_ANY_SEP (I
#define IS_ANY_SEP(c) IS_DIRECTORY_SEP (c)
#endif /* WIN32_ANY */
+
+#if defined (WIN32_NATIVE)
+#define PATHNAME_RESOLVE_LINKS(path, pathout) \
+do \
+{ \
+ if (mswindows_shortcuts_are_symlinks) \
+ { \
+ Ibyte *_prl_path_ = (Ibyte *) (path); \
+ Ibyte _prl_path2_[PATH_MAX_INTERNAL]; \
+ \
+ if (!qxe_realpath (_prl_path_, _prl_path2_, 1)) \
+ (pathout) = _prl_path_; \
+ else \
+ IBYTE_STRING_TO_ALLOCA (_prl_path2_, pathout); \
+ } \
+ else (pathout) = (Ibyte *) (path); \
+} while (0)
+#else
+#define PATHNAME_RESOLVE_LINKS(path, pathout) ((pathout) = (Ibyte *) (path))
+#endif
+
+#define LISP_PATHNAME_RESOLVE_LINKS(path, pathout) \
+ PATHNAME_RESOLVE_LINKS (XSTRING_DATA (path), pathout)
+
+/* The documentation in VC++ claims that the pathname library functions
+ accept strings in the current locale-specific encoding, but that's
+ false, because they just call the native Win32 routines directly, which
+ always use the system-default encoding (which is what Qmswindows_tstr
+ will give us when not XEUNICODE_P). */
+#ifdef WIN32_NATIVE
+# define PATHNAME_CONVERT_OUT(path, pathout) \
+do \
+{ \
+ const Ibyte *_pco_path_; \
+ PATHNAME_RESOLVE_LINKS (path, _pco_path_); \
+ C_STRING_TO_TSTR (_pco_path_, pathout); \
+} while (0)
+#else
+# define PATHNAME_CONVERT_OUT(path, pathout) \
+ C_STRING_TO_EXTERNAL (path, pathout, Qfile_name)
+#endif
+
+#define LISP_PATHNAME_CONVERT_OUT(path, pathout) \
+ PATHNAME_CONVERT_OUT (XSTRING_DATA (path), pathout)
#endif /* emacs */
Index: src/syswindows.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/syswindows.h,v
retrieving revision 1.25
diff -u -p -r1.25 syswindows.h
--- src/syswindows.h 2005/01/24 23:34:11 1.25
+++ src/syswindows.h 2005/01/28 02:32:00
＠＠ -939,10 +939,10 ＠＠ END_C_DECLS
#define LOCAL_FILE_FORMAT_TO_TSTR(path, out) \
do { \
- Ibyte *lttff; \
+ Ibyte *lttff; \
\
LOCAL_TO_WIN32_FILE_FORMAT (XSTRING_DATA (path), lttff); \
- C_STRING_TO_TSTR (lttff, out); \
+ PATHNAME_CONVERT_OUT (lttff, out); \
} while (0)
Lisp_Object tstr_to_local_file_format (Extbyte *pathout);
＠＠ -1006,40 +1006,40 ＠＠ do { \
#ifdef CYGWIN
-#define LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR(lispstr, pathout) \
-do \
-{ \
- Ibyte *lffmutt_fname1; \
- Ibyte *lffmutt_pathint = XSTRING_DATA (lispstr); \
- \
- if ((lffmutt_fname1 = qxestrchr (lffmutt_pathint, ':')) != NULL \
- && *++lffmutt_fname1 == '/' && *++lffmutt_fname1 == '/') \
- { \
- /* If URL style file, the innards may have Cygwin mount points and \
- the like. so separate out the innards, process them, and put back \
- together. */ \
- if (qxestrncasecmp_ascii (lffmutt_pathint, "file://", 7) == 0) \
- { \
- Ibyte *lffmutt_path1, *lffmutt_path2; \
- LOCAL_TO_WIN32_FILE_FORMAT (lffmutt_pathint + 7, lffmutt_path1); \
- if (lffmutt_path1 == lffmutt_pathint + 7) /* Optimization */ \
- lffmutt_path2 = lffmutt_pathint; \
- else \
- { \
+#define LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR(lispstr, pathout) \
+do \
+{ \
+ Ibyte *lffmutt_fname1; \
+ Ibyte *lffmutt_pathint = XSTRING_DATA (lispstr); \
+ \
+ if ((lffmutt_fname1 = qxestrchr (lffmutt_pathint, ':')) != NULL \
+ && *++lffmutt_fname1 == '/' && *++lffmutt_fname1 == '/') \
+ { \
+ /* If URL style file, the innards may have Cygwin mount points and \
+ the like. so separate out the innards, process them, and put back \
+ together. */ \
+ if (qxestrncasecmp_ascii (lffmutt_pathint, "file://", 7) == 0) \
+ { \
+ Ibyte *lffmutt_path1, *lffmutt_path2; \
+ LOCAL_TO_WIN32_FILE_FORMAT (lffmutt_pathint + 7, lffmutt_path1); \
+ if (lffmutt_path1 == lffmutt_pathint + 7) /* Optimization */ \
+ lffmutt_path2 = lffmutt_pathint; \
+ else \
+ { \
lffmutt_path2 = alloca_ibytes (7 + qxestrlen (lffmutt_path1) \
- + 1); \
- qxestrncpy (lffmutt_path2, lffmutt_pathint, 7); \
- qxestrcpy (lffmutt_path2 + 7, lffmutt_path1); \
- } \
- C_STRING_TO_TSTR (lffmutt_path2, pathout); \
- } \
- else \
- /* A straight URL, just convert */ \
- LISP_STRING_TO_TSTR (lispstr, pathout); \
- } \
- else \
- /* Not URL-style, must be a straight filename. */ \
- LOCAL_FILE_FORMAT_TO_TSTR (lispstr, pathout); \
+ + 1); \
+ qxestrncpy (lffmutt_path2, lffmutt_pathint, 7); \
+ qxestrcpy (lffmutt_path2 + 7, lffmutt_path1); \
+ } \
+ C_STRING_TO_TSTR (lffmutt_path2, pathout); \
+ } \
+ else \
+ /* A straight URL, just convert */ \
+ LISP_STRING_TO_TSTR (lispstr, pathout); \
+ } \
+ else \
+ /* Not URL-style, must be a straight filename. */ \
+ LOCAL_FILE_FORMAT_TO_TSTR (lispstr, pathout); \
} while (0)
#else /* not CYGWIN */
＠＠ -1176,6 +1176,7 ＠＠ DECLARE_DOESNT_RETURN (mswindows_report_
Lisp_Object data,
int errnum));
Lisp_Object mswindows_lisp_error (int errnum);
+Ibyte *mswindows_read_link (const Ibyte *fname);
/* in intl-win32.c */
extern Lisp_Object Qmswindows_tstr, Qmswindows_unicode;
Index: src/text.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/text.h,v
retrieving revision 1.27
diff -u -p -r1.27 text.h
--- src/text.h 2005/01/24 23:34:12 1.27
+++ src/text.h 2005/01/28 02:32:02
＠＠ -2391,7 +2391,7 ＠＠ do { \
int eicmp_1 (Eistring *ei, Bytecount off, Charcount charoff,
Bytecount len, Charcount charlen, const Ibyte *data,
- const Eistring *ei2, int is_c, int fold_case);
+ const Eistring *ei2, int is_ascii, int fold_case);
#define eicmp_ei(eistr, eistr2) \
eicmp_1 (eistr, 0, -1, -1, -1, 0, eistr2, 0, 0)
Index: src/win32.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/win32.c,v
retrieving revision 1.24
diff -u -p -r1.24 win32.c
--- src/win32.c 2005/01/24 23:34:13 1.24
+++ src/win32.c 2005/01/28 02:32:02
＠＠ -23,6 +23,8 ＠＠ Software Foundation, Inc., 59 Temple Pla
#include "buffer.h"
#include "console-msw.h"
+#include "hash.h"
+#include "profile.h"
#include "sysfile.h"
#include "sysproc.h"
＠＠ -46,7 +48,10 ＠＠ Info on Windows issues:
nil means no, t means yes. */
Lisp_Object Vmswindows_downcase_file_names;
+struct hash_table *mswindows_read_link_hash;
+
int mswindows_windows9x_p;
+Boolint mswindows_shortcuts_are_symlinks;
pfSwitchToThread_t xSwitchToThread;
＠＠ -341,6 +346,7 ＠＠ otherwise it is an integer representing
if (STRINGP (operation))
LISP_STRING_TO_TSTR (operation, opext);
+ /* #### What about path names, which may be links? */
if (STRINGP (parameters))
LISP_STRING_TO_TSTR (parameters, parmext);
if (STRINGP (current_dir))
＠＠ -403,6 +409,228 ＠＠ No expansion is performed, all conversio
}
#endif
+struct read_link_hash
+{
+ Ibyte *resolved;
+ DWORD ticks;
+};
+
+static Ibyte *
+mswindows_read_link_1 (const Ibyte *fname)
+{
+#ifdef NO_CYGWIN_COM_SUPPORT
+ return NULL;
+#else
+ Ibyte *retval = NULL;
+ Extbyte *fnameext;
+ HANDLE fh;
+ struct read_link_hash *rlh;
+ DWORD ticks;
+
+ /* The call below to resolve a link is rather time-consuming.
+ I tried implementing a simple cache based on creation and write time
+ of the file, but that didn't help enough -- maybe 30% faster but still
+ a lot of time spent here. So just do something cheesy and don't
+ check again if we've recently (< a second) done so. */
+
+ if (!mswindows_read_link_hash)
+ mswindows_read_link_hash = make_string_hash_table (1000);
+ C_STRING_TO_TSTR (fname, fnameext);
+
+ /* See if we can find a cached value. */
+
+ /* The intermediate cast fools gcc into not outputting strict-aliasing
+ complaints */
+ ticks = GetTickCount ();
+ if (!gethash (fname, mswindows_read_link_hash,
+ (const void **) (void *) &rlh))
+ {
+ rlh = xnew_and_zero (struct read_link_hash);
+ puthash (qxestrdup (fname), rlh, mswindows_read_link_hash);
+ }
+ else if (ticks - rlh->ticks < 1000)
+ {
+ return rlh->resolved ? qxestrdup (rlh->resolved) : NULL;
+ }
+
+ rlh->ticks = ticks;
+
+ /* Retrieve creation/write time of link file. */
+
+ /* No access rights required to get info. */
+ if ((fh = qxeCreateFile (fnameext, 0, 0, NULL, OPEN_EXISTING, 0, NULL))
+ == INVALID_HANDLE_VALUE)
+ {
+ CloseHandle (fh);
+ return NULL;
+ }
+
+ CloseHandle (fh);
+
+ /* ####
+
+ Note the following in the docs:
+
+ Note: The IShellLink interface has an ANSI version
+ (IShellLinkA) and a Unicode version (IShellLinkW). The
+ version that will be used depends on whether you compile
+ for ANSI or Unicode. However, Microsoft® Windows 95 and
+ Microsoft® Windows 98 only support IShellLinkA.
+
+ We haven't yet implemented COM support in the
+ Unicode-splitting library. I don't quite understand how
+ COM works yet, but it looks like what's happening is
+ that the ShellLink class implements both the IShellLinkA
+ and IShellLinkW interfaces. To make this work at
+ run-time, we have to do something like this:
+
+ -- define a new interface qxeIShellLink that uses
+ Extbyte * instead of LPSTR or LPWSTR. (not totally
+ necessary since Extbyte * == LPSTR).
+
+ -- define a new class qxeShellLink that implements
+ qxeIShellLink. the methods on this class need to create
+ a shadow ShellLink object to do all the real work, and
+ call the corresponding function from either the
+ IShellLinkA or IShellLinkW interfaces on this object,
+ depending on whether XEUNICODE_P is defined.
+
+ -- with appropriate preprocessor magic, of course, we
+ could make things appear transparent; but we've decided
+ not to do preprocessor magic for the moment.
+ */
+
+ /* #### Not Unicode-split for the moment; we have to do it
+ ourselves. */
+ if (XEUNICODE_P)
+ {
+ IShellLinkW *psl;
+
+ if (CoCreateInstance (
+ XECOMID (CLSID_ShellLink),
+ NULL,
+ CLSCTX_INPROC_SERVER,
+ XECOMID (IID_IShellLinkW),
+ &VOIDP_CAST (psl)) == S_OK)
+ {
+ IPersistFile *ppf;
+
+ if (XECOMCALL2 (psl, QueryInterface,
+ XECOMID (IID_IPersistFile),
+ &VOIDP_CAST (ppf)) == S_OK)
+ {
+ Extbyte *fname_unicode;
+ WIN32_FIND_DATAW wfd;
+ LPWSTR resolved = alloca_array (WCHAR, PATH_MAX_EXTERNAL + 1);
+
+ /* Always Unicode. Not obvious from the
+ IPersistFile documentation, but look under
+ "Shell Link" for example code. */
+ fname_unicode = fnameext;
+
+ if (XECOMCALL2 (ppf, Load,
+ (LPWSTR) fname_unicode,
+ STGM_READ) == S_OK &&
+ /* #### YUCK! Docs read
+
+ cchMaxPath
+
+ Maximum number of bytes to copy to the buffer pointed
+ to by the pszFile parameter.
+
+ But "cch" means "count of characters", not bytes.
+ I'll assume the doc writers messed up and the
+ programmer was correct. Also, this approach is safe
+ even if it's actually the other way around. */
+#if defined (CYGWIN_HEADERS) && W32API_INSTALLED_VER < W32API_VER(2,2)
+ /* Another Cygwin prototype error,
+ fixed in v2.2 of w32api */
+ XECOMCALL4 (psl, GetPath, (LPSTR) resolved,
+ PATH_MAX_EXTERNAL, &wfd, 0)
+#else
+ XECOMCALL4 (psl, GetPath, resolved,
+ PATH_MAX_EXTERNAL, &wfd, 0)
+#endif
+ == S_OK)
+ TSTR_TO_C_STRING_MALLOC (resolved, retval);
+
+ XECOMCALL0 (ppf, Release);
+ }
+
+ XECOMCALL0 (psl, Release);
+ }
+ }
+ else
+ {
+ IShellLinkA *psl;
+
+ if (CoCreateInstance (
+ XECOMID (CLSID_ShellLink),
+ NULL,
+ CLSCTX_INPROC_SERVER,
+ XECOMID (IID_IShellLinkA),
+ &VOIDP_CAST (psl)) == S_OK)
+ {
+ IPersistFile *ppf;
+
+ if (XECOMCALL2 (psl, QueryInterface,
+ XECOMID (IID_IPersistFile),
+ &VOIDP_CAST (ppf)) == S_OK)
+ {
+ Extbyte *fname_unicode;
+ WIN32_FIND_DATAA wfd;
+ LPSTR resolved = alloca_array (CHAR, PATH_MAX_EXTERNAL + 1);
+
+ /* Always Unicode. Not obvious from the
+ IPersistFile documentation, but look under
+ "Shell Link" for example code. */
+ C_STRING_TO_EXTERNAL (fname, fname_unicode,
+ Qmswindows_unicode);
+
+ if (XECOMCALL2 (ppf, Load,
+ (LPWSTR) fname_unicode,
+ STGM_READ) == S_OK
+ && XECOMCALL4 (psl, GetPath, resolved,
+ PATH_MAX_EXTERNAL, &wfd, 0) == S_OK)
+ TSTR_TO_C_STRING_MALLOC (resolved, retval);
+
+ XECOMCALL0 (ppf, Release);
+ }
+
+ XECOMCALL0 (psl, Release);
+ }
+ }
+
+ /* Cache newly found value */
+ if (rlh->resolved)
+ xfree (rlh->resolved, Ibyte *);
+ rlh->resolved = retval ? qxestrdup (retval) : NULL;
+
+ return retval;
+#endif /* NO_CYGWIN_COM_SUPPORT */
+}
+
+/* Resolve a file that may be a shortcut. Accepts either a file ending
+ with .LNK or without the ending. If a shortcut is found, returns
+ a value that you must xfree(); otherwise NULL. */
+
+Ibyte *
+mswindows_read_link (const Ibyte *fname)
+{
+ int len = qxestrlen (fname);
+ if (len > 4 && !qxestrcasecmp_ascii (fname + len - 4, ".LNK"))
+ return mswindows_read_link_1 (fname);
+ else
+ {
+ DECLARE_EISTRING (name2);
+
+ eicpy_rawz (name2, fname);
+ eicat_ascii (name2, ".LNK");
+ return mswindows_read_link_1 (eidata (name2));
+ }
+}
+
+
#if defined (WIN32_NATIVE) || defined (CYGWIN_BROKEN_SIGNALS)
/* setitimer() does not exist on native MS Windows, and appears broken
＠＠ -414,7 +642,6 ＠＠ No expansion is performed, all conversio
mechanism for SIGCHLD. Yuck.)
*/
-
/*--------------------------------------------------------------------*/
/* Signal support */
/*--------------------------------------------------------------------*/
＠＠ -664,11 +891,20 ＠＠ syms_of_win32 (void)
void
vars_of_win32 (void)
{
- DEFVAR_LISP ("mswindows-downcase-file-names", &Vmswindows_downcase_file_names /*
+ DEFVAR_LISP ("mswindows-downcase-file-names",
+ &Vmswindows_downcase_file_names /*
Non-nil means convert all-upper case file names to lower case.
This applies when performing completions and file name expansion.
*/ );
Vmswindows_downcase_file_names = Qnil;
+
+ DEFVAR_BOOL ("mswindows-shortcuts-are-symlinks",
+ &mswindows_shortcuts_are_symlinks /*
+Non-nil means shortcuts (.LNK files) are treated as symbolic links.
+This works also for symlinks created under Cygwin, because they use .LNK
+files to implement symbolic links.
+*/ );
+ mswindows_shortcuts_are_symlinks = 1;
}
void
cvs server: Diffing src/m
cvs server: Diffing src/s
cvs server: Diffing tests
cvs server: Diffing tests/DLL
cvs server: Diffing tests/Dnd
cvs server: Diffing tests/automated
cvs server: Diffing tests/gtk
cvs server: Diffing tests/mule
cvs server: Diffing tests/tooltalk
- 1 participants
- 0 comments
[COMMIT] Some synching of subr.el
20 years, 2 months
Ben Wing
Ben Wing
NOTE: This patch has been committed.
lisp/ChangeLog addition:
2005-01-27 Ben Wing <ben(a)xemacs.org>
* subr.el:
* subr.el (macro-declaration-function): New.
Some synching with FSF 21.2.
smallfix source patch:
Diff command: bash -ci "cvs-diff --show-c-function -no-changelog "
Files affected: lisp/subr.el
Index: lisp/subr.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/subr.el,v
retrieving revision 1.35
diff -u -p -r1.35 subr.el
--- lisp/subr.el 2004/06/17 11:29:39 1.35
+++ lisp/subr.el 2005/01/28 02:04:15
＠＠ -1,12 +1,13 ＠＠
;;; subr.el --- basic lisp subroutines for XEmacs
-;; Copyright (C) 1985, 1986, 1992, 1994-5, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.
;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
;; Copyright (C) 1995 Sun Microsystems.
;; Copyright (C) 2000, 2001, 2002, 2003 Ben Wing.
;; Maintainer: XEmacs Development Team
-;; Keywords: extensions, dumped
+;; Keywords: extensions, dumped, internal
;; This file is part of XEmacs.
＠＠ -48,7 +49,25 ＠＠ Each element of this list holds the argu
(defun custom-declare-variable-early (&rest arguments)
(setq custom-declare-variable-list
(cons arguments custom-declare-variable-list)))
+
+(defun macro-declaration-function (macro decl)
+ "Process a declaration found in a macro definition.
+This is set as the value of the variable `macro-declaration-function'.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The return value of this function is not used."
+ (dolist (d (cdr decl))
+ (cond ((and (consp d) (eq (car d) 'indent))
+ (put macro 'lisp-indent-function (cadr d)))
+ ((and (consp d) (eq (car d) 'debug))
+ (put macro 'edebug-form-spec (cadr d)))
+ (t
+ (message "Unknown declaration %s" d)))))
+
+(setq macro-declaration-function 'macro-declaration-function)
+
+
;;;; Lisp language features.
(defmacro lambda (&rest cdr)
＠＠ -1600,5 +1619,33 ＠＠ FILE should be the name of a library, wi
(make-compatible 'eval-next-after-load "")
;; END SYNC WITH FSF 21.2
+
+;; (defun shell-quote-argument (argument) in process.el.
+
+;; (defun make-syntax-table (&optional oldtable) in syntax.el.
+
+;; (defun syntax-after (pos) #### doesn't exist.
+
+;; global-set-key, local-set-key, global-unset-key, local-unset-key in
+;; keymap.el.
+
+;; frame-configuration-p is in frame.el.
+
+;; functionp is built-in.
+
+;; interactive-form in obsolete.el.
+
+;; assq-del-all in obsolete.el.
+
+;; (defun make-temp-file (prefix &optional dir-flag suffix) #### doesn't exist.
+
+;; add-minor-mode in modeline.el.
+
+;; text-clone stuff #### doesn't exist; should go in text-props.el and
+;; requires changes to extents.c (modification hooks).
+
+;; play-sound is built-in.
+
+;; define-mail-user-agent is in simple.el.
;;; subr.el ends here
- 1 participants
- 0 comments
[COMMIT] Propagate hash changes to gtk-marshal.el
20 years, 2 months
Ben Wing
Ben Wing
NOTE: This patch has been committed.
lisp/ChangeLog addition:
2005-01-27 Ben Wing <ben(a)xemacs.org>
* gtk-marshal.el (find-file):
Propagate hash changes to gtk-marshal.el.
build source patch:
Diff command: bash -ci "cvs-diff --show-c-function -no-changelog "
Files affected: lisp/gtk-marshal.el
Index: lisp/gtk-marshal.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/gtk-marshal.el,v
retrieving revision 1.6
diff -u -p -r1.6 gtk-marshal.el
--- lisp/gtk-marshal.el 2004/05/02 04:06:52 1.6
+++ lisp/gtk-marshal.el 2005/01/28 00:29:10
＠＠ -261,35 +261,6 ＠＠
(insert "\n
#include \"hash.h\"
-static int
-our_string_eq (const void *st1, const void *st2)
-{
- if (!st1)
- return st2 ? 0 : 1;
- else if (!st2)
- return 0;
- else
- return !strcmp ( (const char *) st1, (const char *) st2);
-}
-
-static unsigned long
-our_string_hash (const void *xv)
-{
- unsigned int h = 0;
- unsigned const char *x = (unsigned const char *) xv;
-
- if (!x) return 0;
-
- while (*x)
- {
- unsigned int g;
- h = (h << 4) + *x++;
- if ((g = h & 0xf0000000) != 0)
- h = (h ^ (g >> 24)) ^ g;
- }
-
- return h;
-}
static struct hash_table *marshaller_hashtable;
＠＠ -297,7 +268,7 ＠＠ static void initialize_marshaller_storag
{
if (!marshaller_hashtable)
{
- marshaller_hashtable = make_general_hash_table (100, our_string_hash, our_string_eq);
+ marshaller_hashtable = make_string_hash_table (100);
")
(mapc (lambda (x)
- 1 participants
- 0 comments