[Phemlock-cvs] CVS update: phemlock/src/core/buffer.lisp phemlock/src/core/htext1.lisp phemlock/src/core/htext2.lisp phemlock/src/core/interp.lisp phemlock/src/core/key-event.lisp phemlock/src/core/ring.lisp phemlock/src/core/struct.lisp phemlock/src/core/syntax.lisp phemlock/src/core/table.lisp phemlock/src/core/window.lisp
Robert Strandh
rstrandh at common-lisp.net
Tue Aug 10 12:47:08 UTC 2004
Update of /project/phemlock/cvsroot/phemlock/src/core
In directory common-lisp.net:/tmp/cvs-serv10336/src/core
Modified Files:
buffer.lisp htext1.lisp htext2.lisp interp.lisp key-event.lisp
ring.lisp struct.lisp syntax.lisp table.lisp window.lisp
Log Message:
Replaced most trivial defsetf with a corresponding (defun (setf ...) ...)
Date: Tue Aug 10 05:47:07 2004
Author: rstrandh
Index: phemlock/src/core/buffer.lisp
diff -u phemlock/src/core/buffer.lisp:1.1 phemlock/src/core/buffer.lisp:1.2
--- phemlock/src/core/buffer.lisp:1.1 Fri Jul 9 08:00:36 2004
+++ phemlock/src/core/buffer.lisp Tue Aug 10 05:47:06 2004
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
#+CMU (ext:file-comment
- "$Header: /project/phemlock/cvsroot/phemlock/src/core/buffer.lisp,v 1.1 2004/07/09 15:00:36 gbaumann Exp $")
+ "$Header: /project/phemlock/cvsroot/phemlock/src/core/buffer.lisp,v 1.2 2004/08/10 12:47:06 rstrandh Exp $")
;;;
;;; **********************************************************************
;;;
@@ -23,7 +23,8 @@
"Returns whether buffer may be modified."
(buffer-%writable buffer))
-(defun %set-buffer-writable (buffer value)
+(defun (setf buffer-writable) (value buffer)
+ "Sets whether the buffer is writable and invokes the Buffer Writable Hook."
(invoke-hook hemlock::buffer-writable-hook buffer value)
(setf (buffer-%writable buffer) value))
@@ -37,7 +38,7 @@
(unless (bufferp buffer) (error "~S is not a buffer." buffer))
(> (buffer-modified-tick buffer) (buffer-unmodified-tick buffer)))
-(defun %set-buffer-modified (buffer sense)
+(defun (setf buffer-modified) (sense buffer)
"If true make the buffer modified, if NIL unmodified."
(unless (bufferp buffer) (error "~S is not a buffer." buffer))
(invoke-hook hemlock::buffer-modified-hook buffer sense)
@@ -53,7 +54,8 @@
"Return the region which contains Buffer's text."
(buffer-%region buffer))
-(defun %set-buffer-region (buffer new-region)
+(defun (setf buffer-region) (new-region buffer)
+ "Set a buffer's region."
(let ((old (buffer-region buffer)))
(delete-region old)
(ninsert-region (region-start old) new-region)
@@ -65,7 +67,8 @@
(declaim (special *buffer-names*))
-(defun %set-buffer-name (buffer name)
+(defun (setf buffer-name) (name buffer)
+ "Sets the name of a specified buffer, invoking the Buffer Name Hook."
(multiple-value-bind (entry foundp) (getstring name *buffer-names*)
(cond ((or (not foundp) (eq entry buffer))
(invoke-hook hemlock::buffer-name-hook buffer name)
@@ -81,7 +84,8 @@
(buffer-%pathname buffer))
-(defun %set-buffer-pathname (buffer pathname)
+(defun (setf buffer-pathname) (pathname buffer)
+ "Sets the pathname of a buffer, invoking the Buffer Pathname Hook."
(invoke-hook hemlock::buffer-pathname-hook buffer pathname)
(setf (buffer-%pathname buffer) pathname))
@@ -91,7 +95,9 @@
(result () (cons (ml-field-info-field (car finfos)) result)))
((null finfos) (nreverse result))))
-(defun %set-buffer-modeline-fields (buffer fields)
+(defun (setf buffer-modeline-fields) (fields buffer)
+ "Sets the buffer's list of modeline fields causing all windows into buffer
+ to be updated for the next redisplay."
(check-type fields list)
(check-type buffer buffer "a Hemlock buffer")
(sub-set-buffer-modeline-fields buffer fields)
@@ -196,14 +202,14 @@
(check-type buffer buffer)
(car (buffer-modes buffer)))
-;;; %SET-BUFFER-MAJOR-MODE -- Public
+;;; (SETF BUFFER-MAJOR-MODE) -- Public
;;;
;;; Unwind all modes in effect and add the major mode specified.
;;;Note that BUFFER-MODE-OBJECTS is in order of invocation in buffers
;;;other than the current buffer, and in the reverse order in the
;;;current buffer.
;;;
-(defun %set-buffer-major-mode (buffer name)
+(defun (setf buffer-major-mode) (name buffer)
"Set the major mode of some buffer to the Name'd mode."
(with-mode-and-buffer (name t buffer)
(invoke-hook hemlock::buffer-major-mode-hook buffer name)
@@ -246,7 +252,8 @@
;;; Activate or deactivate a minor mode, with due respect for
;;; bindings.
;;;
-(defun %set-buffer-minor-mode (buffer name new-value)
+(defun (setf buffer-minor-mode) (new-value buffer name)
+ "Turn a buffer minor mode on or off."
(let ((objects (buffer-mode-objects buffer)))
(with-mode-and-buffer (name nil buffer)
(invoke-hook hemlock::buffer-minor-mode-hook buffer name new-value)
@@ -314,12 +321,13 @@
"Return the Buffer-Point of the current buffer."
(buffer-point *current-buffer*))
-;;; %SET-CURRENT-BUFFER -- Internal
+;;; (SETF CURRENT-BUFFER) -- Internal
;;;
;;; Undo previous buffer and mode specific variables and character
;;;attributes and set up the new ones. Set *current-buffer*.
;;;
-(defun %set-current-buffer (buffer)
+(defun (setf current-buffer) (buffer)
+ "Set the current buffer, doing necessary stuff."
(let ((old-buffer *current-buffer*))
(check-type buffer buffer)
(invoke-hook hemlock::set-buffer-hook buffer)
Index: phemlock/src/core/htext1.lisp
diff -u phemlock/src/core/htext1.lisp:1.1 phemlock/src/core/htext1.lisp:1.2
--- phemlock/src/core/htext1.lisp:1.1 Fri Jul 9 08:00:36 2004
+++ phemlock/src/core/htext1.lisp Tue Aug 10 05:47:07 2004
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
#+CMU (ext:file-comment
- "$Header: /project/phemlock/cvsroot/phemlock/src/core/htext1.lisp,v 1.1 2004/07/09 15:00:36 gbaumann Exp $")
+ "$Header: /project/phemlock/cvsroot/phemlock/src/core/htext1.lisp,v 1.2 2004/08/10 12:47:07 rstrandh Exp $")
;;;
;;; **********************************************************************
;;;
@@ -311,7 +311,8 @@
(close-line))
(line-chars line))
-(defun %set-line-string (line string)
+(defun (setf line-string) (string line)
+ "Replace the contents of a line."
(let ((buffer (line-%buffer line)))
(modifying-buffer buffer
(unless (simple-string-p string)
@@ -356,7 +357,8 @@
:Right-Inserting. This may be set with Setf."
(mark-%kind mark))
-(defun %set-mark-kind (mark kind)
+(defun (setf mark-kind) (kind mark)
+ "Used to set the kind of a mark."
(let ((line (mark-line mark)))
(cond ((eq kind :temporary)
(setf (line-marks line) (delq mark (line-marks line)))
Index: phemlock/src/core/htext2.lisp
diff -u phemlock/src/core/htext2.lisp:1.2 phemlock/src/core/htext2.lisp:1.3
--- phemlock/src/core/htext2.lisp:1.2 Fri Jul 9 08:41:24 2004
+++ phemlock/src/core/htext2.lisp Tue Aug 10 05:47:07 2004
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
#+CMU (ext:file-comment
- "$Header: /project/phemlock/cvsroot/phemlock/src/core/htext2.lisp,v 1.2 2004/07/09 15:41:24 dbarlow Exp $")
+ "$Header: /project/phemlock/cvsroot/phemlock/src/core/htext2.lisp,v 1.3 2004/08/10 12:47:07 rstrandh Exp $")
;;;
;;; **********************************************************************
;;;
@@ -132,7 +132,8 @@
;;; join lines. We cannot just delete a character and insert the new one
;;; because the marks would not be right.
;;;
-(defun %set-next-character (mark character)
+(defun (setf next-character) (character mark)
+ "Sets the characters to the right of the given Mark."
(let* ((line (mark-line mark))
(buffer (line-%buffer line))
(next (line-next line)))
@@ -178,15 +179,13 @@
character)))))
character)
-;;; %Set-Previous-Character -- Internal
+;;; (SETF PREVIOUS-CHARACTER) -- Internal
;;;
-;;; The setf form for Previous-Character. We just Temporarily move the
-;;; mark back one and call %Set-Next-Character.
-;;;
-(defun %set-previous-character (mark character)
+(defun (setf previous-character) (character mark)
+ "Sets the character to the left of the given Mark."
(unless (mark-before mark)
(error "~S has no previous character, so it cannot be set." mark))
- (%set-next-character mark character)
+ (setf (next-character mark) character)
(mark-after mark)
character)
Index: phemlock/src/core/interp.lisp
diff -u phemlock/src/core/interp.lisp:1.1 phemlock/src/core/interp.lisp:1.2
--- phemlock/src/core/interp.lisp:1.1 Fri Jul 9 08:00:36 2004
+++ phemlock/src/core/interp.lisp Tue Aug 10 05:47:07 2004
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
#+CMU (ext:file-comment
- "$Header: /project/phemlock/cvsroot/phemlock/src/core/interp.lisp,v 1.1 2004/07/09 15:00:36 gbaumann Exp $")
+ "$Header: /project/phemlock/cvsroot/phemlock/src/core/interp.lisp,v 1.2 2004/08/10 12:47:07 rstrandh Exp $")
;;;
;;; **********************************************************************
;;;
@@ -136,20 +136,17 @@
(integer
(cons :bits (hemlock-ext:key-event-bits-modifiers entry))))))
-;;; %SET-KEY-TRANSLATION -- Internal
+;;; (SETF KEY-TRANSLATION) -- Internal
;;;
-(defun %set-key-translation (key new-value)
+(defun (setf key-translation) (new-value key)
+ "Set the key translation for a key. If set to null, deletes any
+ translation."
(let ((entry (cond ((and (consp new-value) (eq (car new-value) :bits))
(apply #'hemlock-ext:make-key-event-bits (cdr new-value)))
(new-value (crunch-key new-value))
(t new-value))))
(set-table-entry *key-translations* (crunch-key key) entry)
new-value))
-;;;
-(defsetf key-translation %set-key-translation
- "Set the key translation for a key. If set to null, deletes any
- translation.")
-
;;;; Interface Utility Functions:
@@ -314,13 +311,14 @@
(internal-make-command name documentation function))))))
-;;; COMMAND-NAME, %SET-COMMAND-NAME -- Public.
+;;; COMMAND-NAME, (SETF COMMAND-NAME) -- Public.
;;;
(defun command-name (command)
"Returns the string which is the name of Command."
(command-%name command))
;;;
-(defun %set-command-name (command new-name)
+(defun (setf command-name) (new-name command)
+ "Change a Hemlock command's name."
(check-type command command)
(check-type new-name string)
(setq new-name (coerce new-name 'simple-string))
@@ -376,7 +374,8 @@
;;;
;;; Set the flag so we know not to clear the command-type.
;;;
-(defun %set-last-command-type (type)
+(defun (setf last-command-type) (type)
+ "Set the Last-Command-Type for use by the next command."
(setq *last-command-type* type *command-type-set* t))
@@ -393,7 +392,7 @@
;;; %SET-PREFIX-ARGUMENT -- Internal
;;;
-(defun %set-prefix-argument (argument)
+(defun (setf prefix-argument) (argument)
"Set the prefix argument for the next command to Argument."
(unless (or (null argument) (integerp argument))
(error "Prefix argument ~S is neither an integer nor Nil." argument))
Index: phemlock/src/core/key-event.lisp
diff -u phemlock/src/core/key-event.lisp:1.1 phemlock/src/core/key-event.lisp:1.2
--- phemlock/src/core/key-event.lisp:1.1 Fri Jul 9 08:00:36 2004
+++ phemlock/src/core/key-event.lisp Tue Aug 10 05:47:07 2004
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
#+CMU (ext:file-comment
- "$Header: /project/phemlock/cvsroot/phemlock/src/core/key-event.lisp,v 1.1 2004/07/09 15:00:36 gbaumann Exp $")
+ "$Header: /project/phemlock/cvsroot/phemlock/src/core/key-event.lisp,v 1.2 2004/08/10 12:47:07 rstrandh Exp $")
;;;
;;; **********************************************************************
;;;
@@ -207,13 +207,13 @@
(:keysym (button-keysym data))
(:shifted-modifier-name (button-shifted-modifier-name data))))))
-;;; %SET-MOUSE-TRANSLATION-INFO -- Internal.
+;;; (setf MOUSE-TRANSLATION-INFO) -- Internal.
;;;
;;; This walks into *mouse-translation-info* the same way MOUSE-TRANSLATION-INFO
;;; does, filling in the data structure on an as-needed basis, and stores
;;; the value for the indicated info.
;;;
-(defun %set-mouse-translation-info (button event-key info value)
+(defun (setf mouse-translation-info) (value button event-key info)
(let ((event-dispatch (svref *mouse-translation-info* button)))
(unless event-dispatch
(setf event-dispatch
@@ -233,8 +233,6 @@
(setf (button-keysym data) value))
(:shifted-modifier-name
(setf (button-shifted-modifier-name data) value))))))
-;;;
-(defsetf mouse-translation-info %set-mouse-translation-info)
;;; DEFINE-MOUSE-KEYSYM -- Public.
;;;
@@ -607,13 +605,10 @@
(check-type key-event key-event)
(gethash key-event *key-event-characters*))
-(defun %set-key-event-char (key-event character)
+(defun (setf key-event-char) (character key-event)
(check-type character character)
(check-type key-event key-event)
(setf (gethash key-event *key-event-characters*) character))
-;;;
-(defsetf key-event-char %set-key-event-char)
-
;;; This maps characters to key-events. Users modify this by SETF'ing
;;; CHAR-KEY-EVENT.
@@ -625,13 +620,10 @@
(check-type char character)
(svref *character-key-events* (char-code char)))
-(defun %set-char-key-event (char key-event)
+(defun (setf char-key-event) (key-event char)
(check-type char character)
(check-type key-event key-event)
(setf (svref *character-key-events* (char-code char)) key-event))
-;;;
-(defsetf char-key-event %set-char-key-event)
-
;;;; DO-ALPHA-KEY-EVENTS.
Index: phemlock/src/core/ring.lisp
diff -u phemlock/src/core/ring.lisp:1.1 phemlock/src/core/ring.lisp:1.2
--- phemlock/src/core/ring.lisp:1.1 Fri Jul 9 08:00:36 2004
+++ phemlock/src/core/ring.lisp Tue Aug 10 05:47:07 2004
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
#+CMU (ext:file-comment
- "$Header: /project/phemlock/cvsroot/phemlock/src/core/ring.lisp,v 1.1 2004/07/09 15:00:36 gbaumann Exp $")
+ "$Header: /project/phemlock/cvsroot/phemlock/src/core/ring.lisp,v 1.2 2004/08/10 12:47:07 rstrandh Exp $")
;;;
;;; **********************************************************************
;;;
@@ -132,11 +132,12 @@
(aref vec (if (>= sum max) (- sum max) sum)))))))
-;;; %set-ring-ref -- Internal
+;;; (SETF RING-REF) -- Internal
;;;
;;; Setf form for ring-ref, set a ring element.
;;;
-(defun %set-ring-ref (ring index value)
+(defun (setf ring-ref) (value ring index)
+ "Set an element in a ring."
(declare (fixnum index))
(let* ((first (ring-first ring))
(diff (- (ring-bound ring) first))
Index: phemlock/src/core/struct.lisp
diff -u phemlock/src/core/struct.lisp:1.1 phemlock/src/core/struct.lisp:1.2
--- phemlock/src/core/struct.lisp:1.1 Fri Jul 9 08:00:36 2004
+++ phemlock/src/core/struct.lisp Tue Aug 10 05:47:07 2004
@@ -7,7 +7,7 @@
(in-package :hemlock-internals)
#+CMU (ext:file-comment
- "$Header: /project/phemlock/cvsroot/phemlock/src/core/struct.lisp,v 1.1 2004/07/09 15:00:36 gbaumann Exp $")
+ "$Header: /project/phemlock/cvsroot/phemlock/src/core/struct.lisp,v 1.2 2004/08/10 12:47:07 rstrandh Exp $")
;;;
;;; **********************************************************************
;;;
@@ -667,21 +667,6 @@
;;;; Some defsetfs:
-(defsetf buffer-writable %set-buffer-writable
- "Sets whether the buffer is writable and invokes the Buffer Writable Hook.")
-(defsetf buffer-name %set-buffer-name
- "Sets the name of a specified buffer, invoking the Buffer Name Hook.")
-(defsetf buffer-modified %set-buffer-modified
- "Make a buffer modified or unmodified.")
-(defsetf buffer-pathname %set-buffer-pathname
- "Sets the pathname of a buffer, invoking the Buffer Pathname Hook.")
-
-(defsetf getstring %set-string-table
- "Sets the value for a string-table entry, making a new one if necessary.")
-
-(defsetf window-buffer %set-window-buffer
- "Change the buffer a window is mapped to.")
-
(define-setf-expander value (var)
"Set the value of a Hemlock variable, calling any hooks."
(let ((svar (gensym)))
@@ -704,48 +689,3 @@
"Set a Hemlock variable's documentation."
`(%set-variable-documentation ,name ,kind ,where ,new-value))
-(defsetf buffer-minor-mode %set-buffer-minor-mode
- "Turn a buffer minor mode on or off.")
-(defsetf buffer-major-mode %set-buffer-major-mode
- "Set a buffer's major mode.")
-(defsetf previous-character %set-previous-character
- "Sets the character to the left of the given Mark.")
-(defsetf next-character %set-next-character
- "Sets the characters to the right of the given Mark.")
-(defsetf character-attribute %set-character-attribute
- "Set the value for a character attribute.")
-(defsetf character-attribute-hooks %set-character-attribute-hooks
- "Set the hook list for a Hemlock character attribute.")
-(defsetf ring-ref %set-ring-ref "Set an element in a ring.")
-(defsetf current-window %set-current-window "Set the current window.")
-(defsetf current-buffer %set-current-buffer
- "Set the current buffer, doing necessary stuff.")
-(defsetf mark-kind %set-mark-kind "Used to set the kind of a mark.")
-(defsetf buffer-region %set-buffer-region "Set a buffer's region.")
-(defsetf command-name %set-command-name
- "Change a Hemlock command's name.")
-(defsetf line-string %set-line-string
- "Replace the contents of a line.")
-(defsetf last-command-type %set-last-command-type
- "Set the Last-Command-Type for use by the next command.")
-(defsetf prefix-argument %set-prefix-argument
- "Set the prefix argument for the next command.")
-(defsetf logical-key-event-p %set-logical-key-event-p
- "Change what Logical-Char= returns for the specified arguments.")
-(defsetf window-font %set-window-font
- "Change the font-object associated with a font-number in a window.")
-(defsetf default-font %set-default-font
- "Change the font-object associated with a font-number in new windows.")
-
-(defsetf buffer-modeline-fields %set-buffer-modeline-fields
- "Sets the buffer's list of modeline fields causing all windows into buffer
- to be updated for the next redisplay.")
-(defsetf modeline-field-name %set-modeline-field-name
- "Sets a modeline-field's name. If one already exists with that name, an
- error is signaled.")
-(defsetf modeline-field-width %set-modeline-field-width
- "Sets a modeline-field's width and updates all the fields for all windows
- in any buffer whose fields list contains the field.")
-(defsetf modeline-field-function %set-modeline-field-function
- "Sets a modeline-field's function and updates this field for all windows in
- any buffer whose fields list contains the field.")
Index: phemlock/src/core/syntax.lisp
diff -u phemlock/src/core/syntax.lisp:1.1 phemlock/src/core/syntax.lisp:1.2
--- phemlock/src/core/syntax.lisp:1.1 Fri Jul 9 08:00:36 2004
+++ phemlock/src/core/syntax.lisp Tue Aug 10 05:47:07 2004
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
#+CMU (ext:file-comment
- "$Header: /project/phemlock/cvsroot/phemlock/src/core/syntax.lisp,v 1.1 2004/07/09 15:00:36 gbaumann Exp $")
+ "$Header: /project/phemlock/cvsroot/phemlock/src/core/syntax.lisp,v 1.2 2004/08/10 12:47:07 rstrandh Exp $")
;;;
;;; **********************************************************************
;;;
@@ -248,7 +248,8 @@
(with-attribute attribute
(attribute-descriptor-hooks obj)))
-(defun %set-character-attribute-hooks (attribute new-value)
+(defun (setf character-attribute-hooks) (new-value attribute)
+ "Set the hook list for a Hemlock character attribute."
(with-attribute attribute
(setf (attribute-descriptor-hooks obj) new-value)))
@@ -288,11 +289,12 @@
(not (null (gethash symbol *character-attributes*))))
-;;; %SET-CHARACTER-ATTRIBUTE -- Internal
+;;; (SETF CHARACTER-ATTRIBUTE) -- Internal
;;;
;;; Set the value of a character attribute.
;;;
-(defun %set-character-attribute (attribute character new-value)
+(defun (setf character-attribute) (new-value attribute character)
+ "Set the value for a character attribute."
(with-attribute attribute
(invoke-hook hemlock::character-attribute-hook attribute character new-value)
(invoke-hook (attribute-descriptor-hooks obj) attribute character new-value)
Index: phemlock/src/core/table.lisp
diff -u phemlock/src/core/table.lisp:1.1 phemlock/src/core/table.lisp:1.2
--- phemlock/src/core/table.lisp:1.1 Fri Jul 9 08:00:36 2004
+++ phemlock/src/core/table.lisp Tue Aug 10 05:47:07 2004
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
#+CMU (ext:file-comment
- "$Header: /project/phemlock/cvsroot/phemlock/src/core/table.lisp,v 1.1 2004/07/09 15:00:36 gbaumann Exp $")
+ "$Header: /project/phemlock/cvsroot/phemlock/src/core/table.lisp,v 1.2 2004/08/10 12:47:07 rstrandh Exp $")
;;;
;;; **********************************************************************
;;;
@@ -304,7 +304,7 @@
(values (value-node-value (svref nodes pos)) t)
(values nil nil))))))
-(defun %set-string-table (string table value)
+(defun (setf getstring) (value string table)
"Sets the value of String in Table to Value. If necessary, creates
a new entry in the string table."
(with-folded-string (folded len string (string-table-separator table))
Index: phemlock/src/core/window.lisp
diff -u phemlock/src/core/window.lisp:1.1 phemlock/src/core/window.lisp:1.2
--- phemlock/src/core/window.lisp:1.1 Fri Jul 9 08:00:36 2004
+++ phemlock/src/core/window.lisp Tue Aug 10 05:47:07 2004
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
#+CMU (ext:file-comment
- "$Header: /project/phemlock/cvsroot/phemlock/src/core/window.lisp,v 1.1 2004/07/09 15:00:36 gbaumann Exp $")
+ "$Header: /project/phemlock/cvsroot/phemlock/src/core/window.lisp,v 1.2 2004/08/10 12:47:07 rstrandh Exp $")
;;;
;;; **********************************************************************
;;;
@@ -33,7 +33,8 @@
Window-Buffer is always displayed. This may be set with Setf."
*current-window*)
-(defun %set-current-window (new-window)
+(defun (setf current-window) (new-window)
+ "Set the current window."
(invoke-hook hemlock::set-window-hook new-window)
(move-mark (window-point *current-window*)
(buffer-point (window-buffer *current-window*)))
@@ -56,7 +57,8 @@
"Return the buffer which is displayed in Window."
(window-%buffer window))
-(defun %set-window-buffer (window new-buffer)
+(defun (setf window-buffer) (new-buffer window)
+ "Change the buffer a window is mapped to."
(unless (bufferp new-buffer) (error "~S is not a buffer." new-buffer))
(unless (windowp window) (error "~S is not a window." window))
(unless (eq new-buffer (window-buffer window))
@@ -152,7 +154,9 @@
"Returns the name of a modeline field object."
(modeline-field-%name ml-field))
-(defun %set-modeline-field-name (ml-field name)
+(defun (setf modeline-field-name) (name ml-field)
+ "Sets a modeline-field's name. If one already exists with that name, an
+ error is signaled."
(check-type ml-field modeline-field)
(when (gethash name *modeline-field-names*)
(error "Modeline field ~S already exists."
@@ -167,7 +171,9 @@
(declaim (special *buffer-list*))
-(defun %set-modeline-field-width (ml-field width)
+(defun (setf modeline-field-width) (width ml-field)
+ "Sets a modeline-field's width and updates all the fields for all windows
+ in any buffer whose fields list contains the field."
(check-type ml-field modeline-field)
(unless (or (eq width nil) (and (integerp width) (plusp width)))
(error "Width must be nil or a positive integer."))
@@ -183,7 +189,9 @@
"Returns the function of a modeline field object. It returns a string."
(modeline-field-%function ml-field))
-(defun %set-modeline-field-function (ml-field function)
+(defun (setf modeline-field-function) (function ml-field)
+ "Sets a modeline-field's function and updates this field for all windows in
+ any buffer whose fields list contains the field."
(check-type ml-field modeline-field)
(check-type function (or symbol function))
(setf (modeline-field-%function ml-field) function)
More information about the Phemlock-cvs
mailing list