files.lisp

   1 (in-package :lice)
   2
   3 (defcustom *mode-require-final-newline* t
   4   "Whether to add a newline at end of file, in certain major modes.
   5 Those modes set `require-final-newline' to this value when you enable them.
   6 They do so because they are often used for files that are supposed
   7 to end in newlines, and the question is how to arrange that.
   8
   9 A value of t means do this only when the file is about to be saved.
  10 A value of `visit' means do this right after the file is visited.
  11 A value of `visit-save' means do it at both of those times.
  12 Any other non-nil value means ask user whether to add a newline, when saving.
  13
  14 nil means do not add newlines.  That is a risky choice in this variable
  15 since this value is used for modes for files that ought to have final newlines.
  16 So if you set this to nil, you must explicitly check and add
  17 a final newline, whenever you save a file that really needs one."
  18   :type '(choice (const :tag "When visiting" visit)
  19                  (const :tag "When saving" t)
  20                  (const :tag "When visiting or saving" visit-save)
  21                  (const :tag "Don't add newlines" nil)
  22                  (other :tag "Ask each time" ask))
  23   :group 'editing-basics
  24   :version "22.1")
  25
  26 (defcustom-buffer-local *require-final-newline* nil
  27   "Whether to add a newline automatically at the end of the file.
  28
  29 A value of t means do this only when the file is about to be saved.
  30 A value of `visit' means do this right after the file is visited.
  31 A value of `visit-save' means do it at both of those times.
  32 Any other non-nil value means ask user whether to add a newline, when saving.
  33 nil means don't add newlines.
  34
  35 Certain major modes set this locally to the value obtained
  36 from `mode-require-final-newline'."
  37   :type '(choice (const :tag "When visiting" visit)
  38                  (const :tag "When saving" t)
  39                  (const :tag "When visiting or saving" visit-save)
  40                  (const :tag "Don't add newlines" nil)
  41                  (other :tag "Ask each time" ask))
  42   :group 'editing-basics)
  43
  44 (defun format-filename (filename)
  45   (declare (type pathname filename))
  46   (format nil "~a~@[.~a~]"
  47           (pathname-name filename)
  48           (pathname-type filename)))
  49
  50 (defun slurp-file (filename)
  51   "Return the contents of FILENAME as a string."
  52   (declare (type pathname filename))
  53   (with-open-file (in filename)
  54     ;; Note the 1+ is to leave a 1 character gap, because a buffer
  55     ;; can't have a 0 length gap.
  56     (let* ((str (make-array (1+ (file-length in)) :element-type 'character)))
  57       (read-sequence str in)
  58       str)))
  59
  60 (defun make-file-buffer (filename)
  61   "Assumes filename has been verified to exist and is a file."
  62   ;; load the file, put it in a buffer
  63   (declare (type pathname filename))
  64   (let* ((data (slurp-file filename))
  65          (b (make-instance 'buffer
  66                            :file filename
  67                            :point (make-marker)
  68                            :mark (make-marker)
  69                            :data data
  70                            :name (format-filename filename)
  71                            ;; 1- because the data has been allocated with 1 extra character
  72                            :gap-start (1- (length data))
  73                            :gap-size 1 ;;(length +other-buf+)
  74                            :major-mode '*fundamental-mode*)))
  75     (set-marker (buffer-point b) 0 b)
  76     (set-marker (mark-marker b) 0 b)
  77     b))
  78
  79 (defun find-file-no-select (filename)
  80   ;; TODO: verify the file is a file (not a dir) and it exists, etc.
  81   (let ((pn (parse-namestring filename)))
  82     ;; check that the directory exists
  83     (unless (ensure-directories-exist pn)
  84       (error "dir doesn't exist"))
  85     (let ((b (get-buffer-create (format-filename pn))))
  86       (setf (buffer-file b) pn)
  87       (when (probe-file pn)
  88         (setf (buffer-data b) (slurp-file pn)
  89             (buffer-gap-start b) (1- (length (buffer-data b)))
  90             (buffer-gap-size b) 1))
  91       b)))
  92
  93 (defcommand find-file ((filename)
  94                        (:file "Find File: "))
  95   ""
  96   (let ((b (find-file-no-select filename)))
  97     (switch-to-buffer b)))
  98
  99 (defcommand save-buffer ()
 100   (let ((buffer (current-buffer)))
 101     (when (buffer-file buffer)
 102       (if (buffer-modified-p buffer)
 103           (with-open-file (out (buffer-file buffer)
 104                                :direction :output
 105                                :if-exists :overwrite
 106                                :if-does-not-exist :create)
 107             ;; write the data before the gap
 108             (write-sequence (buffer-data buffer) out
 109                             :start (buffer-min buffer)
 110                             :end (buffer-gap-start buffer))
 111             ;; write the data after the gap
 112             (write-sequence (buffer-data buffer) out
 113                             :start (gap-end buffer)
 114                             :end (length (buffer-data buffer)))
 115             (setf (buffer-modified-p buffer) nil)
 116             (message "Wrote ~a~%" (buffer-file (current-buffer))))
 117         (message "(No changes need to be saved)")))))
 118
 119 (defun file-completions (base predicate other)
 120   "Return a list of possible file completions given the base file, BASE. OTHER is not used."
 121   (declare (ignore other))
 122   ;; FIXME: they need to be strings
 123   (let ((tester (or predicate
 124                     (lambda (s)
 125                       (string= base s :end2 (min (length base)
 126                                                  (length s)))))))
 127     (loop for elt in (mapcar 'princ-to-string (directory (merge-pathnames (make-pathname :name :wild) base)))
 128        when (funcall tester elt)
 129        collect elt)))
 130
 131 (defcommand load-file ((file)
 132                        (:file "Load file: "))
 133   "Load the Lisp file named FILE."
 134   (load file))
 135
 136 ;;; auto save
 137
 138 (defun recent-auto-save-p ()
 139   "Return t if current buffer has been auto-saved recently.
 140 More precisely, if it has been auto-saved since last read from or saved
 141 in the visited file.  If the buffer has no visited file,
 142 then any auto-save counts as \"recent\"."
 143   ;; FIXME: implement
 144   nil)
 145
 146 (defun set-buffer-auto-saved ()
 147 "Mark current buffer as auto-saved with its current text.
 148 No auto-save file will be written until the buffer changes again."
 149   (setf (buffer-auto-save-modified (current-buffer)) (buffer-modiff (current-buffer))))
 150
 151 ;; FIXME: maybe this should be a slot in the buffer with the rest of the autosave slots
 152 (define-buffer-local buffer-auto-save-file-name nil
 153   "Name of file for auto-saving current buffer.
 154 If it is nil, that means don't auto-save this buffer.")
 155
 156 (defcustom *delete-auto-save-files* t
 157   "Non-nil means delete auto-save file when a buffer is saved or killed.
 158
 159 Note that the auto-save file will not be deleted if the buffer is killed
 160 when it has unsaved changes."
 161   :type 'boolean
 162   :group 'auto-save)
 163
 164 (defun delete-auto-save-file-if-necessary (&optional force)
 165   "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
 166 Normally delete only if the file was written by this Emacs since
 167 the last real save, but optional arg FORCE non-nil means delete anyway."
 168   (and buffer-auto-save-file-name *delete-auto-save-files*
 169        (not (string= (buffer-file (current-buffer)) buffer-auto-save-file-name))
 170        (or force (recent-auto-save-p))
 171        (progn
 172          (handler-case
 173              (delete-file buffer-auto-save-file-name)
 174            (file-error () nil))
 175          (set-buffer-auto-saved))))
 176
 177 (provide :lice-0.1/files)