User Interaction Suite

At the bottom of this post is a collection of Scheme wrappers for selected handlers from User Interaction Suite of StandardAdditions OSAX[1].

Contents of User Interaction Suite
beep v : Beep 1 or more times
choose application v : Choose an application on this machine or the network
choose color v : Choose a color
choose file v : Choose a file on a disk or server
choose file name v : Get a new file reference from the user, without creating the file
choose folder v : Choose a folder on a disk or server
choose from list v : Choose one or more items from a list
choose remote application v: Choose a running application on a remote machine or on this machine
choose URL v : Choose a service on the Internet
delay v : Pause for a fixed amount of time
display alert v : Display an alert
display dialog v : Display a dialog box, optionally requesting user input
say v : Speak the given text

Usage

The wrappers isolate Scheme user from the details of bridging between Scheme and Applescript. The user just sees Scheme expressions like this:

  
    (display-dialog "Your name?" "Peter brown" '("Cancel" "OK") "OK" 12)

which - when executed in Scheme-OSA environment - produces a dialog panel asking for a user name. It is provided with default answer "Peter Brown", two buttons: "Cancel" and "OK", default button "OK" and a timeout of 12 seconds.

The dialog returns the answer in the form of associative list (a simulated record, before real Scheme records become standard), such as:

 
    ((bhit "OK") (ttxt "John Brown") (gavu #f))

which means a button returned: (bhit "OK"), a text returned: (ttxt "John Brown") and boolean indicating whether or not the dialog gave up waiting for user response: (gavu #f).

The symbols 'bhit, 'ttxt and 'gavu have been directly translated from Applescript; I have made no attempt to make them more user friendly. Fortunately, there are not that many such criptic names. Apple insists on four-character abbreviations for public symbols, but anything that you make for your own use stays non-abbreviated. Hence, your private records, such as

    '((age 19) (factors '(3 5 7)) (speed 120))

will preserve its readability when crossing the border between Scheme and Applescript.

Under the hood

Underneath this presentation layer are translation services: from Scheme to Applescript and back to Scheme.

Firstly, a Scheme expression, such as this one:

 
    (display-dialog "Your name?" "Peter Brown" '("Cancel" "OK") "OK" 12)

is send to Scheme interpreter for evaluation. The interpreter converts it to the following Applescript command

  
display dialog "Your name?" default answer "Peter Brown" ¬
    buttons {"Cancel", "OK"} default button "OK" giving up after 12

then wraps it into string "(osa )", prints it out to standard output and enters into port reading mode - waiting for an answer from the Applescript. After reception of the osa-string the bridge recognizes the header "(osa " as a signal not to print it out but to submit the tail of such string for compilation and execution as an Applescript command. Consequently, the dialog is displayed, data collected from the user and the response is prepared in the form of a record with several properties, as in:

  
    {bhit: "OK", ttxt: "John Green", gavu: false}.

The bridge intercepts it, translates it back to Scheme as a alist:

  
    ((bhit "OK") (ttxt "John Green") (gavu #f)) 

and returns it to Scheme interpreter which was waiting for such answer.The results are then used for further computations, or just sent back to the bridge for display.


References

[1] Full documentation of StandardAdditions is provided in its dictionary of definitions. The dictionary is conveniently browsable using dictionary browser, which can be opened on StandardAdditions either by double clicking on /System/Library/ScriptingAdditions/StandardAdditions.osax or by invoking Script Editor application, opening a list of scriptable applications and additions from its menu File -> Open Dictionary ... and finally selecting the Standard Additions from that list.

[2] 'AppleScript Scripting Additions Guide: English Dialect', a document from Apple Computers


Scheme wrappers

;; procedure: (display-dialog title answer button-list default-button timeout)
;; return: aList
;; display-dialog:: String -> String-> List of String -> String -> Integer-> Alist
;;
;; Display a titled dialog window with title, default answer, at most three buttons,
;; one of which is declared a default and a timeout. Return a record with three
;; properties:
;; ((bhit name-of-a-button-pressed)
;; (ttxt string-from-the-text-field) 
;; (gavu true-if-dialog-gaved-up-due-to-timeout))
;;
;; Example:
;; (display-dialog "Your name?" "Peter Brown" '("Cancel" "OK") "OK" 0)
;; ==> ((bhit "OK") (ttxt "Juan de Silva") (gavu #f))
(define (display-dialog text 
   default-answer buttons default-button timeout) 
   (define str (make-osa-string
      (list 'display 'dialog text 
      'default 'answer default-answer 
      'buttons buttons 
      'default 'button default-button 
      'giving 'up 'after timeout)))
   (cond
      ((not (member default-button buttons)) 
         (error 'display-dialog 
      "Default button should belong to provided list of buttons"))
      (else (osa str))))


;; procedure: (display-message text buttons)
;; Produce a message with several buttons
;; (display-message "Do you want to proceed?" '("No" "Yes"))
(define (display-message text buttons) 
   (define str (make-osa-string
      (list 'display 'dialog text  
      'buttons buttons 
      )))
   (osa str))


;; procedure: (display-alert text)
;; Display an alert
;; Return: ((bhit "OK"))
;; Example:
;; (display-alert "Beware of dog!")
(define (display-alert text)
   (osa (make-osa-string (list 'display 'alert text))))

  
;; procedure: (ask-for-number title default)
;; Ask for a number, providing dialog title and default numerical value
;; Return a number
;; Example:
;; (* (ask-for-number "first number" 10) (ask-for-number "second number" 20))
;; ==> 200
(define (ask-for-number title default)
   (string->number
      (cadr (assq 'ttxt
         (display-dialog 
            title
            (number->string default)
            '("OK") "OK" 0)))))


;; procedure: (choose-from-list aList prompt) 
;; Choose one or more items from a list
;; Example:
;; (choose-from-list '("Eva" "Bob" "John") "Select a winner")
(define (choose-from-list aList prompt)
   (osa  (make-osa-string (list 
   'choose 'from 'list aList 
   'with 'prompt prompt 
   'with 'multiple 'selections 'allowed))))


;; procedure: (choose-files directory-path)
;; Choose one or more files (but not directories) from a specified directory path.
;; Return list of paths.
;; Example:
;; (choose-files "/Users/jans")
(define (choose-files directory-path)
   (define handler (string->symbol (string-append
   "on choose_files from directory\r"
   "   set dirAlias to POSIX file directory\r"
   "   set xs to choose file default location alias dirAlias"; no line break!
   "      with multiple selections allowed\r"
   "   set ys to {}\r"
   "   repeat with x in xs\r"
   "      set ys to ys & (POSIX path of x)\r"
   "   end repeat\r"
   "   return ys\r"
   "end choose_files\r"))) 
   (osa (make-osa-string 
      (list handler 'choose_files 'from directory-path))))


;; procedure: (choose-folders root-folder)
;; Choose one or more folders from a specified root-folder
;; Return a list of folders.
;; (choose-folders "/Users/jans")
(define (choose-folders root-folder)
   (define handler (string->symbol (string-append
   "on choose_folders from root_folder\r"
   "   set dirAlias to POSIX file root_folder\r"
   "   set xs to choose folder default location alias dirAlias"; no line break!
   "      with multiple selections allowed\r"
   "   set ys to {}\r"
   "   repeat with x in xs\r"
   "      set ys to ys & (POSIX path of x)\r"
   "   end repeat\r"
   "   return ys\r"
   "end choose_folders\r")))
   (osa (make-osa-string
      (list handler 'choose_folders 'from root-folder))))


;; procedure: (choose-color default-rgb-list)
;; Choose a color from the color chooser
;; Example:
;; (choose-color '(0 65535 0))
(define (choose-color default-rgb-list)
   (osa (make-osa-string (list
      'choose 'color 'default 'color default-rgb-list))))


;; procedure: (beep n)
;; Beep 1 or more times
;; Return: undefined
(define (beep n)
   (define str (make-osa-string (list 'beep n)))
   (osa str))

   
;; procedure: (say text)
;; Speak the given text
;; Return: undefined
(define (say text)
   (osa (make-osa-string (list 'say text))))



;; procedure: (play-standard-sound sound-name volume)
;;
;; Play a named sound at some volume level (0-7)
;; Avaulable sounds are taken (from /System/Library/Sounds/):
;; "Basso", "Blow", "Bottle", "Frog", "Funk", "Glass", "Hero", "Morse", "Ping", 
;; "Pop", "Purr", "Sosumi", "Submarine", "Tink"
;;
;; Example:
;; (play-standard-sound "Frog" 7)
(define (play-standard-sound sound-name volume)
   (define handler (string->symbol (string-append
   "on play_standard_sound for soundName at someVolume\r"
   "   try\r"
   "      tell application \"Scheme-OSA\"\r"
   "         set volume someVolume\r"
   "         set theSound to load sound soundName\r"
   "         play theSound\r"
   "         delete theSound\r"
   "      end tell\r"
   "   on error msg number n\r"
   "       error soundName & \" is not a standard sound\" number n\r"
   "   end try\r"
   "end play_standard_sound\r")))
   (osa (make-osa-string
      (list handler 'play_standard_sound 'for sound-name 'at volume))))