Mxml/commands.lisp

   1 (in-package :gsharp)
   2
   3 ;;; like print-buffer-filename in gui.lisp
   4 (defun export-buffer-filename ()
   5   (let* ((buffer (current-buffer))
   6          (filepath (filepath buffer))
   7          (name (name buffer))
   8          (defaults (or filepath (merge-pathnames (make-pathname :name name)
   9                                                  (user-homedir-pathname)))))
  10     (merge-pathnames (make-pathname :type "xml") defaults)))
  11
  12 ;;; like directory-of-current-buffer in esa-io.lisp
  13 (defun directory-of-current-buffer ()
  14   "Extract the directory part of the filepath to the file in the current buffer.
  15    If the current buffer does not have a filepath, the path to
  16    the user's home directory will be returned."
  17   (make-pathname
  18    :directory
  19    (pathname-directory
  20     (or (filepath (current-buffer))
  21         (user-homedir-pathname)))))
  22
  23 (define-gsharp-command (com-import-musicxml :name t)
  24     ((pathname 'pathname
  25                :prompt "Import From: " :prompt-mode :raw
  26                :default (directory-of-current-buffer) :default-type 'pathname
  27                :insert-default t))
  28   (let* ((buffer (gsharp-mxml::parse-mxml (gsharp-mxml::musicxml-document pathname)))
  29          (input-state (make-input-state))
  30          (cursor (make-initial-cursor buffer))
  31          (view (make-instance 'orchestra-view :buffer buffer :cursor cursor)))
  32     (setf (view (car (windows *application-frame*))) view
  33           (filepath buffer) (merge-pathnames (make-pathname :type "gsh") pathname)
  34           (name buffer) (file-namestring (filepath buffer))
  35           (input-state *application-frame*) input-state)
  36     (select-layer cursor (car (layers (segment (current-cursor)))))))
  37
  38 (define-gsharp-command (com-export-musicxml :name t)
  39     ((pathname 'pathname
  40                :prompt "Export To: " :prompt-mode :raw
  41                :default (export-buffer-filename) :default-type 'pathname
  42                :insert-default t))
  43   (let ((string (gsharp-mxml::write-mxml (current-buffer))))
  44     (with-open-file (s pathname :if-does-not-exist :create :if-exists :supersede :direction :output)
  45       (write-string string s))))