src/buffer-local.lisp

   1 ;;; buffer local variables
   2
   3 (in-package "LICE")
   4
   5 (defstruct buffer-local-binding
   6   symbol value local-p doc-string)
   7
   8 (defvar *global-buffer-locals* (make-hash-table)
   9   "The default values of buffer locals and a hash table containing all possible buffer locals")
  10
  11 (defun buffer-local-exists-p (symbol)
  12   (multiple-value-bind (v b) (gethash symbol *global-buffer-locals*)
  13     (declare (ignore v))
  14     b))
  15
  16 (defun get-buffer-local-create (symbol default-value &optional doc-string)
  17   (if (buffer-local-exists-p symbol)
  18       (gethash symbol *global-buffer-locals*)
  19       (setf (gethash symbol *global-buffer-locals*)
  20             (make-buffer-local-binding :symbol symbol
  21                                        :value default-value
  22                                        :doc-string doc-string))))
  23
  24 (defmacro define-buffer-local (symbol default-value &optional doc-string)
  25   "buffer locals are data hooks you can use to store values per
  26 buffer. Use them when building minor and major modes. You
  27 generally want to define them with this so you can create a
  28 docstring for them. there is also `get-buffer-local-create'."
  29   `(progn
  30      (when (boundp ',symbol)
  31        (warn "Symbol ~s is already bound. Existing uses of symbol will not be buffer local." ',symbol)
  32        (makunbound ',symbol))
  33      (define-symbol-macro ,symbol (buffer-local ',symbol))
  34      (get-buffer-local-create ',symbol ,default-value ,doc-string)))
  35
  36 (defun (setf buffer-local) (value symbol &optional (buffer (current-buffer)))
  37   "Set the value of the buffer local in the current buffer."
  38   ;; create a global buffer local entry if needed.
  39   (let ((global-binding (get-buffer-local-create symbol value)))
  40     ;; if the symbol becomes buffer local when set or it has a buffer
  41     ;; value
  42     (if (or (buffer-local-binding-local-p global-binding)
  43             (second (multiple-value-list
  44                      (gethash symbol (buffer-locals buffer)))))
  45         ;; set the buffer's value
  46         (setf (gethash symbol (buffer-locals buffer)) value)
  47         ;; set the global value
  48         (setf (buffer-local-binding-value global-binding) value))))
  49
  50 (defun buffer-local (symbol &optional (buffer (current-buffer)))
  51   "Return the value of the buffer local symbol. If none exists
  52 for the current buffer then use the global one. If that doesn't
  53 exist, throw an error."
  54   (multiple-value-bind (v b) (gethash symbol (buffer-locals buffer))
  55     (if b
  56         v
  57         (multiple-value-bind (v b) (gethash symbol *global-buffer-locals*)
  58           (if b
  59               (buffer-local-binding-value v)
  60               (error "No binding for buffer-local ~s" symbol))))))
  61
  62 (defun make-local-variable (symbol)
  63   "Make VARIABLE have a separate value in the current buffer.
  64 Other buffers will continue to share a common default value.
  65 \(The buffer-local value of VARIABLE starts out as the same value
  66 VARIABLE previously had.  If VARIABLE was void, it remains void.\)
  67 Return VARIABLE.
  68
  69 If the variable is already arranged to become local when set,
  70 this function causes a local value to exist for this buffer,
  71 just as setting the variable would do.
  72
  73 Unlike GNU/Emacs This function does not return
  74 VARIABLE. See alse `(SETF MAKE-LOCAL-VARIABLE)'.
  75
  76 See also `make-variable-buffer-local' and `define-buffer-local'.
  77
  78 Do not use `make-local-variable' to make a hook variable buffer-local.
  79 Instead, use `add-hook' and specify t for the LOCAL argument."
  80   (setf (gethash symbol (buffer-locals (current-buffer))) (buffer-local symbol))
  81   ;; only setq and setf expand the symbol-macro properly, so we can't
  82   ;; return the symbol.
  83   nil)
  84
  85 (defun (setf make-local-variable) (value symbol)
  86   "Make the symbol local to the current buffer like
  87 `make-local-variable' and also set its value in the buffer."
  88   (setf (gethash symbol (buffer-locals (current-buffer))) value))
  89
  90 (defun make-variable-buffer-local (variable)
  91   "Make VARIABLE become buffer-local whenever it is set.
  92 At any time, the value for the current buffer is in effect,
  93 unless the variable has never been set in this buffer,
  94 in which case the default value is in effect.
  95 Note that binding the variable with `let', or setting it while
  96 a `let'-style binding made in this buffer is in effect,
  97 does not make the variable buffer-local.  Return VARIABLE.
  98
  99 In most cases it is better to use `make-local-variable',
 100 which makes a variable local in just one buffer.
 101
 102 The function `default-value' gets the default value and `set-default' sets it."
 103   (setf (buffer-local-binding-local-p (gethash variable *global-buffer-locals*)) t))
 104
 105 (defun default-value (symbol)
 106   "Return SYMBOL's default value.
 107 This is the value that is seen in buffers that do not have their own values
 108 for this variable.  The default value is meaningful for variables with
 109 local bindings in certain buffers."
 110   (buffer-local-binding-value (gethash symbol *global-buffer-locals*)))
 111
 112 (defun (setf default-value) (value symbol)
 113   "Set symbol's default value to value.  symbol and value are evaluated.
 114 The default value is seen in buffers that do not have their own values
 115 for this variable."
 116   (setf (buffer-local-binding-value (gethash symbol *global-buffer-locals*)) value)  )
 117
 118 (depricate set-default (setf default-value))
 119 (defun set-default (symbol value)
 120   "Set symbol's default value to value.  symbol and value are evaluated.
 121 The default value is seen in buffers that do not have their own values
 122 for this variable."
 123   (setf (default-value symbol) value))
 124
 125 \f
 126 ;;; Some built-in buffer local variables
 127
 128 (define-buffer-local *buffer-invisibility-spec* nil
 129   "Invisibility spec of this buffer.
 130 The default is t, which means that text is invisible
 131 if it has a non-nil `invisible' property.
 132 If the value is a list, a text character is invisible if its `invisible'
 133 property is an element in that list.
 134 If an element is a cons cell of the form (PROP . ELLIPSIS),
 135 then characters with property value PROP are invisible,
 136 and they have an ellipsis as well if ELLIPSIS is non-nil.")
 137
 138 (define-buffer-local *selective-display* nil
 139   "Non-nil enables selective display.
 140 An Integer N as value means display only lines
 141 that start with less than n columns of space.
 142 A value of t means that the character ^M makes itself and
 143 all the rest of the line invisible; also, when saving the buffer
 144 in a file, save the ^M as a newline.")
 145
 146 (define-buffer-local *mark-active* nil
 147   "Non-nil means the mark and region are currently active in this buffer.")