3 ;;; like print-buffer-filename in gui.lisp
4 (defun export-buffer-filename ()
5 (let* ((buffer (current-buffer))
6 (filepath (filepath buffer
))
8 (defaults (or filepath
(merge-pathnames (make-pathname :name name
)
9 (user-homedir-pathname)))))
10 (merge-pathnames (make-pathname :type
"xml") defaults
)))
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."
20 (or (filepath (current-buffer))
21 (user-homedir-pathname)))))
23 (define-gsharp-command (com-import-musicxml :name t
)
25 :prompt
"Import From: " :prompt-mode
:raw
26 :default
(directory-of-current-buffer) :default-type
'pathname
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)))))))
38 (define-gsharp-command (com-export-musicxml :name t
)
40 :prompt
"Export To: " :prompt-mode
:raw
41 :default
(export-buffer-filename) :default-type
'pathname
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
))))