home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / new / util / edit / jade / lisp / buffers.jl < prev    next >
Lisp/Scheme  |  1994-10-05  |  19KB  |  527 lines
  1. ;;;; buffers.jl -- High-level buffer/file handling
  2. ;;;  Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (defvar auto-save-p t
  21.   "When t files are auto-save'd regularly.")
  22. (defvar default-auto-save-interval 120
  23.   "The number of seconds between each auto-save.")
  24.  
  25. (defvar make-backup-files t
  26.   "When non-nil backups of files are made when they are saved.")
  27. (defvar backup-by-copying nil
  28.   "When non-nil all file backups are made by copying the file, not by
  29. renaming it.")
  30. (defvar else-backup-by-copying t
  31.   "Non-nil means make file backups by copying the file if it's not a good
  32. idea to rename it. If `backup-by-copying' is non-nil this variable has no
  33. effect.")
  34.  
  35. (defvar default-buffer (current-buffer)
  36.   "The `*jade*' buffer.")
  37.  
  38. ;; Initialise the first window's buffer-list
  39. (setq buffer-list (cons default-buffer nil))
  40.  
  41. (defvar standard-output default-buffer
  42.   "Stream that `prin?' writes its output to by default")
  43. (defvar standard-input default-buffer
  44.   "Stream that `read' takes it's input from by default")
  45.  
  46. (defvar buffer-file-modtime 0
  47.   "Holds the modification time of the file this buffer was loaded from")
  48. (make-variable-buffer-local 'buffer-file-modtime)
  49.  
  50. (defvar mildly-special-buffer nil
  51.   "When a buffer's `special' attribute is set kill-buffer will only kill
  52. it totally if this variable is non-nil.")
  53. (make-variable-buffer-local 'mildly-special-buffer)
  54.  
  55. (make-variable-buffer-local 'kill-buffer-hook)
  56.  
  57. (defvar enable-local-variables t
  58.   "Tells how to process local variable lists. t means process them
  59. silently, nil means ignore them, anything else means to query each
  60. variable being set.")
  61.  
  62. (defvar enable-local-eval 'maybe
  63.   "Tells how to process the `eval' local variable. Same options as
  64. with `enable-local-variables'.")
  65.  
  66. (defvar local-variable-lines 20
  67.   "This variable defines how many of the bottom-most lines in a file are
  68. searched for a `Local Variables:' section.")
  69.  
  70. (defun goto-buffer (buffer)
  71.   "Switch the current buffer to BUFFER which can either be a buffer-object
  72. or a string naming an existing buffer. The selected buffer is moved to
  73. the head of the buffer list. If BUFFER is a string and it doesn't name
  74. an existing buffer a new one will be created with that name."
  75.   (interactive "BSwitch to buffer")
  76.   (when (stringp buffer)
  77.     (setq buffer (open-buffer buffer)))
  78.   (unless (bufferp buffer)
  79.     (signal 'bad-arg (list buffer 1)))
  80.   (setq buffer-list (cons buffer (delq buffer buffer-list)))
  81.   (set-current-buffer buffer))
  82.  
  83. (defun open-file (name)
  84.   "If no buffer containing file NAME exits try to create one.
  85. After creating a new buffer (named after the file's (not path) name)
  86. it first call the hook `read-file-hook' with arguments `(buffer-file-name
  87. buffer)'.
  88. If this hook returns nil (ie, no members of the hook decided to read the
  89. file into memory) the file is read into the buffer verbatim.\n
  90. Once the file is in memory, through the hook or otherwise, this function
  91. then tries to initialise the correct editing mode for the file.\n
  92. `open-file' always returns the buffer holding the file, or nil if it
  93. doesn't exist."
  94.   (let
  95.       ((buf (get-file-buffer name)))
  96.     (unless buf
  97.       (when (setq buf (make-buffer (file-name-nondirectory name)))
  98.     (add-buffer buf buffer-list)
  99.     (with-buffer buf
  100.       (unless (eval-hook 'read-file-hook name buf)
  101.         (set-buffer-file-name buf name)
  102.         (if (file-exists-p name)
  103.         (progn
  104.           (read-buffer name)
  105.           (setq buffer-file-modtime (file-modtime name)))
  106.           (message "New file")))
  107.       (fix-local-variables)
  108.       (set-buffer-modified buf nil)
  109.       (when auto-save-p
  110.         (setq auto-save-interval default-auto-save-interval))
  111.       (setq last-save-time (current-time)
  112.         buffer-undo-list nil)
  113.       (when (auto-save-file-newer-p name)
  114.         (message "Warning: Auto-saved file is newer")
  115.         (beep))
  116.       (when (and (file-exists-p name) (not (file-writable-p name)))
  117.         (set-buffer-read-only buf t))
  118.       (eval-hook 'open-file-hook buf)
  119.       (init-mode buf))))
  120.     buf))
  121.  
  122. ;; Scans the end of a file for any local-variable definitions
  123. (defun fix-local-variables ()
  124.   (unless enable-local-variables
  125.     (return))
  126.   (let
  127.       ((pos (pos 0 (- (buffer-length) local-variable-lines))))
  128.     (when (< (pos-line pos) 0)
  129.       (set-pos-line pos 0))
  130.     (when (find-next-regexp "^(.*)Local Variables:(.*)$" pos)
  131.       (let
  132.       ((re (concat ?^
  133.                (regexp-quote (copy-area (match-start 1) (match-end 1)))
  134.                "([^:]+):(.*)"
  135.                (regexp-quote (copy-area (match-start 2) (match-end 2)))
  136.                ?$))
  137.        name value)
  138.     (setq pos (match-end))
  139.     (while (find-next-regexp re pos)
  140.       (setq pos (match-end)
  141.         name (copy-area (match-start 1) (match-end 1))
  142.         value (copy-area (match-start 2) (match-end 2)))
  143.       (cond
  144.        ((and (equal name "End") (equal value ""))
  145.         (return))
  146.        ((equal name "mode")
  147.         (when (or (eq enable-local-variables t)
  148.               (y-or-n-p (format nil "Use major mode %s?" value)))
  149.           (setq mode-name name)))
  150.        ((equal name "eval")
  151.         (when (and enable-local-eval
  152.                (or (eq enable-local-eval t)
  153.                (y-or-n-p (format nil "Eval `%s'?" value))))
  154.           (eval (read-from-string value))))
  155.        (t
  156.         (when (or (eq enable-local-variables t)
  157.               (y-or-n-p (format nil "Set %s to %s?" name value)))
  158.           (setq name (intern name))
  159.           (make-local-variable name)
  160.           (set name (read-from-string value))))))))))
  161.  
  162. (defun find-file (name)
  163.   "Sets the current buffer to that containing the file NAME, if NAME
  164. is unspecified it will be prompted for. If the file is not already in memory
  165. `open-file' will be used to load it."
  166.   (interactive "FFind file: ")
  167.   (goto-buffer (open-file name)))
  168.  
  169. (defun find-file-read-only (name)
  170.   "Similar to `find-file' except that the buffer is edited in read-only mode."
  171.   (interactive "FFind file read-only:")
  172.   (let
  173.       ((buf (open-file name)))
  174.     (when buf
  175.       (set-buffer-read-only buf t)
  176.       (goto-buffer buf))))
  177.  
  178. (defun find-alternate-file (name)
  179.   "If NAME is unspecified one will be prompted for. The current buffer is
  180. killed and one editing NAME is found."
  181.   (interactive "FFind alternate file:")
  182.   (kill-buffer (current-buffer))
  183.   (goto-buffer (open-file name)))
  184.  
  185. (defun backup-file (file-name)
  186.   "If necessary make a backup of FILE-NAME. The file called FILE-NAME may or
  187. may not exist after this function returns."
  188.   (when (and make-backup-files (file-regular-p name))
  189.     (let
  190.     ((backup-name (concat name ?~)))
  191.       (if backup-by-copying
  192.       (copy-file name backup-name)
  193.     (if (and (file-owner-p name)
  194.          (= (file-nlinks name) 1))
  195.         (progn
  196.           (when (file-exists-p backup-name)
  197.         (delete-file backup-name))
  198.           (rename-file name backup-name))
  199.       (when else-backup-by-copying
  200.         (copy-file name backup-name)))))))
  201.  
  202. (defun write-file (buffer &optional name)
  203.   "Writes the contents of BUFFER to the file NAME, or to the one
  204. that it is associated with."
  205.   (unless (stringp name)
  206.     (setq name (buffer-file-name buffer)))
  207.   (unless (eval-hook 'write-file-hook name buffer)
  208.     (let
  209.     ((modes (when (file-exists-p name) (file-modes name))))
  210.       (backup-file name)
  211.       (when (write-buffer name buffer)
  212.     (when modes
  213.       (set-file-modes name modes))
  214.     t))))
  215.  
  216. (defun save-file (&optional buffer &aux name)
  217.   "Saves the buffer BUFFER, or the current buffer, to the file that it is
  218. associated with, then sets the number of modifications made to this file
  219. to zero.
  220. Note: if no changes have been made to this buffer, it won't be saved."
  221.   (interactive)
  222.   (unless (bufferp buffer)
  223.     (setq buffer (current-buffer)))
  224.   (with-