May 2008 - climacs-cvs@common-lisp.net - mailman3.common-lisp.net

[climacs-cvs] CVS climacs
by thenriksen 18 May '08

18 May '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv22105 Modified Files: core.lisp Log Message: Error handling now done by commands, handle errors when exiting in a better way. --- /project/climacs/cvsroot/climacs/core.lisp 2008/05/18 09:05:11 1.26 +++ /project/climacs/cvsroot/climacs/core.lisp 2008/05/18 09:20:42 1.27 @@ -323,37 +323,34 @@ (display-message "~A is a directory name." filepath) (beep)) (t - (handler-case - (let ((existing-view (find-view-with-pathname filepath))) - (if (and existing-view (if readonlyp (read-only-p (buffer existing-view)) t)) - (switch-to-view (current-window) existing-view) - (let* ((newp (not (probe-file filepath))) - (buffer (if (and newp (not readonlyp)) - (make-new-buffer) - (with-open-file (stream filepath :direction :input) - (make-buffer-from-stream stream)))) - (view (make-new-view-for-climacs - *esa-instance* 'textual-drei-syntax-view - :name (filepath-filename filepath) - :buffer buffer))) - (unless (buffer-pane-p (current-window)) - (other-window (or (find-if #'(lambda (window) - (typep window 'climacs-pane)) - (windows *esa-instance*)) - (split-window t)))) - (setf (offset (point buffer)) (offset (point view)) - (syntax view) (make-syntax-for-view view (syntax-class-name-for-filepath filepath)) - (file-write-time buffer) (if newp (get-universal-time) (file-write-date filepath)) - (needs-saving buffer) nil - (name buffer) (filepath-filename filepath)) - (setf (current-view (current-window)) view) - (evaluate-attribute-line view) - (setf (filepath buffer) (pathname filepath) - (read-only-p buffer) readonlyp) - (beginning-of-buffer (point view)) - buffer))) - (file-error (c) - (display-message "~A" c)))))) + (let ((existing-view (find-view-with-pathname filepath))) + (if (and existing-view (if readonlyp (read-only-p (buffer existing-view)) t)) + (switch-to-view (current-window) existing-view) + (let* ((newp (not (probe-file filepath))) + (buffer (if (and newp (not readonlyp)) + (make-new-buffer) + (with-open-file (stream filepath :direction :input) + (make-buffer-from-stream stream)))) + (view (make-new-view-for-climacs + *esa-instance* 'textual-drei-syntax-view + :name (filepath-filename filepath) + :buffer buffer))) + (unless (buffer-pane-p (current-window)) + (other-window (or (find-if #'(lambda (window) + (typep window 'climacs-pane)) + (windows *esa-instance*)) + (split-window t)))) + (setf (offset (point buffer)) (offset (point view)) + (syntax view) (make-syntax-for-view view (syntax-class-name-for-filepath filepath)) + (file-write-time buffer) (if newp (get-universal-time) (file-write-date filepath)) + (needs-saving buffer) nil + (name buffer) (filepath-filename filepath)) + (setf (current-view (current-window)) view) + (evaluate-attribute-line view) + (setf (filepath buffer) (pathname filepath) + (read-only-p buffer) readonlyp) + (beginning-of-buffer (point view)) + buffer)))))) (defmethod frame-find-file ((application-frame climacs) filepath) (find-file-impl filepath nil)) @@ -394,13 +391,17 @@ (defmethod frame-exit :around ((frame climacs) #-mcclim &key) (dolist (view (views frame)) - (when (and (buffer-of-view-needs-saving view) - (handler-case (accept 'boolean - :prompt (format nil "Save buffer of view: ~a ?" (name view))) - (error () (progn (beep) - (display-message "Invalid answer") - (return-from frame-exit nil))))) - (save-buffer (buffer view)))) + (handler-case + (when (and (buffer-of-view-needs-saving view) + (handler-case (accept 'boolean + :prompt (format nil "Save buffer of view: ~a ?" (name view))) + (error () (progn (beep) + (display-message "Invalid answer") + (return-from frame-exit nil))))) + (save-buffer (buffer view))) + (file-error (e) + (display-message "~A (hit a key to continue)" e) + (read-gesture)))) (when (or (notany #'buffer-of-view-needs-saving (views frame)) (handler-case (accept 'boolean :prompt "Modified buffers of views exist. Quit anyway?") (error () (progn (beep)

1 0

[climacs-cvs] CVS climacs
by thenriksen 18 May '08

18 May '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv17643 Modified Files: core.lisp Log Message: Handle file-errors when finding files. --- /project/climacs/cvsroot/climacs/core.lisp 2008/01/27 08:13:54 1.25 +++ /project/climacs/cvsroot/climacs/core.lisp 2008/05/18 09:05:11 1.26 @@ -323,40 +323,37 @@ (display-message "~A is a directory name." filepath) (beep)) (t - (let ((existing-view (find-view-with-pathname filepath))) - (if (and existing-view (if readonlyp (read-only-p (buffer existing-view)) t)) - (switch-to-view (current-window) existing-view) - (progn - (when readonlyp - (unless (probe-file filepath) - (beep) - (display-message "No such file: ~A" filepath) - (return-from find-file-impl nil))) - (let* ((newp (not (probe-file filepath))) - (buffer (if newp - (make-new-buffer) - (with-open-file (stream filepath :direction :input) - (make-buffer-from-stream stream)))) - (view (make-new-view-for-climacs - *esa-instance* 'textual-drei-syntax-view - :name (filepath-filename filepath) - :buffer buffer))) - (unless (buffer-pane-p (current-window)) - (other-window (or (find-if #'(lambda (window) - (typep window 'climacs-pane)) - (windows *esa-instance*)) - (split-window t)))) - (setf (offset (point buffer)) (offset (point view)) - (syntax view) (make-syntax-for-view view (syntax-class-name-for-filepath filepath)) - (file-write-time buffer) (if newp (get-universal-time) (file-write-date filepath)) - (needs-saving buffer) nil - (name buffer) (filepath-filename filepath)) - (setf (current-view (current-window)) view) - (evaluate-attribute-line view) - (setf (filepath buffer) (pathname filepath) - (read-only-p buffer) readonlyp) - (beginning-of-buffer (point view)) - buffer))))))) + (handler-case + (let ((existing-view (find-view-with-pathname filepath))) + (if (and existing-view (if readonlyp (read-only-p (buffer existing-view)) t)) + (switch-to-view (current-window) existing-view) + (let* ((newp (not (probe-file filepath))) + (buffer (if (and newp (not readonlyp)) + (make-new-buffer) + (with-open-file (stream filepath :direction :input) + (make-buffer-from-stream stream)))) + (view (make-new-view-for-climacs + *esa-instance* 'textual-drei-syntax-view + :name (filepath-filename filepath) + :buffer buffer))) + (unless (buffer-pane-p (current-window)) + (other-window (or (find-if #'(lambda (window) + (typep window 'climacs-pane)) + (windows *esa-instance*)) + (split-window t)))) + (setf (offset (point buffer)) (offset (point view)) + (syntax view) (make-syntax-for-view view (syntax-class-name-for-filepath filepath)) + (file-write-time buffer) (if newp (get-universal-time) (file-write-date filepath)) + (needs-saving buffer) nil + (name buffer) (filepath-filename filepath)) + (setf (current-view (current-window)) view) + (evaluate-attribute-line view) + (setf (filepath buffer) (pathname filepath) + (read-only-p buffer) readonlyp) + (beginning-of-buffer (point view)) + buffer))) + (file-error (c) + (display-message "~A" c)))))) (defmethod frame-find-file ((application-frame climacs) filepath) (find-file-impl filepath nil))

1 0

[climacs-cvs] CVS climacs
by thenriksen 18 May '08

18 May '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv17430 Modified Files: gui.lisp Log Message: Don't provide default dimensions, now handled by a compose-space method for esa:minibuffer-pane. --- /project/climacs/cvsroot/climacs/gui.lisp 2008/03/28 21:10:31 1.262 +++ /project/climacs/cvsroot/climacs/gui.lisp 2008/05/18 09:04:41 1.263 @@ -180,7 +180,6 @@ (defclass climacs-minibuffer-pane (minibuffer-pane) () (:default-initargs - :height 20 :max-height 20 :min-height 20 :default-view +textual-view+ :background *mini-bg-color* :foreground *mini-fg-color*

1 0

[climacs-cvs] CVS climacs
by thenriksen 03 May '08

03 May '08

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv1887 Modified Files: structured-editing.lisp Log Message: Fixed some bugs in structedit. --- /project/climacs/cvsroot/climacs/structured-editing.lisp 2008/04/28 20:50:11 1.3 +++ /project/climacs/cvsroot/climacs/structured-editing.lisp 2008/05/03 09:14:02 1.4 @@ -109,14 +109,20 @@ function used to determine whether or not `(point)' is at the end of a structural object." (let ((immediate-form (funcall immediate-form-fn (current-syntax) (offset (point)))) - (form-around (form-around (current-syntax) (offset (point))))) + (form-around (form-around (current-syntax) (offset (point)))) + (list-at-mark (list-at-mark (current-syntax) (point))) + (string-at-mark (form-of-type-at-mark (current-syntax) (point) #'form-string-p))) (cond ((and (or (form-string-p immediate-form) (form-list-p immediate-form)) (= (funcall border-offset-fn immediate-form) (offset (point)))) (funcall move-fn (point))) - ((funcall at-border-fn (current-syntax) (point)) - (when (null (form-children (list-at-mark (current-syntax) (point)))) + ((and (funcall at-border-fn (current-syntax) (point)) + form-around) + (when (or (and list-at-mark + (null (form-children list-at-mark))) + (and string-at-mark + (= (size string-at-mark) 2))) (delete-form (current-buffer) form-around))) ((and (form-character-p immediate-form) (= (funcall border-offset-fn immediate-form) @@ -244,14 +250,16 @@ 2 0))) ;; Delete from point until end of line. (kill-region (point) (end-of-line (clone-mark (point)))))) - ((= (buffer-line-number (current-buffer) (start-offset form-after)) - (line-number (point))) + ((and form-after + (= (buffer-line-number (current-buffer) (start-offset form-after)) + (line-number (point)))) (forward-kill-expression (point) (current-syntax)) (loop for form-after = (form-after (current-syntax) (offset (point))) - while (and form-after - (= (buffer-line-number (current-buffer) (start-offset form-after)) - (line-number (point)))) - do (forward-kill-expression (point) (current-syntax) 1 t)))))) + while (and form-after + (= (buffer-line-number (current-buffer) (start-offset form-after)) + (line-number (point)))) + do (forward-kill-expression (point) (current-syntax) 1 t))) + (t (forward-kill-line (point) (current-syntax) 1 t nil))))) (set-key `(com-open-list ,*numeric-argument-marker* ,*numeric-argument-marker*) 'structedit-table

1 0