3 (defun format-filename (filename)
4 (declare (type pathname filename
))
5 (format nil
"~a~@[.~a~]"
6 (pathname-name filename
)
7 (pathname-type filename
)))
9 (defun slurp-file (filename)
10 "Return the contents of FILENAME as a string."
11 (declare (type pathname filename
))
12 (with-open-file (in filename
)
13 ;; Note the 1+ is to leave a 1 character gap, because a buffer
14 ;; can't have a 0 length gap.
15 (let* ((str (make-array (1+ (file-length in
)) :element-type
'character
)))
16 (read-sequence str in
)
19 (defun make-file-buffer (filename)
20 "Assumes filename has been verified to exist and is a file."
21 ;; load the file, put it in a buffer
22 (declare (type pathname filename
))
23 (let* ((data (slurp-file filename
))
24 (b (make-instance 'buffer
29 :mode-line
*mode-line-format
*
30 :name
(format-filename filename
)
31 ;; 1- because the data has been allocated with 1 extra character
32 :gap-start
(1- (length data
))
33 :gap-size
1 ;;(length +other-buf+)
34 :major-mode fundamental-mode
)))
35 (set-marker (buffer-point b
) 0 b
)
36 (set-marker (mark-marker b
) 0 b
)
39 (defun find-file-no-select (filename)
40 ;; TODO: verify the file is a file (not a dir) and it exists, etc.
41 (let ((pn (parse-namestring filename
)))
42 ;; check that the directory exists
43 (unless (ensure-directories-exist pn
)
44 (error "dir doesn't exist"))
46 (let ((b (make-file-buffer pn
)))
47 (push b
*buffer-list
*)
49 ;; It doesn't exist so open an empty buffer but give it a file,
50 ;; so it can be saved.
51 (let ((b (get-buffer-create (format-filename pn
))))
52 (setf (buffer-file b
) pn
)
55 (defcommand find-file
((filename)
56 (:file
"Find File: "))
58 (let ((b (find-file-no-select filename
)))
59 (switch-to-buffer b
)))
61 (defcommand save-buffer
()
62 (let ((buffer (current-buffer)))
63 (when (buffer-file buffer
)
64 (if (buffer-modified buffer
)
65 (with-open-file (out (buffer-file buffer
)
68 :if-does-not-exist
:create
)
69 ;; write the data before the gap
70 (write-sequence (buffer-data buffer
) out
71 :start
(buffer-min buffer
)
72 :end
(buffer-gap-start buffer
))
73 ;; write the data after the gap
74 (write-sequence (buffer-data buffer
) out
75 :start
(gap-end buffer
)
76 :end
(length (buffer-data buffer
)))
77 (setf (buffer-modified buffer
) nil
)
78 (message "Wrote ~a~%" (buffer-file (current-buffer))))
79 (message "(No changes need to be saved)")))))
81 (defun file-completions (base predicate other
)
82 "Return a list of possible file completions given the base file, BASE. OTHER is not used."
83 (declare (ignore other
))
84 ;; FIXME: they need to be strings
85 (let ((tester (or predicate
87 (string= base s
:end2
(min (length base
)
89 (loop for elt in
(mapcar 'princ-to-string
(directory (merge-pathnames (make-pathname :name
:wild
) base
)))
90 when
(funcall tester elt
)
93 (defcommand load-file
((file)
94 (:file
"Load file: "))
95 "Load the Lisp file named FILE."
98 (provide :lice-0.1
/files
)