data-types.lisp

   1 ;;; declare all our data types
   2
   3 (in-package "LICE")
   4
   5 \f
   6 ;;; Markers
   7
   8 (deftype marker-insertion-type () '(member :before :after))
   9
  10 (defclass marker ()
  11   ((position :type integer :initform 0 :accessor marker-position)
  12    (buffer #|:type (or buffer null)|# :initform nil :accessor marker-buffer)
  13    (insertion-type :type marker-insertion-type :initform :after :accessor marker-insertion-type))
  14   (:documentation "A Marker"))
  15
  16 (defmethod print-object ((obj marker) stream)
  17   (print-unreadable-object (obj stream :type t :identity t)
  18     (format stream "~a" (marker-position obj))))
  19
  20 \f
  21 ;;; Intervals
  22
  23 ;; interval node is a list: (key left right &rest plist)
  24 (defstruct (interval
  25              (:print-function (lambda (i s d)
  26                                 (declare (ignore d))
  27                                 (format s "#S(interval ~s ~s ~s | ~s ~s)"
  28                                         (interval-pt i)
  29                                         (interval-length i)
  30                                         (interval-plist i)
  31                                         (interval-left i)
  32                                         (interval-right i)))))
  33   (pt nil)
  34   (length nil)
  35   (left nil)
  36   (right nil)
  37   (parent nil #|:type (or null pstring buffer interval)|#)
  38   (plist nil :type list))
  39
  40 ;; MOVITZ's defstruct doesn't create copy-interval
  41 #+movitz
  42 (defun copy-interval (interval)
  43   (make-interval :pt (interval-pt interval)
  44                  :length (interval-length interval)
  45                  :left (interval-left interval)
  46                  :right (interval-right interval)
  47                  :parent (interval-parent interval)
  48                  :plist (interval-plist interval)))
  49
  50 \f
  51 ;;; Buffers
  52
  53 (defclass pstring ()
  54   ((data :type string :initarg :data :accessor pstring-data)
  55    (intervals #|:type (or null interval)|# :initform nil :initarg :intervals :accessor intervals))
  56   (:documentation "The lice string implementation."))
  57
  58 (defmethod print-object ((obj pstring) stream)
  59   (print-unreadable-object (obj stream :type t :identity t)
  60     (format stream "~s" (pstring-data obj))))
  61
  62 (defun pstring-length (ps)
  63   "Return the length of the string in PS"
  64   (declare (type pstring ps))
  65   (length (pstring-data ps)))
  66
  67 (defclass base-buffer ()
  68   ((file :type (or null pathname) :initarg :file :accessor buffer-file)
  69    (name :type string :initarg :name :accessor buffer-name)
  70    (mode-line-string :type string :initform "" :accessor buffer-mode-line-string)
  71    (modified :type boolean :initform nil :accessor buffer-modified-p)
  72    (read-only :type boolean :initform nil :accessor buffer-read-only)
  73    (tick :type integer :initform 0 :accessor buffer-modified-tick :documentation
  74          "The buffer's tick counter. It is incremented for each change
  75 in text.")
  76    (display-count :type integer :initform 0 :accessor buffer-display-count :documentation
  77                   "The buffer's display counter. It is incremented each time it
  78 is displayed in a window.")
  79    (display-time :type integer :initform 0 :accessor buffer-display-time :documentation
  80                  "The last time the buffer was switched to in a window.")
  81    (major-mode #|:type major-mode|# :initarg :major-mode :accessor buffer-major-mode)
  82    (local-map :initform nil :initarg :local-map :accessor buffer-local-map :documentation
  83            "The keymap local to the buffer. This overrides major mode bindings.")
  84    (syntax-table :initform nil :initarg :syntax-table :accessor buffer-syntax-table)
  85    (locals-variables :type hash-table :initform (make-hash-table) :accessor buffer-local-variables)
  86    (locals :type hash-table :initform (make-hash-table) :accessor buffer-locals))
  87   (:documentation "A Buffer."))
  88
  89 ;; undo structures used to record types of undo information. This is
  90 ;; an alternative to the cons cells gnu emacs uses which I find
  91 ;; obscure.
  92 (defstruct undo-entry-insertion
  93   beg end)
  94 (defstruct undo-entry-delete
  95   text position)
  96 (defstruct undo-entry-modified
  97   time)
  98 (defstruct undo-entry-property
  99   prop value beg end)
 100 (defstruct undo-entry-apply
 101   function args)
 102 (defstruct undo-entry-selective
 103   delta beg end function args)
 104 (defstruct undo-entry-marker
 105   marker distance)
 106
 107 (defclass buffer (base-buffer)
 108   ((point #|:type marker|# :initarg :point :accessor buffer-point)
 109    (mark #|:type marker|# :initarg :mark :accessor buffer-mark-marker)
 110    ;; A string containing the raw buffer
 111    (data :type (array character 1) :initarg :data :accessor buffer-data)
 112    (intervals #|:type (or null interval)|# :initform nil :initarg :intervals :accessor intervals)
 113    (gap-start :type integer :initarg :gap-start :accessor buffer-gap-start)
 114    (gap-size :type integer :initarg :gap-size :accessor buffer-gap-size)
 115    (markers :type list :initform '() :accessor buffer-markers)
 116    (auto-save-modified :type integer :initform 0 :accessor buffer-auto-save-modified)
 117    (modiff :type integer :initform 0 :accessor buffer-modiff)
 118    ;;(syntax-table :initform *standard-syntax-table* :accessor buffer-syntax-table)
 119    (undo-list :initform '() :accessor buffer-undo-list
 120               :documentation "List of undo entries in current buffer.
 121 Recent changes come first; older changes follow newer.
 122
 123 An entry (BEG . END) represents an insertion which begins at
 124 position BEG and ends at position END.
 125
 126 An entry (TEXT . POSITION) represents the deletion of the string TEXT
 127 from (abs POSITION).  If POSITION is positive, point was at the front
 128 of the text being deleted; if negative, point was at the end.
 129
 130 An entry (t HIGH . LOW) indicates that the buffer previously had
 131 \"unmodified\" status.  HIGH and LOW are the high and low 16-bit portions
 132 of the visited file's modification time, as of that time.  If the
 133 modification time of the most recent save is different, this entry is
 134 obsolete.
 135
 136 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
 137 was modified between BEG and END.  PROPERTY is the property name,
 138 and VALUE is the old value.
 139
 140 An entry (apply FUN-NAME . ARGS) means undo the change with
 141 \(apply FUN-NAME ARGS).
 142
 143 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
 144 in the active region.  BEG and END is the range affected by this entry
 145 and DELTA is the number of bytes added or deleted in that range by
 146 this change.
 147
 148 An entry (MARKER . DISTANCE) indicates that the marker MARKER
 149 was adjusted in position by the offset DISTANCE (an integer).
 150
 151 An entry of the form POSITION indicates that point was at the buffer
 152 location given by the integer.  Undoing an entry of this form places
 153 point at POSITION.
 154
 155 nil marks undo boundaries.  The undo command treats the changes
 156 between two undo boundaries as a single step to be undone.
 157
 158 If the value of the variable is t, undo information is not recorded.
 159 "))
 160   (:documentation "A text Buffer."))
 161
 162 (defmethod print-object ((obj buffer) stream)
 163   (print-unreadable-object (obj stream :type t :identity t)
 164     (format stream "~a" (buffer-name obj))))
 165
 166 (defvar *current-buffer* nil
 167   "When this buffer is non-nil, it contains the current buffer. Calls
 168 to `current-buffer' return this buffer. Otherwise, `current-buffer'
 169 returns the current frames's current window's buffer.
 170
 171 This variable should never be set using `setq' or `setf'. Bind it with
 172 `let' for as long as it needs to be set.")
 173
 174 (defun current-buffer ()
 175   "Return the current buffer."
 176   *current-buffer*)
 177
 178 ;;; Windows
 179
 180 ;; start and end are inclusive and are buffer points
 181 (defclass line-cache ()
 182   ((start :type integer :initform 0 :initarg :start :accessor lc-start)
 183    (end :type integer :initform 0 :initarg :end :accessor lc-end)
 184    (valid :type boolean :initform nil :initarg :valid :accessor lc-valid)
 185    (cache :type list ;;(array cache-item 1)
 186           :initform nil ;; (make-array 0 :element-type 'cache-item
 187 ;;                         :adjustable t
 188 ;;                         :fill-pointer 0)
 189           :initarg :cache :accessor lc-cache)))
 190
 191 (defclass window ()
 192   ((frame :initarg :frame :accessor window-frame)
 193    (x :type integer :initarg :x :accessor window-x)
 194    (y :type integer :initarg :y :accessor window-y)
 195    (w :type integer :initarg :w :documentation
 196       "The width of the window's contents.")
 197    (h :type integer :initarg :h :documentation
 198       "The total height of the window, including the mode-line.")
 199    (seperator :type boolean :initform nil :accessor window-seperator :documentation
 200               "T when the window is to draw a vertical seperator. used in horizontal splits.")
 201    (line-state :type (array integer 1) :initarg :line-state :accessor window-line-state)
 202    (cache :type line-cache :initarg :cache :accessor window-cache)
 203    ;; Indices into cache (inclusive) that describe the range of the
 204    ;; cache that will be displayed.
 205    (top-line :type integer :initarg :top-line :accessor window-top-line)
 206    (bottom-line :type integer :initarg :bottom-line :accessor window-bottom-line)
 207    (point-col :type integer :initarg :point-col :accessor window-point-col)
 208    (point-line :type integer :initarg :point-line :accessor window-point-line)
 209    ;; The rest refer to points in the buffer
 210    (buffer :type buffer :initarg :buffer :accessor window-buffer)
 211    (bpoint :type marker :initarg :bpoint :accessor window-bpoint :documentation
 212            "A marker marking where in the text the window point is.")
 213    (top :type marker :initarg :top :accessor window-top :documentation
 214         "The point in buffer that is the first character displayed in the window")
 215    (bottom :type marker :initarg :bottom :accessor window-bottom :documentation
 216            "The point in buffer that is the last character displayed
 217 in the window. This should only be used if bottom-valid is T.")
 218    (bottom-valid :type boolean :initform nil :accessor window-bottom-valid :documentation
 219                  "When this is T then bottom should be used to
 220 calculate the visible contents of the window. This is used when
 221 scrolling up (towards the beginning of the buffer)."))
 222   (:documentation "A Lice Window."))
 223
 224 (defclass minibuffer-window (window)
 225   ())
 226
 227 (defvar *selected-window* nil
 228   "The window that the cursor now appears in and commands apply to.")
 229
 230 ;;; frames
 231
 232 (defclass frame ()
 233   ((window-tree :type (or list window) :initarg :window-tree :accessor frame-window-tree)
 234    (width :type fixnum :initarg :width :accessor frame-width)
 235    (height :type fixnum :initarg :height :accessor frame-height)
 236    (minibuffer-window :type window :initarg :minibuffer-window :accessor frame-minibuffer-window)
 237    (minibuffers-active :type fixnum :initform 0 :initarg minibuffers-active :accessor frame-minibuffers-active)
 238    (selected-window :type window :initarg :selected-window :accessor frame-selected-window))
 239   (:documentation "A Lice frame is super cool."))
 240
 241 ;; XXX: This is only temporary
 242 (defvar *selected-frame* nil
 243   "The frame that accepts input.")
 244
 245 ;;; Events
 246
 247 (defvar *last-point-position* nil
 248   "The value of point when the last command was started.")
 249
 250 (defvar *last-point-position-buffer* nil
 251   "The buffer that was current when the last command was started.")
 252
 253 (defvar *last-point-position-window* nil
 254   "The window that was selected when the last command was started.")
 255
 256 (defvar *current-event* nil
 257   "The current event being processed.")