home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Text / Emacs-1.12d folder / lisp / mac / core-suite.el < prev    next >
Encoding:
Text File  |  1993-12-30  |  4.1 KB  |  120 lines  |  [TEXT/EMAC]
  1. ;;;
  2. ;;; This file is part of a Macintosh port of GNU Emacs.
  3. ;;; Copyright (C) 1993 Marc Parmet.  All rights reserved.
  4. ;;;
  5. ;;; This is the implementation of the Apple event required suite.
  6. ;;;
  7. ;;; This file cannot be included in a dump.  The AEInstallEventHandler calls
  8. ;;; must be executed on each invokation.
  9. ;;;
  10.  
  11. (AEInstallEventHandler kCoreEventClass kAEOpenApplication 'do-ae-open-appl 0 0)
  12.  
  13. (defun do-ae-open-appl (event reply refCon)
  14.   noErr)
  15.  
  16. (AEInstallEventHandler kCoreEventClass kAEOpenDocuments 'do-ae-open-docs 0 0)
  17.  
  18. (defun do-ae-open-docs (event reply refCon)
  19.   (let* ((docList (make-string sizeof-AEDesc 0))
  20.          have-docList
  21.          (itemsInList (make-string 4 0))
  22.          (result
  23.           (catch 'bailout
  24.             (catch-err (AEGetParamDesc event keyDirectObject typeAEList docList))
  25.             (setq have-docList t)
  26.             ;;; We get an error from this next line if Think C sends a position record.
  27.             ;(catch-err (ae-have-required-parameters event))
  28.             (catch-err (AECountItems docList itemsInList))
  29.             (setq itemsInList (ae-extract typeLongInteger itemsInList 0))
  30.             (catch-err (ae-open-list-items docList 1 itemsInList event))
  31.             noErr)))
  32.     (if have-docList (AEDisposeDesc docList))
  33.     result))
  34.  
  35. (defun ae-is-stationery (spec)
  36.   (let* ((info (make-string sizeof-FInfo 0))
  37.          (err (FSpGetFInfo spec info)))
  38.     (if (zerop err)
  39.         (let ((flags (extract-internal info 8 2 nil)))
  40.           (not (zerop (logand 2048 flags))))
  41.       nil)))
  42.  
  43. (defun ae-open-list-items (docList i itemsInList event)
  44.   (if (> i itemsInList)
  45.       noErr
  46.     (let* ((keywd (make-string 4 0))
  47.            (returnedType (make-string 4 0))
  48.            (spec (make-string sizeof-FSSpec 0))
  49.            (actualSize (make-string 4 0))
  50.            (err (AEGetNthPtr docList i typeFSS keywd returnedType spec
  51.                              sizeof-FSSpec actualSize)))
  52.       (if (not (zerop err))
  53.           err
  54.         (let ((filename (FSSpec-to-unix-filename spec)))
  55.           (if (ae-is-stationery spec)
  56.               (let ((old-buffer (current-buffer))
  57.                     (new-buffer (generate-new-buffer "untitled")))
  58.                 (set-buffer new-buffer)
  59.                 (insert-file-contents filename)
  60.                 (if (eq (selected-window) (minibuffer-window))
  61.                     (set-buffer old-buffer)
  62.                   (switch-to-buffer new-buffer)))
  63.             (if (eq (selected-window) (minibuffer-window))
  64.                 (progn
  65.                   (find-file-other-window filename)
  66.                   ;;; find-file-other-window will select the new window, probably
  67.                   ;;; not a good idea.  If we use save-excursion, the
  68.                   ;;; newly created buffer will not be displayed immediately, also
  69.                   ;;; not a good idea.  So we do this.
  70.                   (select-window (minibuffer-window)))
  71.               (find-file filename)))
  72.           (if (fboundp 'tc:parse-position-record)
  73.               (tc:parse-position-record event)))))
  74.     (ae-open-list-items docList (1+ i) itemsInList event)))
  75.  
  76. (AEInstallEventHandler kCoreEventClass kAEPrintDocuments 'do-ae-print-docs 0 0)
  77.  
  78. (defun do-ae-print-docs (event reply refCon)
  79.   (let* ((docList (make-string sizeof-AEDesc 0))
  80.          have-docList
  81.          (itemsInList (make-string 4 0))
  82.          err
  83.          (result
  84.           (catch 'bailout
  85.             (catch-err (AEGetParamDesc event keyDirectObject typeAEList docList))
  86.             (setq have-docList t)
  87.             (catch-err (ae-have-required-parameters event))
  88.             (catch-err (AECountItems docList itemsInList))
  89.             (setq itemsInList (ae-extract typeLongInteger itemsInList 0))
  90.             (catch-err (ae-print-list-items docList 1 itemsInList))
  91.             noErr)))
  92.     (if have-docList (AEDisposeDesc docList))
  93.     result))
  94.  
  95. (defun ae-print-list-items (docList i itemsInList)
  96.    (if (> i itemsInList)
  97.        noErr
  98.     (let* ((keywd (make-string 4 0))
  99.            (returnedType (make-string 4 0))
  100.            (spec (make-string sizeof-FSSpec 0))
  101.            (actualSize (make-string 4 0))
  102.            (err (AEGetNthPtr docList i typeFSS keywd returnedType spec
  103.                              sizeof-FSSpec actualSize)))
  104.       (if (not (zerop err))
  105.           err
  106.         (let ((filename (FSSpec-to-unix-filename spec)))
  107.           (call-process "lpr" nil 0 nil filename))
  108.         (ae-print-list-items docList (1+ i) itemsInList)))))
  109.  
  110. (AEInstallEventHandler kCoreEventClass kAEQuitApplication 'do-ae-quit-appl 0 0)
  111.  
  112. (defun do-ae-quit-appl (event reply refCon)
  113.   ;;; This will save changed buffers as new files with hash marks around the name.
  114.   ;;; A more interactive function would not be right here.
  115.   (let ((err (ae-have-required-parameters event)))
  116.     (if (not (zerop err))
  117.         err
  118.       (kill-emacs)
  119.       noErr)))
  120.