/[emacs]/emacs/src/mac.c
ViewVC logotype

Diff of /emacs/src/mac.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.38 by lute, Mon Jul 4 16:06:33 2005 UTC revision 1.39 by tamm, Sun Jul 10 18:17:18 2005 UTC
# Line 3394  void terminate_applescript() Line 3394  void terminate_applescript()
3394    CloseComponent (as_scripting_component);    CloseComponent (as_scripting_component);
3395  }  }
3396    
3397    /* Convert a lisp string or integer to the 4 byte character code
3398     */
3399    
3400    OSType mac_get_code_from_arg(Lisp_Object arg, OSType defCode)
3401    {
3402      OSType result;
3403      if (NILP(arg))
3404        {
3405          result = defCode;
3406        }
3407      else if (INTEGERP(arg))
3408        {
3409          result = XFASTINT(arg);
3410        }
3411      else
3412        {
3413          /* check type string */
3414          CHECK_STRING(arg);
3415          if (strlen(SDATA(arg)) != 4)
3416            {
3417              error ("Wrong argument: need string of length 4 for code");
3418            }
3419          /* Should work cross-endian */
3420          result = SDATA(arg)[3] + (SDATA(arg)[2] << 8) +
3421            (SDATA(arg)[1] << 16) + (SDATA(arg)[0] << 24);
3422        }
3423      return result;
3424    }
3425    
3426    /**
3427       Convert the 4 byte character code into a 4 byte string
3428     */
3429    Lisp_Object mac_get_object_from_code(OSType defCode)
3430    {
3431      if (defCode == 0) {
3432        return make_specified_string("", -1, 0, 0);
3433      } else {
3434        /* Should work cross-endian */
3435        char code[4];
3436        code[0] = defCode >> 24 & 0xff;
3437        code[1] = defCode >> 16 & 0xff;
3438        code[2] = defCode >> 8 & 0xff;
3439        code[3] = defCode & 0xff;
3440        return make_specified_string(code, -1, 4, 0);
3441      }
3442    }
3443    
3444    
3445    DEFUN ("mac-get-file-creator", Fmac_get_file_creator, Smac_get_file_creator, 1, 1, 0,
3446           doc: /* Get the creator code of FILENAME as a four character string. */)
3447      (Lisp_Object filename)
3448    {
3449      OSErr status;
3450      FSRef defLoc;
3451      OSType cCode;
3452      Lisp_Object result = Qnil;
3453      CHECK_STRING (filename);
3454    
3455      if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
3456        return Qnil;
3457      }
3458      filename = Fexpand_file_name (filename, Qnil);
3459    
3460      BLOCK_INPUT;
3461      status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &defLoc, NULL);
3462    
3463      if (status == noErr)
3464        {
3465          FSCatalogInfo catalogInfo;
3466          FSRef parentDir;
3467          status = FSGetCatalogInfo(&defLoc, kFSCatInfoNodeFlags + kFSCatInfoFinderInfo,
3468                                    &catalogInfo, NULL, NULL, &parentDir);
3469          if (status == noErr)
3470            {
3471              result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileCreator);
3472            }
3473        }
3474      UNBLOCK_INPUT;
3475      if (status != noErr) {
3476        error ("Error while getting file information.");
3477      }
3478      return result;
3479    }
3480    
3481    DEFUN ("mac-get-file-type", Fmac_get_file_type, Smac_get_file_type, 1, 1, 0,
3482           doc: /* Get the type code of FILENAME as a four character string. */)
3483      (Lisp_Object filename)
3484    {
3485      OSErr status;
3486      FSRef defLoc;
3487      OSType cCode;
3488      Lisp_Object result = Qnil;
3489      CHECK_STRING (filename);
3490    
3491      if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
3492        return Qnil;
3493      }
3494      filename = Fexpand_file_name (filename, Qnil);
3495    
3496      BLOCK_INPUT;
3497      status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &defLoc, NULL);
3498    
3499      if (status == noErr)
3500        {
3501          FSCatalogInfo catalogInfo;
3502          FSRef parentDir;
3503          status = FSGetCatalogInfo(&defLoc, kFSCatInfoNodeFlags + kFSCatInfoFinderInfo,
3504                                    &catalogInfo, NULL, NULL, &parentDir);
3505          if (status == noErr)
3506            {
3507              result = mac_get_object_from_code(((FileInfo*)&catalogInfo.finderInfo)->fileType);
3508            }
3509        }
3510      UNBLOCK_INPUT;
3511      if (status != noErr) {
3512        error ("Error while getting file information.");
3513      }
3514      return result;
3515    }
3516    
3517    DEFUN ("mac-set-file-creator", Fmac_set_file_creator, Smac_set_file_creator, 1, 2, 0,
3518           doc: /* Set creator code of file FILENAME to CODE.
3519    If non-nil, CODE must be a 32-bit integer or a 4-character string. Otherwise,
3520    'EMAx' is assumed. Return non-nil if successful.
3521       */)
3522      (Lisp_Object filename, Lisp_Object code)
3523    {
3524      OSErr status;
3525      FSRef defLoc;
3526      OSType cCode;
3527      CHECK_STRING (filename);
3528    
3529      cCode = mac_get_code_from_arg(code, 'EMAx');
3530    
3531      if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
3532        return Qnil;
3533      }
3534      filename = Fexpand_file_name (filename, Qnil);
3535    
3536      BLOCK_INPUT;
3537      status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &defLoc, NULL);
3538    
3539      if (status == noErr)
3540        {
3541          FSCatalogInfo catalogInfo;
3542          FSRef parentDir;
3543          status = FSGetCatalogInfo(&defLoc, kFSCatInfoNodeFlags + kFSCatInfoFinderInfo,
3544                                    &catalogInfo, NULL, NULL, &parentDir);
3545          if (status == noErr)
3546            {
3547            ((FileInfo*)&catalogInfo.finderInfo)->fileCreator = cCode;
3548            status = FSSetCatalogInfo(&defLoc, kFSCatInfoFinderInfo, &catalogInfo);
3549            /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
3550            }
3551        }
3552      UNBLOCK_INPUT;
3553      if (status != noErr) {
3554        error ("Error while setting creator information.");
3555      }
3556      return Qt;
3557    }
3558    
3559    DEFUN ("mac-set-file-type", Fmac_set_file_type, Smac_set_file_type, 2, 2, 0,
3560           doc: /* Set file code of file FILENAME to CODE.
3561    CODE must be a 32-bit integer or a 4-character string. Return non-nil if successful.
3562       */)
3563      (filename, code)
3564         Lisp_Object filename;
3565         Lisp_Object code;
3566    {
3567      OSErr status;
3568      FSRef defLoc;
3569      OSType cCode;
3570      CHECK_STRING (filename);
3571    
3572      cCode = mac_get_code_from_arg(code, 0); /* Default to empty code*/
3573    
3574      if (NILP(Ffile_exists_p(filename)) || !NILP(Ffile_directory_p(filename))) {
3575        return Qnil;
3576      }
3577      filename = Fexpand_file_name (filename, Qnil);
3578    
3579      BLOCK_INPUT;
3580      status = FSPathMakeRef(SDATA(ENCODE_FILE(filename)), &defLoc, NULL);
3581    
3582      if (status == noErr)
3583        {
3584          FSCatalogInfo catalogInfo;
3585          FSRef parentDir;
3586          status = FSGetCatalogInfo(&defLoc, kFSCatInfoNodeFlags + kFSCatInfoFinderInfo,
3587                                    &catalogInfo, NULL, NULL, &parentDir);
3588          if (status == noErr)
3589            {
3590            ((FileInfo*)&catalogInfo.finderInfo)->fileType = cCode;
3591            status = FSSetCatalogInfo(&defLoc, kFSCatInfoFinderInfo, &catalogInfo);
3592            /* TODO: on Mac OS 10.2, we need to touch the parent dir, FNNotify? */
3593            }
3594        }
3595      UNBLOCK_INPUT;
3596      if (status != noErr) {
3597        error ("Error while setting creator information.");
3598      }
3599      return Qt;
3600    }
3601    
3602    
3603  /* Compile and execute the AppleScript SCRIPT and return the error  /* Compile and execute the AppleScript SCRIPT and return the error
3604     status as function value.  A zero is returned if compilation and     status as function value.  A zero is returned if compilation and
# Line 4361  syms_of_mac () Line 4566  syms_of_mac ()
4566  #endif  #endif
4567    defsubr (&Smac_clear_font_name_table);    defsubr (&Smac_clear_font_name_table);
4568    
4569      defsubr (&Smac_set_file_creator);
4570      defsubr (&Smac_set_file_type);
4571      defsubr (&Smac_get_file_creator);
4572      defsubr (&Smac_get_file_type);
4573    defsubr (&Sdo_applescript);    defsubr (&Sdo_applescript);
4574    defsubr (&Smac_file_name_to_posix);    defsubr (&Smac_file_name_to_posix);
4575    defsubr (&Sposix_file_name_to_mac);    defsubr (&Sposix_file_name_to_mac);

Legend:
Removed from v.1.38  
changed lines
  Added in v.1.39

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26