files.lisp

   1 (in-package :lice)
   2
   3 (defun format-filename (filename)
   4   (declare (type pathname filename))
   5   (format nil "~a~@[.~a~]"
   6           (pathname-name filename)
   7           (pathname-type filename)))
   8
   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)
  17       str)))
  18
  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
  25                            :file filename
  26                            :point (make-marker)
  27                            :mark (make-marker)
  28                            :data data
  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)
  37     b))
  38
  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"))
  45     (if (probe-file pn)
  46         (let ((b (make-file-buffer pn)))
  47           (push b *buffer-list*)
  48           b)
  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)
  53         b))))
  54
  55 (defcommand find-file ((filename)
  56                        (:file "Find File: "))
  57   ""
  58   (let ((b (find-file-no-select filename)))
  59     (switch-to-buffer b)))
  60
  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)
  66                                :direction :output
  67                                :if-exists :overwrite
  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)")))))
  80
  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
  86                     (lambda (s)
  87                       (string= base s :end2 (min (length base)
  88                                                  (length s)))))))
  89     (loop for elt in (mapcar 'princ-to-string (directory (merge-pathnames (make-pathname :name :wild) base)))
  90        when (funcall tester elt)
  91        collect elt)))
  92
  93 (defcommand load-file ((file)
  94                        (:file "Load file: "))
  95   "Load the Lisp file named FILE."
  96   (load file))
  97
  98 (provide :lice-0.1/files)