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

Update to work with recent ESA changes.

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