[climacs-cvs] CVS climacs
thenriksen
thenriksen at common-lisp.net
Fri Sep 8 18:12:03 UTC 2006
Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv26340
Modified Files:
lisp-syntax-swine.lisp io.lisp groups.lisp core.lisp
Log Message:
Update to work with recent ESA changes.
--- /project/climacs/cvsroot/climacs/lisp-syntax-swine.lisp 2006/08/30 19:32:23 1.3
+++ /project/climacs/cvsroot/climacs/lisp-syntax-swine.lisp 2006/09/08 18:12:03 1.4
@@ -1016,7 +1016,7 @@
(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 @@
(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 @@
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 @@
(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
--- /project/climacs/cvsroot/climacs/io.lisp 2006/09/02 11:41:41 1.6
+++ /project/climacs/cvsroot/climacs/io.lisp 2006/09/08 18:12:03 1.7
@@ -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))
--- /project/climacs/cvsroot/climacs/groups.lisp 2006/09/06 20:07:21 1.1
+++ /project/climacs/cvsroot/climacs/groups.lisp 2006/09/08 18:12:03 1.2
@@ -287,7 +287,7 @@
(unwind-protect (progn , at 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)
--- /project/climacs/cvsroot/climacs/core.lisp 2006/09/06 20:07:21 1.8
+++ /project/climacs/cvsroot/climacs/core.lisp 2006/09/08 18:12:03 1.9
@@ -334,16 +334,12 @@
;;;
;;; 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 @@
(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 @@
(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 @@
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 @@
(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 @@
(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 @@
(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 @@
(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?")
More information about the Climacs-cvs
mailing list