source: trunk/ccl/hemlock/src/struct.lisp @ 807

Last change on this file since 807 was 807, checked in by gb, 15 years ago

Font-mark/font-region stuff.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 27.9 KB
Line 
1 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
2;;;
3;;; **********************************************************************
4;;; This code was written as part of the CMU Common Lisp project at
5;;; Carnegie Mellon University, and has been placed in the public domain.
6;;;
7#+CMU (ext:file-comment
8  "$Header$")
9;;;
10;;; **********************************************************************
11;;;
12;;; Structures and assorted macros for Hemlock.
13;;;
14
15(in-package :hemlock-internals)
16
17
18;;;; Marks.
19
20(defstruct (mark (:print-function %print-hmark)
21                 (:predicate markp)
22                 (:copier nil)
23                 (:constructor internal-make-mark (line charpos %kind)))
24  "A Hemlock mark object.  See Hemlock Command Implementor's Manual for details."
25  line                                  ; pointer to line
26  charpos                               ; character position
27  %kind)                                ; type of mark
28
29(setf (documentation 'markp 'function)
30  "Returns true if its argument is a Hemlock mark object, false otherwise.")
31(setf (documentation 'mark-line 'function)
32  "Returns line that a Hemlock mark points to.")
33(setf (documentation 'mark-charpos 'function)
34  "Returns the character position of a Hemlock mark.
35  A mark's character position is the index within the line of the character
36  following the mark.")
37
38(defstruct (font-mark (:print-function
39                       (lambda (s stream d)
40                         (declare (ignore d))
41                         (write-string "#<Hemlock Font-Mark \"" stream)
42                         (%print-before-mark s stream)
43                         (write-string "/\\" stream)
44                         (%print-after-mark s stream)
45                         (write-string "\">" stream)))
46                      (:include mark)
47                      (:copier nil)
48                      (:constructor internal-make-font-mark
49                                    (line charpos %kind font)))
50  font
51  region)
52
53(defmacro fast-font-mark-p (s)
54  `(typep ,s 'font-mark))
55
56
57;;;; Regions, buffers, modeline fields.
58
59;;; The region object:
60;;;
61(defstruct (region (:print-function %print-hregion)
62                   (:predicate regionp)
63                   (:copier nil)
64                   (:constructor internal-make-region (start end)))
65  "A Hemlock region object.  See Hemlock Command Implementor's Manual for details."
66  start                                 ; starting mark
67  end)                                  ; ending mark
68
69(setf (documentation 'regionp 'function)
70  "Returns true if its argument is a Hemlock region object, Nil otherwise.")
71(setf (documentation 'region-end 'function)
72  "Returns the mark that is the end of a Hemlock region.")
73(setf (documentation 'region-start 'function)
74  "Returns the mark that is the start of a Hemlock region.")
75
76(defstruct (font-region (:include region)
77                        (:constructor internal-make-font-region (start end)))
78  node)
79
80;;; The buffer object:
81;;;
82(defstruct (buffer (:constructor internal-make-buffer)
83                   (:print-function %print-hbuffer)
84                   (:copier nil)
85                   (:predicate bufferp))
86  "A Hemlock buffer object.  See Hemlock Command Implementor's Manual for details."
87  %name                       ; name of the buffer (a string)
88  %region                     ; the buffer's region
89  %pathname                   ; associated pathname
90  modes                       ; list of buffer's mode names
91  mode-objects                ; list of buffer's mode objects
92  bindings                    ; buffer's command table
93  point                       ; current position in buffer
94  %mark                       ; a saved buffer position
95  region-active               ; modified-tick when region last activated
96  (%writable t)               ; t => can alter buffer's region
97  (modified-tick -2)          ; The last time the buffer was modified.
98  (unmodified-tick -1)        ; The last time the buffer was unmodified
99  #+clx
100  windows                     ; List of all windows into this buffer.
101  #-clx
102  document                    ; NSDocument object associated with this buffer
103  var-values                  ; the buffer's local variables
104  variables                   ; string-table of local variables
105  write-date                  ; File-Write-Date for pathname.
106  display-start               ; Window display start when switching to buf.
107  %modeline-fields            ; List of modeline-field-info's.
108  (delete-hook nil)           ; List of functions to call upon deletion.
109  (external-format :unix)     ; Line-termination, for the time being
110  process                     ; Maybe a listener
111  (gap-context )              ; The value of *buffer-gap-context*
112                              ; in the thread that can modify the buffer.
113  protected-region            ; (optional) write-protected region
114  (font-regions (ccl::init-dll-header (ccl::make-dll-header)))
115                                        ; a doubly-linked list of font regions.
116  active-font-region                    ; currently active font region
117  )
118
119(defstruct (font-region-node (:include ccl::dll-node)
120                             (:constructor make-font-region-node (region)))
121  region)
122
123(setf (documentation 'buffer-modes 'function)
124  "Return the list of the names of the modes active in a given buffer.")
125(setf (documentation 'buffer-point 'function)
126  "Return the mark that is the current focus of attention in a buffer.")
127(setf (documentation 'buffer-windows 'function)
128  "Return the list of windows that are displaying a given buffer.")
129(setf (documentation 'buffer-variables 'function)
130  "Return the string-table of the variables local to the specifed buffer.")
131(setf (documentation 'buffer-write-date 'function)
132  "Return in universal time format the write date for the file associated
133   with the buffer.  If the pathname is set, then this should probably
134   be as well.  Should be NIL if the date is unknown or there is no file.")
135(setf (documentation 'buffer-delete-hook 'function)
136  "This is the list of buffer specific functions that Hemlock invokes when
137   deleting this buffer.")
138
139
140;;; Modeline fields.
141;;;
142(defstruct (modeline-field (:print-function print-modeline-field)
143                           (:constructor %make-modeline-field
144                                         (%name %function %width)))
145  "This is one item displayed in a Hemlock window's modeline."
146  %name         ; EQL name of this field.
147  %function     ; Function that returns a string for this field.
148  %width)       ; Width to display this field in.
149
150(setf (documentation 'modeline-field-p 'function)
151      "Returns true if its argument is a modeline field object, nil otherwise.")
152
153(defstruct (modeline-field-info (:print-function print-modeline-field-info)
154                                (:conc-name ml-field-info-)
155                                (:constructor make-ml-field-info (field)))
156  field
157  (start nil)
158  (end nil))
159
160
161
162;;;; The mode object.
163
164(defstruct (mode-object (:predicate modep)
165                        (:copier nil)
166                        (:print-function %print-hemlock-mode))
167  name                   ; name of this mode
168  setup-function         ; setup function for this mode
169  cleanup-function       ; Cleanup function for this mode
170  bindings               ; The mode's command table.
171  transparent-p          ; Are key-bindings transparent?
172  hook-name              ; The name of the mode hook.
173  major-p                ; Is this a major mode?
174  precedence             ; The precedence for a minor mode.
175  character-attributes   ; Mode local character attributes
176  variables              ; String-table of mode variables
177  var-values             ; Alist for saving mode variables
178  documentation          ; Introductory comments for mode describing commands.
179  hidden                 ; Not listed in modeline fields
180)
181
182(defun %print-hemlock-mode (object stream depth)
183  (declare (ignore depth))
184  (write-string "#<Hemlock Mode \"" stream)
185  (write-string (mode-object-name object) stream)
186  (write-string "\">" stream))
187
188
189
190;;;; Variables.
191
192;;; This holds information about Hemlock variables, and the system stores
193;;; these structures on the property list of the variable's symbolic
194;;; representation under the 'hemlock-variable-value property.
195;;;
196(defstruct (variable-object
197            (:print-function
198             (lambda (object stream depth)
199               (declare (ignore depth))
200               (format stream "#<Hemlock Variable-Object ~S>"
201                       (variable-object-name object))))
202            (:copier nil)
203            (:constructor make-variable-object (documentation name)))
204  value         ; The value of this variable.
205  hooks         ; The hook list for this variable.
206  down          ; The variable-object for the previous value.
207  documentation ; The documentation.
208  name)         ; The string name.
209
210
211
212;#+clx
213(progn
214;;;; Windows, dis-lines, and font-changes.
215
216;;; The window object:
217;;;
218  (defstruct (window (:constructor internal-make-window)
219                     (:predicate windowp)
220                     (:copier nil)
221                     (:print-function %print-hwindow))
222    "This structure implements a Hemlock window."
223    tick                                ; The last time this window was updated.
224    %buffer                     ; buffer displayed in this window.
225    height                      ; Height of window in lines.
226    width                               ; Width of the window in characters.
227    old-start                   ; The charpos of the first char displayed.
228    first-line                  ; The head of the list of dis-lines.
229    last-line                   ; The last dis-line displayed.
230    first-changed                       ; The first changed dis-line on last update.
231    last-changed                        ; The last changed dis-line.
232    spare-lines                 ; The head of the list of unused dis-lines
233    (old-lines 0)                       ; Slot used by display to keep state info
234    hunk                                ; The device hunk that displays this window.
235    display-start                       ; first character position displayed
236    display-end                 ; last character displayed
237    point                               ; Where the cursor is in this window. 
238    modeline-dis-line           ; Dis-line for modeline display.
239    modeline-buffer             ; Complete string of all modeline data.
240    modeline-buffer-len         ; Valid chars in modeline-buffer.
241    display-recentering)                ; Tells whether redisplay recenters window
242                                        ;    regardless of whether it is current.
243
244  (setf (documentation 'windowp 'function)
245        "Returns true if its argument is a Hemlock window object, Nil otherwise.")
246  (setf (documentation 'window-height 'function)
247        "Return the height of a Hemlock window in character positions.")
248  (setf (documentation 'window-width 'function)
249        "Return the width of a Hemlock window in character positions.")
250  (setf (documentation 'window-display-start 'function)
251        "Return the mark which points before the first character displayed in
252   the supplied window.")
253  (setf (documentation 'window-display-end 'function)
254        "Return the mark which points after the last character displayed in
255   the supplied window.")
256  (setf (documentation 'window-point 'function)
257        "Return the mark that points to where the cursor is displayed in this
258  window.  When the window is made current, the Buffer-Point of this window's
259  buffer is moved to this position.  While the window is current, redisplay
260  makes this mark point to the same position as the Buffer-Point of its
261  buffer.")
262  (setf (documentation 'window-display-recentering 'function)
263        "This determines whether redisplay recenters window regardless of whether it
264  is current.  This is SETF'able.")
265
266  (defstruct (window-dis-line (:copier nil)
267                              (:constructor make-window-dis-line (chars))
268                              (:conc-name dis-line-))
269    chars                             ; The line-image to be displayed.
270    (length 0 :type fixnum)     ; Length of line-image.
271    font-changes                ; Font-Change structures for changes in this line.
272    old-chars                 ; Line-Chars of line displayed.
273    line                              ; Line displayed.
274    (flags 0 :type fixnum)      ; Bit flags indicate line status.
275    (delta 0 :type fixnum)      ; # lines moved from previous position.
276    (position 0 :type fixnum)   ; Line # to be displayed on.
277    (end 0 :type fixnum))             ; Index after last logical character displayed.
278
279  (defstruct (font-change (:copier nil)
280                          (:constructor make-font-change (next)))
281    x                         ; X position that change takes effect.
282    font                              ; Index into font-map of font to use.
283    next                              ; The next Font-Change on this dis-line.
284    mark)                             ; Font-Mark responsible for this change.
285
286
287
288;;;; Font family.
289
290  (defstruct font-family
291    map                 ; Font-map for hunk.
292    height              ; Height of char box includung VSP.
293    width                       ; Width of font.
294    baseline            ; Pixels from top of char box added to Y.
295    cursor-width                ; Pixel width of cursor.
296    cursor-height               ; Pixel height of cursor.
297    cursor-x-offset     ; Added to pos of UL corner of char box to get
298    cursor-y-offset)    ; UL corner of cursor blotch.
299
300  )
301
302
303;;;; Attribute descriptors.
304
305(defstruct (attribute-descriptor
306            (:copier nil)
307            (:print-function %print-attribute-descriptor))
308  "This structure is used internally in Hemlock to describe a character
309  attribute."
310  name
311  keyword
312  documentation
313  vector
314  hooks
315  end-value)
316
317
318
319;;;; Commands.
320
321(defstruct (command (:constructor internal-make-command
322                                  (%name documentation function))
323                    (:copier nil)
324                    (:predicate commandp)
325                    (:print-function %print-hcommand))
326  %name                            ;The name of the command
327  documentation                    ;Command documentation string or function
328  function                         ;The function which implements the command
329  %bindings)                       ;Places where command is bound
330
331(setf (documentation 'commandp 'function)
332  "Returns true if its argument is a Hemlock command object, Nil otherwise.")
333(setf (documentation 'command-documentation 'function)
334  "Return the documentation for a Hemlock command, given the command-object.
335  Command documentation may be either a string or a function.  This may
336  be set with Setf.")
337
338
339
340;;;; Random typeout streams.
341
342;;; These streams write to random typeout buffers for WITH-POP-UP-DISPLAY.
343;;;
344
345(defclass random-typeout-stream (#-scl fundamental-character-output-stream
346                                 #+scl character-output-stream)
347  ((mark         :initarg :mark
348                 :initform nil
349                 :accessor random-typeout-stream-mark
350                 :documentation "The buffer point of the associated buffer.")
351   (window       :initarg :window
352                 :initform nil
353                 :accessor random-typeout-stream-window
354                 :documentation "The hemlock window all this shit is in.")
355   (more-mark    :initarg :more-mark
356                 :initform nil
357                 :accessor random-typeout-stream-more-mark
358                 :documentation "The mark that is not displayed when we need to more.")
359   (no-prompt    :initarg :no-prompt
360                 :initform nil
361                 :accessor random-typeout-stream-no-prompt
362                 :documentation "T when we want to exit, still collecting output.")
363   (first-more-p :initarg :first-more-p
364                 :initform t
365                 :accessor random-typeout-stream-first-more-p
366                 :documentation "T until the first time we more. Nil after.")
367   (line-buffered-p :documentation "whether line buffered") ))
368
369(defun make-random-typeout-stream (mark)
370  (make-instance 'random-typeout-stream
371                 :mark mark))
372
373(defmethod print-object ((object random-typeout-stream) stream)
374  (format stream "#<Hemlock Random-Typeout-Stream ~S>"
375          (ignore-errors
376            (buffer-name
377             (line-buffer (mark-line (random-typeout-stream-mark object)))))))
378
379
380;;;; Redisplay devices.
381
382;;; Devices contain monitor specific redisplay methods referenced by
383;;; redisplay independent code.
384;;;
385(defstruct (device (:print-function print-device)
386                   (:constructor %make-device))
387  name                  ; simple-string such as "concept" or "lnz".
388  init                  ; fun to call whenever going into the editor.
389                        ; args: device
390  exit                  ; fun to call whenever leaving the editor.
391                        ; args: device
392  smart-redisplay       ; fun to redisplay a window on this device.
393                        ; args: window &optional recenterp
394  dumb-redisplay        ; fun to redisplay a window on this device.
395                        ; args: window &optional recenterp
396  after-redisplay       ; args: device
397                        ; fun to call at the end of redisplay entry points.
398  clear                 ; fun to clear the entire display.
399                        ; args: device
400  note-read-wait        ; fun to somehow note on display that input is expected.
401                        ; args: on-or-off
402  put-cursor            ; fun to put the cursor at (x,y) or (column,line).
403                        ; args: hunk &optional x y
404  show-mark             ; fun to display the screens cursor at a certain mark.
405                        ; args: window x y time
406  next-window           ; funs to return the next and previous window
407  previous-window       ;    of some window.
408                        ; args: window
409  make-window           ; fun to make a window on the screen.
410                        ; args: device start-mark
411                        ;       &optional modeline-string modeline-function
412  delete-window         ; fun to remove a window from the screen.
413                        ; args: window
414  random-typeout-setup  ; fun to prepare for random typeout.
415                        ; args: device n
416  random-typeout-cleanup; fun to clean up after random typeout.
417                        ; args: device degree
418  random-typeout-line-more ; fun to keep line-buffered streams up to date.
419  random-typeout-full-more ; fun to do full-buffered  more-prompting.
420                           ; args: # of newlines in the object just inserted
421                           ;    in the buffer.
422  force-output          ; if non-nil, fun to force any output possibly buffered.
423  finish-output         ; if non-nil, fun to force output and hand until done.
424                        ; args: device window
425  beep                  ; fun to beep or flash the screen.
426  bottom-window-base    ; bottom text line of bottom window.
427  hunks)                ; list of hunks on the screen.
428
429(defun print-device (obj str n)
430  (declare (ignore n))
431  (format str "#<Hemlock Device ~S>" (device-name obj)))
432
433
434(defstruct (bitmap-device #|(:print-function print-device)|#
435                          (:include device))
436  display)                    ; CLX display object.
437
438
439(defstruct (tty-device #|(:print-function print-device)|#
440                       (:constructor %make-tty-device)
441                       (:include device))
442  dumbp                 ; t if it does not have line insertion and deletion.
443  lines                 ; number of lines on device.
444  columns               ; number of columns per line.
445  display-string        ; fun to display a string of characters at (x,y).
446                        ; args: hunk x y string &optional start end
447  standout-init         ; fun to put terminal in standout mode.
448                        ; args: hunk
449  standout-end          ; fun to take terminal out of standout mode.
450                        ; args: hunk
451  clear-lines           ; fun to clear n lines starting at (x,y).
452                        ; args: hunk x y n
453  clear-to-eol          ; fun to clear to the end of a line from (x,y).
454                        ; args: hunk x y
455  clear-to-eow          ; fun to clear to the end of a window from (x,y).
456                        ; args: hunk x y
457  open-line             ; fun to open a line moving lines below it down.
458                        ; args: hunk x y &optional n
459  delete-line           ; fun to delete a line moving lines below it up.
460                        ; args: hunk x y &optional n
461  insert-string         ; fun to insert a string in the middle of a line.
462                        ; args: hunk x y string &optional start end
463  delete-char           ; fun to delete a character from the middle of a line.
464                        ; args: hunk x y &optional n
465  (cursor-x 0)          ; column the cursor is in.
466  (cursor-y 0)          ; line the cursor is on.
467  standout-init-string  ; string to put terminal in standout mode.
468  standout-end-string   ; string to take terminal out of standout mode.
469  clear-to-eol-string   ; string to cause device to clear to eol at (x,y).
470  clear-string          ; string to cause device to clear entire screen.
471  open-line-string      ; string to cause device to open a blank line.
472  delete-line-string    ; string to cause device to delete a line, moving
473                        ; lines below it up.
474  insert-init-string    ; string to put terminal in insert mode.
475  insert-char-init-string ; string to prepare terminal for insert-mode character.
476  insert-char-end-string ; string to affect terminal after insert-mode character.
477  insert-end-string     ; string to take terminal out of insert mode.
478  delete-init-string    ; string to put terminal in delete mode.
479  delete-char-string    ; string to delete a character.
480  delete-end-string     ; string to take terminal out of delete mode.
481  init-string           ; device init string.
482  cm-end-string         ; takes device out of cursor motion mode.
483  (cm-x-add-char nil)   ; char-code to unconditionally add to x coordinate.
484  (cm-y-add-char nil)   ; char-code to unconditionally add to y coordinate.
485  (cm-x-condx-char nil) ; char-code threshold for adding to x coordinate.
486  (cm-y-condx-char nil) ; char-code threshold for adding to y coordinate.
487  (cm-x-condx-add-char nil) ; char-code to conditionally add to x coordinate.
488  (cm-y-condx-add-char nil) ; char-code to conditionally add to y coordinate.
489  cm-string1            ; initial substring of cursor motion string.
490  cm-string2            ; substring of cursor motion string between coordinates.
491  cm-string3            ; substring of cursor motion string after coordinates.
492  cm-one-origin         ; non-nil if need to add one to coordinates.
493  cm-reversep           ; non-nil if need to reverse coordinates.
494  (cm-x-pad nil)        ; nil, 0, 2, or 3 for places to pad.
495                        ; 0 sends digit-chars.
496  (cm-y-pad nil)        ; nil, 0, 2, or 3 for places to pad.
497                        ; 0 sends digit-chars.
498  screen-image          ; vector device-lines long of strings
499                        ; device-columns long.
500  ;;
501  ;; This terminal's baud rate, or NIL for infinite.
502  (speed nil :type (or (unsigned-byte 24) null)))
503
504
505;;;; Device screen hunks and window-group.
506
507;;; Window groups are used to keep track of the old width and height of a group
508;;; so that when a configure-notify event is sent, we can determine if the size
509;;; of the window actually changed or not.
510;;;
511(defstruct (window-group (:print-function %print-window-group)
512                         (:constructor
513                          make-window-group (xparent width height)))
514  xparent
515  width
516  height)
517
518(defun %print-window-group (object stream depth)
519  (declare (ignore object depth))
520  (format stream "#<Hemlock Window Group>"))
521
522;;; Device-hunks are used to claim a piece of the screen and for ordering
523;;; pieces of the screen.  Window motion primitives and splitting/merging
524;;; primitives use hunks.  Hunks are somewhat of an interface between the
525;;; portable and non-portable parts of screen management, between what the
526;;; user sees on the screen and how Hemlock internals deal with window
527;;; sequencing and creation.  Note: the echo area hunk is not hooked into
528;;; the ring of other hunks via the next and previous fields.
529;;;
530(defstruct (device-hunk (:print-function %print-device-hunk))
531  "This structure is used internally by Hemlock's screen management system."
532  window                ; Window displayed in this hunk.
533  position              ; Bottom Y position of hunk.
534  height                ; Height of hunk in pixels or lines.
535  next                  ; Next and previous hunks.
536  previous
537  device)               ; Display device hunk is on.
538
539(defun %print-device-hunk (object stream depth)
540  (declare (ignore depth))
541  (format stream "#<Hemlock Device-Hunk ~D+~D~@[, ~S~]>"
542          (device-hunk-position object)
543          (device-hunk-height object)
544          (let* ((window (device-hunk-window object))
545                 (buffer (if window (window-buffer window))))
546            (if buffer (buffer-name buffer)))))
547
548
549;;; Bitmap hunks.
550;;;
551;;; The lock field is no longer used.  If events could be handled while we
552;;; were in the middle of something with the hunk, then this could be set
553;;; for exclusion purposes.
554;;;
555(defstruct (bitmap-hunk #|(:print-function %print-device-hunk)|#
556                        (:include device-hunk))
557  width                       ; Pixel width.
558  char-height                 ; Height of text body in characters.
559  char-width                  ; Width in characters.
560  xwindow                     ; X window for this hunk.
561  gcontext                    ; X gcontext for xwindow.
562  start                       ; Head of dis-line list (no dummy).
563  end                         ; Exclusive end, i.e. nil if nil-terminated.
564  modeline-dis-line           ; Dis-line for modeline, or NIL if none.
565  modeline-pos                ; Position of modeline in pixels.
566  (lock t)                    ; Something going on, set trashed if we're changed.
567  trashed                     ; Something bad happened, recompute image.
568  font-family                 ; Font-family used in this window.
569  input-handler               ; Gets hunk, char, x, y when char read.
570  changed-handler             ; Gets hunk when size changed.
571  (thumb-bar-p nil)           ; True if we draw a thumb bar in the top border.
572  window-group)               ; The window-group to which this hunk belongs.
573
574
575;;; Terminal hunks.
576;;;
577(defstruct (tty-hunk #|(:print-function %print-device-hunk)|#
578                     (:include device-hunk))
579  text-position         ; Bottom Y position of text in hunk.
580  text-height)          ; Number of lines of text.
581
582
583
584;;;; Some defsetfs:
585
586(defsetf buffer-writable %set-buffer-writable
587  "Sets whether the buffer is writable and invokes the Buffer Writable Hook.")
588(defsetf buffer-name %set-buffer-name
589  "Sets the name of a specified buffer, invoking the Buffer Name Hook.")
590(defsetf buffer-modified %set-buffer-modified
591  "Make a buffer modified or unmodified.")
592(defsetf buffer-pathname %set-buffer-pathname
593  "Sets the pathname of a buffer, invoking the Buffer Pathname Hook.")
594
595(defsetf getstring %set-string-table
596  "Sets the value for a string-table entry, making a new one if necessary.")
597
598(defsetf window-buffer %set-window-buffer
599  "Change the buffer a window is mapped to.")
600
601(define-setf-expander value (var)
602  "Set the value of a Hemlock variable, calling any hooks."
603  (let ((svar (gensym)))
604    (values
605     ()
606     ()
607     (list svar)
608     `(%set-value ',var ,svar)
609     `(value ,var))))
610
611(defsetf variable-value (name &optional (kind :current) where) (new-value)
612  "Set the value of a Hemlock variable, calling any hooks."
613  `(%set-variable-value ,name ,kind ,where ,new-value))
614
615(defsetf variable-hooks (name &optional (kind :current) where) (new-value)
616  "Set the list of hook functions for a Hemlock variable."
617  `(%set-variable-hooks ,name ,kind ,where ,new-value))
618
619(defsetf variable-documentation (name &optional (kind :current) where) (new-value)
620  "Set a Hemlock variable's documentation."
621  `(%set-variable-documentation ,name ,kind ,where ,new-value))
622
623(defsetf buffer-minor-mode %set-buffer-minor-mode
624  "Turn a buffer minor mode on or off.")
625(defsetf buffer-major-mode %set-buffer-major-mode
626  "Set a buffer's major mode.")
627(defsetf previous-character %set-previous-character
628  "Sets the character to the left of the given Mark.")
629(defsetf next-character %set-next-character
630  "Sets the characters to the right of the given Mark.")
631(defsetf character-attribute %set-character-attribute
632  "Set the value for a character attribute.")
633(defsetf character-attribute-hooks %set-character-attribute-hooks
634  "Set the hook list for a Hemlock character attribute.")
635(defsetf ring-ref %set-ring-ref "Set an element in a ring.")
636(defsetf current-window %set-current-window "Set the current window.")
637(defsetf current-buffer %set-current-buffer
638  "Set the current buffer, doing necessary stuff.")
639(defsetf mark-kind %set-mark-kind "Used to set the kind of a mark.")
640(defsetf buffer-region %set-buffer-region "Set a buffer's region.")
641(defsetf command-name %set-command-name
642  "Change a Hemlock command's name.")
643(defsetf line-string %set-line-string
644  "Replace the contents of a line.")
645(defsetf last-command-type %set-last-command-type
646  "Set the Last-Command-Type for use by the next command.")
647(defsetf prefix-argument %set-prefix-argument
648  "Set the prefix argument for the next command.")
649(defsetf logical-key-event-p %set-logical-key-event-p
650  "Change what Logical-Char= returns for the specified arguments.")
651(defsetf window-font %set-window-font
652  "Change the font-object associated with a font-number in a window.")
653(defsetf default-font %set-default-font
654  "Change the font-object associated with a font-number in new windows.")
655
656(defsetf buffer-modeline-fields %set-buffer-modeline-fields
657  "Sets the buffer's list of modeline fields causing all windows into buffer
658   to be updated for the next redisplay.")
659(defsetf modeline-field-name %set-modeline-field-name
660  "Sets a modeline-field's name.  If one already exists with that name, an
661   error is signaled.")
662(defsetf modeline-field-width %set-modeline-field-width
663  "Sets a modeline-field's width and updates all the fields for all windows
664   in any buffer whose fields list contains the field.")
665(defsetf modeline-field-function %set-modeline-field-function
666  "Sets a modeline-field's function and updates this field for all windows in
667   any buffer whose fields list contains the field.")
668
669;;; Shared buffer-gap context, used to communicate between command threads
670;;; and the event thread.  Note that this isn't buffer-specific; in particular,
671;;; OPEN-LINE and friends may not point at a line that belongs to any
672;;; buffer.
673
674(defstruct buffer-gap-context
675  (lock (ccl::make-lock))
676  (left-open-pos 0)
677  (right-open-pos 0)
678  (line-cache-length 200)
679  (open-line nil)
680  (open-chars (make-string 200))
681)
682
683(define-symbol-macro *line-cache-length* (buffer-gap-context-line-cache-length *buffer-gap-context*))
684(define-symbol-macro *open-line* (buffer-gap-context-open-line *buffer-gap-context*))
685(define-symbol-macro *open-chars* (buffer-gap-context-open-chars *buffer-gap-context*))
686(define-symbol-macro *left-open-pos* (buffer-gap-context-left-open-pos *buffer-gap-context*))
687(define-symbol-macro *right-open-pos* (buffer-gap-context-right-open-pos *buffer-gap-context*))
688
Note: See TracBrowser for help on using the repository browser.