[Openmcl-devel] file-type

[Gary Byers]

I agree with Hamilton that OpenMCL's file system code should stick to
the straight and narrow (e.g., the Darwin layer) and remain pretty
much ignorant of HFS file types & creator codes.

Without getting into the issue of whether or not HFS types and creators
were or are good ideas, I think that there's room (somewhere) for
MacOSX-specific functions to access that information (if only to
"improve interoperability with legacy applications".)  I think for
instance that the Cocoa editor might want to offer an option to
set HFS type&creator codes when saving a file (in much the same way
and for much the same reason that I think that it should offer control
over line termination.)

My understanding is that Apple revived some support for HFS file
information in OSX 10.1 that had been missing in 10.0.  I don't know
whether this was a long-term commitment to supporting that feature
or a recognition that developers still needed to deal with transition
issues.  I don't -think- that Apple encourages the use of HFS-specific
filesystem features in new code.

I was going to try to do this in Carbon, but what better way to expose
people to (more) Cocoa programming ?  (Besides, there's a bug in the
interface translator that affects the Carbon interfaces more than it
does the Cocoa interfaces.)

I'd be surprised if this was industrial strength, but it seems to work
in simple cases.  As of version 0.12.1, OpenMCL doesn't keep track of
shared libraries across SAVE-APPLICATION under MacOSX, so this code
won't work in a saved image.

On Thu, 25 Jul 2002, Hamilton Link wrote:

> PATHNAME-TYPE should work to get the filename extension. MAC-FILE-TYPE
> is no longer supported, since it doesn't mean much under linuxppc iirc.
> hamilton
>
> Augusto wrote:
> >
> > Hi,
> >
> > I start with openmcl and it is really great
> >
> > I have some little problems :
> >
> > -The function directoryp does work fine
> >
> > -I dont find a function to get the type of a file from a pathname (like
> > mac-file-type )
> >
> > can somebody help me
> >
> > thanks
> >
> > Carlos Agon
> >
> > _______________________________________________
> > Openmcl-devel mailing list
> > Openmcl-devel at clozure.com
> > http://clozure.com/cgi-bin/mailman/listinfo/openmcl-devel
>
>
> _______________________________________________
> Openmcl-devel mailing list
> Openmcl-devel at clozure.com
> http://clozure.com/cgi-bin/mailman/listinfo/openmcl-devel
>
>
-------------- next part --------------
(in-package "CCL")

(eval-when (:compile-toplevel :execute)
  (use-interface-dir :cocoa))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "APPLE-OBJC"))

(eval-when (:compile-toplevel :execute)
  (setq *readtable* *objc-readtable*))


(defun %integer->ostype (integer)
  (%stack-block ((buf 4))
    (setf (%get-unsigned-long buf) integer)
    (%get-ostype buf)))

(defun %mac-type-and-creator (path new-type new-creator)
  (let* ((namestring (native-translated-namestring (pathname path))))  
    (with-cstrs ((cstr namestring))
      (with-nsstr (nsstr cstr (length namestring))
	(let* ((pool [[(@class "NSAutoreleasePool") "alloc"] "init"])
	       (type 0)
	       (creator 0))
	  (without-interrupts
	   (unwind-protect
		(let* ((fm [(@class "NSFileManager") "defaultManager"])
		       (dict [fm "fileAttributesAtPath:traverseLink:"
				 :id nsstr :<BOOL> #$YES :id]))
		  (if (%null-ptr-p dict)
		    (error "Can't get file information for ~s" path)
		    (let* ((typenum [dict "objectForKey:"
					 :id #@"NSFileHFSTypeCode"])
			  (creatornum [dict "objectForKey:"
					    :id #@"NSFileHFSCreatorCode"]))
		     (unless (%null-ptr-p typenum)
		       (setq type
			     [typenum "unsignedLongValue" :unsigned-fullword]))
		     (unless (%null-ptr-p creatornum)
		       (setq creator
			     [creatornum "unsignedLongValue" :unsigned-fullword]))
		     (when (or new-type new-creator)
		       (when new-type
			 (setq dict
			       (copy-dictionary
				dict
				#@"NSFileHFSTypeCode"
				[(@class "NSNumber")
				 "numberWithUnsignedLong:"
				 :unsigned-fullword new-type])))
		       (when new-creator
			 (setq dict
			       (copy-dictionary
				dict
				#@"NSFileHFSCreatorCode"
				[(@class "NSNumber")
				 "numberWithUnsignedLong:"
				 :unsigned-fullword new-creator])))
		       [fm "changeFileAttributes:atPath:"
			   :id dict :id nsstr :<BOOL>])
		     (values (%integer->ostype (or new-type type))
			     (%integer->ostype (or new-creator creator))))))
	     [pool "release"])))))))

(defun mac-file-type (path)
  (nth-value 0 (%mac-type-and-creator path nil nil)))

(defun mac-file-creator (path)
  (nth-value 1 (%mac-type-and-creator path nil nil)))

(defun set-mac-file-type (path new-type)
  (nth-value 0 (%mac-type-and-creator path new-type nil)))

(defun set-mac-file-creator (path new-creator)
  (nth-value 1 (%mac-type-and-creator path nil new-creator)))