[ltk-user] Bug in choose-directory, get-open-file, get-save-file

[David Holz]

The parameter given to initialdir is surrounded in braces {~a}.  On the 
windows platform, the directory will usually end in a backslash, such as 
{c:\whatever\} which acts to escape out the close brace.  Putting a space 
after the ~a seems to fix this.  Here are my new definitions for those 
functions, which also flesh out the parameters for get-save-file; I'm not 
including a diff because I have a number of other changes in there as well.


(defun get-open-file (&key (filetypes '(("All Files" "*")))
			   (initialdir (namestring *default-pathname-defaults*))
			   multiple parent title initialfile)
  (let ((files
        (with-output-to-string (s)
          (format s "{")
          (dolist (type filetypes)
            (let ((name (first type))
                  (wildcard (second type)))
              (format s "{{~a} {~a}} " name wildcard)))
          (format s "}"))))
    (format-wish "senddatastrings [tk_getOpenFile ~
                  -filetypes ~a ~@[ -initialdir {~a }~] -multiple ~a ~
                  ~@[ -parent ~a~] ~@[ -title {~a}~] ~@[ -initialfile {~a 
}~]]"
		 files initialdir
		 (if multiple 1 0)
		 (and parent (widget-path parent))
		 title initialfile)
    (read-data)))

(defun get-save-file (&key (filetypes '(("All Files" "*")))
			   (initialdir (namestring *default-pathname-defaults*))
			   parent title initialfile)
  (let ((files
        (with-output-to-string (s)
          (format s "{")
          (dolist (type filetypes)
            (let ((name (first type))
                  (wildcard (second type)))
              (format s "{{~a} {~a}} " name wildcard)))
          (format s "}"))))
    (format-wish "senddatastring [tk_getSaveFile ~
                  -filetypes ~a ~@[ -initialdir {~a }~] ~
                  ~@[ -parent ~a~] ~@[ -title {~a}~] ~@[ -initialfile {~a 
}~]]"
		 files initialdir
		 (and parent (widget-path parent))
		 title initialfile)
    (read-data)))

(defun choose-directory (&key (initialdir (namestring 
*default-pathname-defaults*))
			      parent title mustexist)
  (format-wish "senddatastring [tk_chooseDirectory ~@[ -initialdir {~a 
}~]~@[ -parent ~a~]~@[ -title {~a}~]~@[ -mustexist ~a~]]" initialdir (and 
parent (widget-path parent)) title (and mustexist 1))
  (read-data))

_________________________________________________________________
Find sales, coupons, and free shipping, all in one place!  MSN Shopping 
Sales & Deals 
http://shopping.msn.com/content/shp/?ctid=198,ptnrid=176,ptnrdata=200639