/[climacs]/climacs/io.lisp
ViewVC logotype

Contents of /climacs/io.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (show annotations)
Thu Jan 24 09:29:28 2008 UTC (6 years, 2 months ago) by thenriksen
Branch: MAIN
CVS Tags: HEAD
Changes since 1.9: +1 -0 lines
Don't permit undoing the initial file load.
1 ;;; -*- Mode: Lisp; Package: CLIMACS-CORE -*-
2
3 ;;; (c) copyright 2004 by
4 ;;; Robert Strandh (strandh@labri.fr)
5 ;;; (c) copyright 2006 by
6 ;;; Troels Henriksen (athas@sigkill.dk)
7
8 ;;; This library is free software; you can redistribute it and/or
9 ;;; modify it under the terms of the GNU Library General Public
10 ;;; License as published by the Free Software Foundation; either
11 ;;; version 2 of the License, or (at your option) any later version.
12 ;;;
13 ;;; This library is distributed in the hope that it will be useful,
14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;;; Library General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU Library General Public
19 ;;; License along with this library; if not, write to the
20 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;;; Boston, MA 02111-1307 USA.
22
23 ;;; Input/Output of buffers to and from streams.
24
25 (in-package :climacs-core)
26
27 (define-condition buffer-contains-noncharacter (buffer-writing-error)
28 ()
29 (:report (lambda (condition stream)
30 (format stream "Buffer ~A contains non-character object"
31 (name (buffer condition)))))
32 (:documentation "This error is signalled whenever an attempt is
33 made to save a buffer that contains a non-character object."))
34
35 (defun buffer-contains-noncharacter (buffer filepath)
36 "Signal an error of type `buffer-contains-noncharacter' with
37 the buffer `buffer' and the filepath `filepath'."
38 (error 'buffer-contains-noncharacter :buffer buffer :filepath filepath))
39
40 (defmethod check-buffer-writability ((application-frame climacs) (filepath pathname)
41 (buffer drei-buffer))
42 (do-buffer-region (object offset buffer 0 (size buffer))
43 (unless (characterp object)
44 (buffer-contains-noncharacter buffer filepath)))
45 (call-next-method))
46
47 (defmethod frame-save-buffer-to-stream ((application-frame climacs) (buffer climacs-buffer) stream)
48 (let ((seq (buffer-sequence buffer 0 (size buffer))))
49 (if (every #'characterp seq)
50 (write-sequence seq stream)
51 (display-message "Cannot save to file, buffer contains non-character object"))))
52
53 (defun input-from-stream (stream buffer offset)
54 (let* ((seq (make-string (file-length stream)))
55 (count (#+mcclim read-sequence #-mcclim cl:read-sequence
56 seq stream)))
57 (insert-buffer-sequence buffer offset
58 (if (= count (length seq))
59 seq
60 (subseq seq 0 count)))))
61
62 (defmethod frame-make-buffer-from-stream ((application-frame climacs) stream)
63 (let* ((buffer (make-new-buffer)))
64 (input-from-stream stream buffer 0)
65 (clear-undo-history buffer)
66 buffer))

  ViewVC Help
Powered by ViewVC 1.1.5