Update of /project/gsharp/cvsroot/gsharp In directory common-lisp:/tmp/cvs-serv29109

Modified Files: gui.lisp modes.lisp Log Message: Cleaned up some dead code.

--- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/15 02:54:26 1.54 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/15 03:18:03 1.55 @@ -198,9 +198,9 @@ (make-command-table 'file-command-table :errorp nil - :menu '(("Load" :command com-load-file) + :menu '(("Find" :command com-find-file) ("Save" :command com-save-buffer) - ("Save as" :command com-save-buffer-as) + ("Save as" :command com-write-buffer) ("Quit" :command com-quit)))

(define-gsharp-command (com-new-buffer :name t) () @@ -216,101 +216,6 @@ (setf (input-state *application-frame*) input-state (staves (car (layers (car (segments buffer))))) (list staff))))

-(define-presentation-type completable-pathname () - :inherit-from 'pathname) - -(define-condition file-not-found (gsharp-condition) () - (:report - (lambda (condition stream) - (declare (ignore condition)) - (format stream "File nont found")))) - -(defun filename-completer (so-far mode) - (flet ((remove-trail (s) - (subseq s 0 (let ((pos (position #/ s :from-end t))) - (if pos (1+ pos) 0))))) - (let* ((directory-prefix - (if (and (plusp (length so-far)) (eql (aref so-far 0) #/)) - "" - (namestring #+sbcl (car (directory ".")) #+cmu (ext:default-directory)))) - (full-so-far (concatenate 'string directory-prefix so-far)) - (pathnames - (loop with length = (length full-so-far) - for path in (directory (concatenate 'string - (remove-trail so-far) - "*.*")) - when (let ((mismatch (mismatch (namestring path) full-so-far))) - (or (null mismatch) (= mismatch length))) - collect path)) - (strings (mapcar #'namestring pathnames)) - (first-string (car strings)) - (length-common-prefix nil) - (completed-string nil) - (full-completed-string nil)) - (unless (null pathnames) - (setf length-common-prefix - (loop with length = (length first-string) - for string in (cdr strings) - do (setf length (min length (or (mismatch string first-string) length))) - finally (return length)))) - (unless (null pathnames) - (setf completed-string - (subseq first-string (length directory-prefix) - (if (null (cdr pathnames)) nil length-common-prefix))) - (setf full-completed-string - (concatenate 'string directory-prefix completed-string))) - (case mode - ((:complete-limited :complete-maximal) - (cond ((null pathnames) - (values so-far nil nil 0 nil)) - ((null (cdr pathnames)) - (values completed-string t (car pathnames) 1 nil)) - (t - (values completed-string nil nil (length pathnames) nil)))) - (:complete - (cond ((null pathnames) - (values so-far nil nil 0 nil)) - ((null (cdr pathnames)) - (values completed-string t (car pathnames) 1 nil)) - ((find full-completed-string strings :test #'string-equal) - (let ((pos (position full-completed-string strings :test #'string-equal))) - (values completed-string - t (elt pathnames pos) (length pathnames) nil))) - (t - (values completed-string nil nil (length pathnames) nil)))) - (:possibilities - (values nil nil nil (length pathnames) - (loop with length = (length directory-prefix) - for name in pathnames - collect (list (subseq (namestring name) length nil) - name)))))))) - - -(define-presentation-method accept - ((type completable-pathname) stream (view textual-view) &key) - (multiple-value-bind (pathname success string) - (complete-input stream - #'filename-completer - :partial-completers '(#\Space) - :allow-any-input t) - (declare (ignore success)) - (or pathname string))) - -(define-gsharp-command (com-load-file :name t) () - (let* ((stream (frame-standard-input *application-frame*)) - (filename (handler-case (accept 'completable-pathname :stream stream - :prompt "File Name") - (simple-parse-error () (error 'file-not-found)))) - (buffer (read-everything filename)) - (input-state (make-input-state)) - (cursor (make-initial-cursor buffer)) - (view (make-instance 'orchestra-view - :buffer buffer - :cursor cursor))) - (setf (view (car (windows *application-frame*))) view) - (setf (input-state *application-frame*) input-state) - (select-layer cursor (car (layers (segment (current-cursor))))))) - (defmethod find-file :around (filepath (application-frame gsharp)) (declare (ignore filepath)) (let* ((buffer (call-next-method)) @@ -324,15 +229,6 @@ (filepath buffer) filepath) (select-layer cursor (car (layers (segment (current-cursor)))))))

-(define-gsharp-command (com-save-buffer-as :name t) () - (let* ((stream (frame-standard-input *application-frame*)) - (filename (handler-case (accept 'completable-pathname :stream stream - :prompt "File Name") - (simple-parse-error () (error 'file-not-found))))) - (with-open-file (stream filename :direction :output) - (save-buffer-to-stream (current-buffer *application-frame*) stream) - (message "Saved buffer to ~A~%" filename)))) - (define-gsharp-command (com-quit :name t) () (frame-exit *application-frame*))

--- /project/gsharp/cvsroot/gsharp/modes.lisp 2006/02/15 02:54:26 1.9 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2006/02/15 03:18:03 1.10 @@ -13,7 +13,6 @@ (set-key 'com-left 'global-gsharp-table '((#\l :meta))) (set-key 'com-right 'global-gsharp-table '((#\r :meta))) (set-key 'com-rotate-notehead 'global-gsharp-table '((#\r :control))) -;;; (set-key 'com-load-file 'global-gsharp-table '((#\x :control) (#\f :control))) (set-key 'com-istate-more-dots 'global-gsharp-table '((#\i) (#.))) (set-key 'com-istate-more-lbeams 'global-gsharp-table '((#\i) (#[))) (set-key 'com-istate-more-rbeams 'global-gsharp-table '((#\i) (#])))