Commit 344a909b authored by Troels Henriksen's avatar Troels Henriksen
Browse files

Update to work with recent ESA changes.

parent a53496d3
...@@ -334,16 +334,12 @@ spaces only.")) ...@@ -334,16 +334,12 @@ spaces only."))
;;; ;;;
;;; Buffer handling ;;; Buffer handling
(defmethod make-new-buffer ((application-frame climacs)) (defmethod frame-make-new-buffer ((application-frame climacs)
(let ((buffer (make-instance 'climacs-buffer))) &key (name "*scratch*"))
(let ((buffer (make-instance 'climacs-buffer :name name)))
(push buffer (buffers application-frame)) (push buffer (buffers application-frame))
buffer)) buffer))
(defun make-new-named-buffer (&optional name)
(let ((buffer (make-new-buffer *application-frame*)))
(when name (setf (name buffer) name))
buffer))
(defgeneric erase-buffer (buffer)) (defgeneric erase-buffer (buffer))
(defmethod erase-buffer ((buffer string)) (defmethod erase-buffer ((buffer string))
...@@ -401,7 +397,7 @@ spaces only.")) ...@@ -401,7 +397,7 @@ spaces only."))
(let ((buffer (find name (buffers *application-frame*) (let ((buffer (find name (buffers *application-frame*)
:key #'name :test #'string=))) :key #'name :test #'string=)))
(switch-to-buffer (or buffer (switch-to-buffer (or buffer
(make-new-named-buffer name))))) (make-new-buffer :name name)))))
;;placeholder ;;placeholder
(defmethod switch-to-buffer ((symbol (eql 'nil))) (defmethod switch-to-buffer ((symbol (eql 'nil)))
...@@ -424,11 +420,11 @@ spaces only.")) ...@@ -424,11 +420,11 @@ spaces only."))
(error () (progn (beep) (error () (progn (beep)
(display-message "Invalid answer") (display-message "Invalid answer")
(return-from kill-buffer nil))))) (return-from kill-buffer nil)))))
(save-buffer buffer *application-frame*)) (save-buffer buffer))
(setf buffers (remove buffer buffers)) (setf buffers (remove buffer buffers))
;; Always need one buffer. ;; Always need one buffer.
(when (null buffers) (when (null buffers)
(make-new-named-buffer "*scratch*")) (make-new-buffer :name "*scratch*"))
(setf (buffer (current-window)) (car buffers)) (setf (buffer (current-window)) (car buffers))
(full-redisplay (current-window)) (full-redisplay (current-window))
(buffer (current-window)))) (buffer (current-window))))
...@@ -621,7 +617,7 @@ by `pathname'. Returns NIL if no buffer can be found." ...@@ -621,7 +617,7 @@ by `pathname'. Returns NIL if no buffer can be found."
file if necessary." file if necessary."
(when (and (findablep pathname) (when (and (findablep pathname)
(not (find-buffer-with-pathname pathname))) (not (find-buffer-with-pathname pathname)))
(find-file pathname *application-frame*))) (find-file pathname)))
(defun find-file-impl (filepath &optional readonlyp) (defun find-file-impl (filepath &optional readonlyp)
(cond ((null filepath) (cond ((null filepath)
...@@ -642,8 +638,8 @@ file if necessary." ...@@ -642,8 +638,8 @@ file if necessary."
(return-from find-file-impl nil))) (return-from find-file-impl nil)))
(let ((buffer (if (probe-file filepath) (let ((buffer (if (probe-file filepath)
(with-open-file (stream filepath :direction :input) (with-open-file (stream filepath :direction :input)
(make-buffer-from-stream stream *application-frame*)) (make-buffer-from-stream stream))
(make-new-buffer *application-frame*))) (make-new-buffer)))
(pane (current-window))) (pane (current-window)))
(setf (offset (point (buffer pane))) (offset (point pane)) (setf (offset (point (buffer pane))) (offset (point pane))
(buffer (current-window)) buffer (buffer (current-window)) buffer
...@@ -659,10 +655,10 @@ file if necessary." ...@@ -659,10 +655,10 @@ file if necessary."
(clear-modify buffer) (clear-modify buffer)
buffer))))))) buffer)))))))
(defmethod find-file (filepath (application-frame climacs)) (defmethod frame-find-file ((application-frame climacs) filepath)
(find-file-impl filepath nil)) (find-file-impl filepath nil))
(defmethod find-file-read-only (filepath (application-frame climacs)) (defmethod frame-find-file-read-only ((application-frame climacs) filepath)
(find-file-impl filepath t)) (find-file-impl filepath t))
(defun directory-of-buffer (buffer) (defun directory-of-buffer (buffer)
...@@ -675,7 +671,7 @@ file if necessary." ...@@ -675,7 +671,7 @@ file if necessary."
(or (filepath buffer) (or (filepath buffer)
(user-homedir-pathname))))) (user-homedir-pathname)))))
(defmethod set-visited-filename (filepath buffer (application-frame climacs)) (defmethod frame-set-visited-filename ((application-frame climacs) filepath buffer)
(setf (filepath buffer) filepath (setf (filepath buffer) filepath
(file-saved-p buffer) nil (file-saved-p buffer) nil
(file-write-time buffer) nil (file-write-time buffer) nil
...@@ -705,7 +701,7 @@ to overwrite." ...@@ -705,7 +701,7 @@ to overwrite."
(error () (progn (beep) (error () (progn (beep)
(display-message "Invalid answer") (display-message "Invalid answer")
(return-from frame-exit nil))))) (return-from frame-exit nil)))))
do (save-buffer buffer frame)) do (save-buffer buffer))
(when (or (notany #'(lambda (buffer) (and (needs-saving buffer) (filepath buffer))) (when (or (notany #'(lambda (buffer) (and (needs-saving buffer) (filepath buffer)))
(buffers frame)) (buffers frame))
(handler-case (accept 'boolean :prompt "Modified buffers exist. Quit anyway?") (handler-case (accept 'boolean :prompt "Modified buffers exist. Quit anyway?")
......
...@@ -287,7 +287,7 @@ is run." ...@@ -287,7 +287,7 @@ is run."
(unwind-protect (progn ,@body) (unwind-protect (progn ,@body)
(unless ,keep (unless ,keep
(loop for buffer in ,buffer-diff-sym (loop for buffer in ,buffer-diff-sym
do (save-buffer buffer *application-frame*) do (save-buffer buffer)
do (kill-buffer buffer)))))))) do (kill-buffer buffer))))))))
(defmacro define-group (name (group-arg &rest args) &body body) (defmacro define-group (name (group-arg &rest args) &body body)
......
...@@ -24,7 +24,7 @@ ...@@ -24,7 +24,7 @@
(in-package :climacs-core) (in-package :climacs-core)
(defmethod save-buffer-to-stream ((buffer climacs-buffer) stream) (defmethod frame-save-buffer-to-stream ((application-frame climacs) (buffer climacs-buffer) stream)
(let ((seq (buffer-sequence buffer 0 (size buffer)))) (let ((seq (buffer-sequence buffer 0 (size buffer))))
(write-sequence seq stream))) (write-sequence seq stream)))
...@@ -37,7 +37,7 @@ ...@@ -37,7 +37,7 @@
seq seq
(subseq seq 0 count))))) (subseq seq 0 count)))))
(defmethod make-buffer-from-stream (stream (application-frame climacs)) (defmethod frame-make-buffer-from-stream ((application-frame climacs) stream)
(let* ((buffer (make-new-buffer application-frame))) (let* ((buffer (make-new-buffer application-frame)))
(input-from-stream stream buffer 0) (input-from-stream stream buffer 0)
buffer)) buffer))
...@@ -1016,7 +1016,7 @@ Each newline and following whitespace is replaced by a single space." ...@@ -1016,7 +1016,7 @@ Each newline and following whitespace is replaced by a single space."
(namestring path))))))) (namestring path)))))))
(if buffer (if buffer
(switch-to-buffer buffer) (switch-to-buffer buffer)
(find-file (file-name location) *application-frame*)) (find-file (file-name location)))
(goto-position (point (current-window)) (goto-position (point (current-window))
(char-position (source-position location))))) (char-position (source-position location)))))
...@@ -1098,7 +1098,7 @@ results." ...@@ -1098,7 +1098,7 @@ results."
(t (t
(when (and (needs-saving buffer) (when (and (needs-saving buffer)
(accept 'boolean :prompt (format nil "Save buffer ~A ?" (name buffer)))) (accept 'boolean :prompt (format nil "Save buffer ~A ?" (name buffer))))
(save-buffer buffer *application-frame*)) (save-buffer buffer))
(let ((*read-base* (base (syntax buffer)))) (let ((*read-base* (base (syntax buffer))))
(multiple-value-bind (result notes) (multiple-value-bind (result notes)
(compile-file-for-climacs (get-usable-image (syntax buffer)) (compile-file-for-climacs (get-usable-image (syntax buffer))
...@@ -1173,7 +1173,7 @@ nil or a list of provided arguments in the form housing symbol. ...@@ -1173,7 +1173,7 @@ nil or a list of provided arguments in the form housing symbol.
Returns NIL if an arglist cannot be displayed." Returns NIL if an arglist cannot be displayed."
(multiple-value-bind (arglist emphasized-symbols highlighted-symbols) (multiple-value-bind (arglist emphasized-symbols highlighted-symbols)
(analyze-arglist (analyze-arglist
(arglist-for-form (syntax (current-buffer *application-frame*)) operator arguments) (arglist-for-form (syntax (current-buffer)) operator arguments)
current-arg-indices current-arg-indices
preceding-arg preceding-arg
arguments) arguments)
...@@ -1230,7 +1230,7 @@ retrieved for the operator, nothing will be displayed." ...@@ -1230,7 +1230,7 @@ retrieved for the operator, nothing will be displayed."
(defun edit-definition (symbol &optional type) (defun edit-definition (symbol &optional type)
(let ((all-definitions (find-definitions-for-climacs (let ((all-definitions (find-definitions-for-climacs
(get-usable-image (syntax (current-buffer *application-frame*))) (get-usable-image (syntax (current-buffer)))
symbol))) symbol)))
(let ((definitions (if (not type) (let ((definitions (if (not type)
all-definitions all-definitions
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment