From strandh at labri.fr  Tue Aug 10 06:48:46 2004
From: strandh at labri.fr (Robert Strandh)
Date: Tue, 10 Aug 2004 08:48:46 +0200
Subject: [Phemlock-cvs] the CVS mailing list
Message-ID: <16664.28622.771924.637965@serveur5.labri.fr>

It seems like my commits do not show up on the phemlock-cvs mailing
list.  Does anybody know why? 

-- 
Robert Strandh

---------------------------------------------------------------------
Greenspun's Tenth Rule of Programming: any sufficiently complicated C
or Fortran program contains an ad hoc informally-specified bug-ridden
slow implementation of half of Common Lisp.
---------------------------------------------------------------------



From rstrandh at common-lisp.net  Tue Aug 10 05:24:16 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 05:24:16 -0000
Subject: [Phemlock-cvs] CVS update: phemlock/src/echo.lisp 
Message-ID: <E1BuP7Q-0006Ay-00@common-lisp.net>

Update of /project/phemlock/cvsroot/phemlock/src
In directory common-lisp.net:/tmp/cvs-serv994/src

Modified Files:
	echo.lisp 
Log Message:
Removed the string table *logical-key-event-names* as it was never
used, only written to. 

Added #k"control=[" as an alias for ESCAPE, because that is what
I use all the time (rather than trying to find the META key). 


Date: Mon Aug  9 22:24:15 2004
Author: rstrandh

Index: phemlock/src/echo.lisp
diff -u phemlock/src/echo.lisp:1.1.1.1 phemlock/src/echo.lisp:1.2
--- phemlock/src/echo.lisp:1.1.1.1	Fri Jul  9 06:37:45 2004
+++ phemlock/src/echo.lisp	Mon Aug  9 22:24:15 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/echo.lisp,v 1.1.1.1 2004/07/09 13:37:45 gbaumann Exp $")
+  "$Header: /project/phemlock/cvsroot/phemlock/src/echo.lisp,v 1.2 2004/08/10 05:24:15 rstrandh Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -559,10 +559,6 @@
 
 ;;;; Logical key-event stuff.
 
-(defvar *logical-key-event-names* (make-string-table)
-  "This variable holds a string-table from logical-key-event names to the
-   corresponding keywords.")
-
 (defvar *real-to-logical-key-events* (make-hash-table :test #'eql)
   "A hashtable from real key-events to their corresponding logical
    key-event keywords.")
@@ -648,9 +644,7 @@
 		    (setf (gethash keyword *logical-key-event-descriptors*)
 			  (make-logical-key-event-descriptor)))))
     (setf (logical-key-event-descriptor-name entry) name)
-    (setf (logical-key-event-descriptor-documentation entry) documentation)
-    (setf (getstring name *logical-key-event-names*) keyword)))
-
+    (setf (logical-key-event-descriptor-documentation entry) documentation)))
 
 
 ;;;; Some standard logical-key-events:




From rstrandh at common-lisp.net  Tue Aug 10 05:24:16 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 05:24:16 -0000
Subject: [Phemlock-cvs] CVS update: phemlock/src/core/package.lisp 
Message-ID: <E1BuP7Q-0006Hj-00@common-lisp.net>

Update of /project/phemlock/cvsroot/phemlock/src/core
In directory common-lisp.net:/tmp/cvs-serv994/src/core

Modified Files:
	package.lisp 
Log Message:
Removed the string table *logical-key-event-names* as it was never
used, only written to. 

Added #k"control=[" as an alias for ESCAPE, because that is what
I use all the time (rather than trying to find the META key). 


Date: Mon Aug  9 22:24:16 2004
Author: rstrandh

Index: phemlock/src/core/package.lisp
diff -u phemlock/src/core/package.lisp:1.1 phemlock/src/core/package.lisp:1.2
--- phemlock/src/core/package.lisp:1.1	Fri Jul  9 08:00:36 2004
+++ phemlock/src/core/package.lisp	Mon Aug  9 22:24:16 2004
@@ -660,7 +660,7 @@
    #:prompt-for-buffer #:prompt-for-file #:prompt-for-integer
    #:prompt-for-keyword #:prompt-for-expression #:prompt-for-string
    #:prompt-for-variable #:prompt-for-yes-or-no #:prompt-for-y-or-n
-   #:prompt-for-key-event #:prompt-for-key #:*logical-key-event-names*
+   #:prompt-for-key-event #:prompt-for-key
    #:logical-key-event-p #:logical-key-event-documentation
    #:logical-key-event-name #:logical-key-event-key-events
    #:define-logical-key-event #:*parse-type* #:current-variable-tables
@@ -860,6 +860,13 @@
   )
 
 ;; $Log: package.lisp,v $
+;; Revision 1.2  2004/08/10 05:24:16  rstrandh
+;; Removed the string table *logical-key-event-names* as it was never
+;; used, only written to.
+;;
+;; Added #k"control=[" as an alias for ESCAPE, because that is what
+;; I use all the time (rather than trying to find the META key).
+;;
 ;; Revision 1.1  2004/07/09 15:00:36  gbaumann
 ;; Let us see if this works.
 ;;




From rstrandh at common-lisp.net  Tue Aug 10 05:24:16 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 05:24:16 -0000
Subject: [Phemlock-cvs] CVS update: phemlock/src/user/bindings.lisp 
Message-ID: <E1BuP7Q-0006Js-00@common-lisp.net>

Update of /project/phemlock/cvsroot/phemlock/src/user
In directory common-lisp.net:/tmp/cvs-serv994/src/user

Modified Files:
	bindings.lisp 
Log Message:
Removed the string table *logical-key-event-names* as it was never
used, only written to. 

Added #k"control=[" as an alias for ESCAPE, because that is what
I use all the time (rather than trying to find the META key). 


Date: Mon Aug  9 22:24:16 2004
Author: rstrandh

Index: phemlock/src/user/bindings.lisp
diff -u phemlock/src/user/bindings.lisp:1.1.1.1 phemlock/src/user/bindings.lisp:1.2
--- phemlock/src/user/bindings.lisp:1.1.1.1	Fri Jul  9 06:38:49 2004
+++ phemlock/src/user/bindings.lisp	Mon Aug  9 22:24:16 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/user/bindings.lisp,v 1.1.1.1 2004/07/09 13:38:49 gbaumann Exp $")
+       "$Header: /project/phemlock/cvsroot/phemlock/src/user/bindings.lisp,v 1.2 2004/08/10 05:24:16 rstrandh Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -22,6 +22,7 @@
 ;;; the next character typed.
 ;;;
 (setf (key-translation #k"escape") '(:bits :meta))
+(setf (key-translation #k"control-[") '(:bits :meta))
 (setf (key-translation #k"control-z") '(:bits :control :meta))
 (setf (key-translation #k"control-Z") '(:bits :control :meta))
 (setf (key-translation #k"control-^") '(:bits :control))




From rstrandh at common-lisp.net  Tue Aug 10 05:58:04 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 05:58:04 -0000
Subject: [Phemlock-cvs] CVS update: phemlock/src/echo.lisp 
Message-ID: <E1BuPe8-00016e-00@common-lisp.net>

Update of /project/phemlock/cvsroot/phemlock/src
In directory common-lisp.net:/tmp/cvs-serv27169/src

Modified Files:
	echo.lisp 
Log Message:
Removed logical-key-event-name and logical-key-event-documentation
as they were never used. 

Date: Mon Aug  9 22:58:03 2004
Author: rstrandh

Index: phemlock/src/echo.lisp
diff -u phemlock/src/echo.lisp:1.2 phemlock/src/echo.lisp:1.3
--- phemlock/src/echo.lisp:1.2	Mon Aug  9 22:24:15 2004
+++ phemlock/src/echo.lisp	Mon Aug  9 22:58:03 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/echo.lisp,v 1.2 2004/08/10 05:24:15 rstrandh Exp $")
+  "$Header: /project/phemlock/cvsroot/phemlock/src/echo.lisp,v 1.3 2004/08/10 05:58:03 rstrandh Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -612,19 +612,6 @@
 	    (delete keyword (logical-key-event-descriptor-key-events entry))))))
   new-value)
 
-;;; LOGICAL-KEY-EVENT-DOCUMENTATION, NAME, KEY-EVENTS  --  Public
-;;;
-;;;    Grab the right field out of the descriptor and return it.
-;;;
-(defun logical-key-event-documentation (keyword)
-  "Return the documentation for the logical key-event Keyword."
-  (logical-key-event-descriptor-documentation
-   (get-logical-key-event-desc keyword)))
-;;;
-(defun logical-key-event-name (keyword)
-  "Return the string name for the logical key-event Keyword."
-  (logical-key-event-descriptor-name (get-logical-key-event-desc keyword)))
-;;;
 (defun logical-key-event-key-events (keyword)
   "Return the list of key-events for which Keyword is the logical key-event."
   (logical-key-event-descriptor-key-events
@@ -643,7 +630,6 @@
 	 (entry (or (gethash keyword *logical-key-event-descriptors*)
 		    (setf (gethash keyword *logical-key-event-descriptors*)
 			  (make-logical-key-event-descriptor)))))
-    (setf (logical-key-event-descriptor-name entry) name)
     (setf (logical-key-event-descriptor-documentation entry) documentation)))
 
 




From rstrandh at common-lisp.net  Tue Aug 10 05:58:04 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 05:58:04 -0000
Subject: [Phemlock-cvs] CVS update: phemlock/src/core/package.lisp 
Message-ID: <E1BuPe8-0001Bs-00@common-lisp.net>

Update of /project/phemlock/cvsroot/phemlock/src/core
In directory common-lisp.net:/tmp/cvs-serv27169/src/core

Modified Files:
	package.lisp 
Log Message:
Removed logical-key-event-name and logical-key-event-documentation
as they were never used. 

Date: Mon Aug  9 22:58:04 2004
Author: rstrandh

Index: phemlock/src/core/package.lisp
diff -u phemlock/src/core/package.lisp:1.2 phemlock/src/core/package.lisp:1.3
--- phemlock/src/core/package.lisp:1.2	Mon Aug  9 22:24:16 2004
+++ phemlock/src/core/package.lisp	Mon Aug  9 22:58:04 2004
@@ -204,8 +204,6 @@
    #:editor-finish-output
    #:define-logical-key-event
    #:logical-key-event-key-events
-   #:logical-key-event-name
-   #:logical-key-event-documentation
    #:logical-key-event-p
    #:clear-echo-area
    #:message
@@ -661,8 +659,8 @@
    #:prompt-for-keyword #:prompt-for-expression #:prompt-for-string
    #:prompt-for-variable #:prompt-for-yes-or-no #:prompt-for-y-or-n
    #:prompt-for-key-event #:prompt-for-key
-   #:logical-key-event-p #:logical-key-event-documentation
-   #:logical-key-event-name #:logical-key-event-key-events
+   #:logical-key-event-p
+   #:logical-key-event-key-events
    #:define-logical-key-event #:*parse-type* #:current-variable-tables
 
    ;; files.lisp
@@ -860,6 +858,10 @@
   )
 
 ;; $Log: package.lisp,v $
+;; Revision 1.3  2004/08/10 05:58:04  rstrandh
+;; Removed logical-key-event-name and logical-key-event-documentation
+;; as they were never used.
+;;
 ;; Revision 1.2  2004/08/10 05:24:16  rstrandh
 ;; Removed the string table *logical-key-event-names* as it was never
 ;; used, only written to.




From rstrandh at common-lisp.net  Tue Aug 10 06:34:43 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 06:34:43 -0000
Subject: [Phemlock-cvs] CVS update: phemlock/src/user/bindings.lisp 
Message-ID: <E1BuQDa-0004Ol-00@common-lisp.net>

Update of /project/phemlock/cvsroot/phemlock/src/user
In directory common-lisp.net:/tmp/cvs-serv23331/user

Modified Files:
	bindings.lisp 
Log Message:
Commented out some of the bindings that generated compile-time error
messages because the functionality was commented out in the
hemlock.system file.  There are lots left, though.


Date: Mon Aug  9 23:34:42 2004
Author: rstrandh

Index: phemlock/src/user/bindings.lisp
diff -u phemlock/src/user/bindings.lisp:1.2 phemlock/src/user/bindings.lisp:1.3
--- phemlock/src/user/bindings.lisp:1.2	Mon Aug  9 22:24:16 2004
+++ phemlock/src/user/bindings.lisp	Mon Aug  9 23:34:42 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/user/bindings.lisp,v 1.2 2004/08/10 05:24:16 rstrandh Exp $")
+       "$Header: /project/phemlock/cvsroot/phemlock/src/user/bindings.lisp,v 1.3 2004/08/10 06:34:42 rstrandh Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -321,24 +321,24 @@
 
 
 ;;;; Typescript.
-(bind-key "Confirm Typescript Input" #k"return" :mode "Typescript")
-(bind-key "Interactive Beginning of Line" #k"control-a" :mode "Typescript")
-(bind-key "Kill Interactive Input" #k"meta-i" :mode "Typescript")
-(bind-key "Previous Interactive Input" #k"meta-p" :mode "Typescript")
-(bind-key "Search Previous Interactive Input" #k"meta-P" :mode "Typescript")
-(bind-key "Next Interactive Input" #k"meta-n" :mode "Typescript")
-(bind-key "Reenter Interactive Input" #k"control-return" :mode "Typescript")
-(bind-key "Typescript Slave Break" #k"hyper-b" :mode "Typescript")
-(bind-key "Typescript Slave to Top Level" #k"hyper-g" :mode "Typescript")
-(bind-key "Typescript Slave Status" #k"hyper-s" :mode "Typescript")
-(bind-key "Select Slave" #k"control-meta-\c")
-(bind-key "Select Background" #k"control-meta-C")
+;; (bind-key "Confirm Typescript Input" #k"return" :mode "Typescript")
+;; (bind-key "Interactive Beginning of Line" #k"control-a" :mode "Typescript")
+;; (bind-key "Kill Interactive Input" #k"meta-i" :mode "Typescript")
+;; (bind-key "Previous Interactive Input" #k"meta-p" :mode "Typescript")
+;; (bind-key "Search Previous Interactive Input" #k"meta-P" :mode "Typescript")
+;; (bind-key "Next Interactive Input" #k"meta-n" :mode "Typescript")
+;; (bind-key "Reenter Interactive Input" #k"control-return" :mode "Typescript")
+;; (bind-key "Typescript Slave Break" #k"hyper-b" :mode "Typescript")
+;; (bind-key "Typescript Slave to Top Level" #k"hyper-g" :mode "Typescript")
+;; (bind-key "Typescript Slave Status" #k"hyper-s" :mode "Typescript")
+;; (bind-key "Select Slave" #k"control-meta-\c")
+;; (bind-key "Select Background" #k"control-meta-C")
 
-(bind-key "Abort Operations" #k"hyper-a")
-(bind-key "List Operations" #k"hyper-l")
+;; (bind-key "Abort Operations" #k"hyper-a")
+;; (bind-key "List Operations" #k"hyper-l")
 
-(bind-key "Next Compiler Error" #k"hyper-n")
-(bind-key "Previous Compiler Error" #k"hyper-p")
+;; (bind-key "Next Compiler Error" #k"hyper-n")
+;; (bind-key "Previous Compiler Error" #k"hyper-p")
 
 
 ;;;; Lisp (some).
@@ -474,20 +474,20 @@
 
 ;;;; Spell bindings.
 
-(bind-key "Check Word Spelling" #k"meta-$")
-(bind-key "Add Word to Spelling Dictionary" #k"control-x $")
+;; (bind-key "Check Word Spelling" #k"meta-$")
+;; (bind-key "Add Word to Spelling Dictionary" #k"control-x $")
 
-(dolist (info (command-bindings (getstring "Self Insert" *command-names*)))
-  (let* ((key (car info))
-         (key-event (svref key 0))
-         (character (key-event-char key-event)))
-    (unless (or (alpha-char-p character) (eq key-event #k"'"))
-      (bind-key "Auto Check Word Spelling" key :mode "Spell"))))
-(bind-key "Auto Check Word Spelling" #k"return" :mode "Spell")
-(bind-key "Auto Check Word Spelling" #k"tab" :mode "Spell")
-(bind-key "Auto Check Word Spelling" #k"linefeed" :mode "Spell")
-(bind-key "Correct Last Misspelled Word" #k"meta-:")
-(bind-key "Undo Last Spelling Correction" #k"control-x a")
+;; (dolist (info (command-bindings (getstring "Self Insert" *command-names*)))
+;;   (let* ((key (car info))
+;;          (key-event (svref key 0))
+;;          (character (key-event-char key-event)))
+;;     (unless (or (alpha-char-p character) (eq key-event #k"'"))
+;;       (bind-key "Auto Check Word Spelling" key :mode "Spell"))))
+;; (bind-key "Auto Check Word Spelling" #k"return" :mode "Spell")
+;; (bind-key "Auto Check Word Spelling" #k"tab" :mode "Spell")
+;; (bind-key "Auto Check Word Spelling" #k"linefeed" :mode "Spell")
+;; (bind-key "Correct Last Misspelled Word" #k"meta-:")
+;; (bind-key "Undo Last Spelling Correction" #k"control-x a")
 
 
 ;;;; Overwrite Mode.




From rstrandh at common-lisp.net  Tue Aug 10 12:47:07 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 12:47:07 -0000
Subject: [Phemlock-cvs] CVS update: phemlock/src/echo.lisp
	phemlock/src/font.lisp 
Message-ID: <E1BuW1y-0006UE-00@common-lisp.net>

Update of /project/phemlock/cvsroot/phemlock/src
In directory common-lisp.net:/tmp/cvs-serv10336/src

Modified Files:
	echo.lisp font.lisp 
Log Message:
Replaced most trivial defsetf with a corresponding (defun (setf ...) ...)


Date: Tue Aug 10 05:47:05 2004
Author: rstrandh

Index: phemlock/src/echo.lisp
diff -u phemlock/src/echo.lisp:1.3 phemlock/src/echo.lisp:1.4
--- phemlock/src/echo.lisp:1.3	Mon Aug  9 22:58:03 2004
+++ phemlock/src/echo.lisp	Tue Aug 10 05:47:04 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/echo.lisp,v 1.3 2004/08/10 05:58:03 rstrandh Exp $")
+  "$Header: /project/phemlock/cvsroot/phemlock/src/echo.lisp,v 1.4 2004/08/10 12:47:04 rstrandh Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -599,7 +599,8 @@
 ;;;    Add or remove a logical key-event link by adding to or deleting from
 ;;; the list in the from-char hashtable and the descriptor.
 ;;;
-(defun %set-logical-key-event-p (key-event keyword new-value)
+(defun (setf logical-key-event-p) (new-value key-event keyword)
+  "Change what Logical-Char= returns for the specified arguments."
   (let ((entry (get-logical-key-event-desc keyword)))
     (cond
      (new-value


Index: phemlock/src/font.lisp
diff -u phemlock/src/font.lisp:1.1.1.1 phemlock/src/font.lisp:1.2
--- phemlock/src/font.lisp:1.1.1.1	Fri Jul  9 06:37:45 2004
+++ phemlock/src/font.lisp	Tue Aug 10 05:47:04 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/font.lisp,v 1.1.1.1 2004/07/09 13:37:45 gbaumann Exp $")
+  "$Header: /project/phemlock/cvsroot/phemlock/src/font.lisp,v 1.2 2004/08/10 12:47:04 rstrandh Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -94,7 +94,8 @@
   "Returns a font id for window and font."
   (svref (font-family-map (bitmap-hunk-font-family (window-hunk window))) font))
 
-(defun %set-window-font (window font font-object)
+(defun (setf window-font) (font-object window font)
+  "Change the font-object associated with a font-number in a window."
   (unless (and (>= font 0) (< font font-map-size))
     (error "Font number ~S out of range." font))
   (setf (bitmap-hunk-trashed (window-hunk window)) :font-change)
@@ -109,7 +110,8 @@
   "Returns the font id for font out of the default font family."
   (svref (font-family-map *default-font-family*) font))
 
-(defun %set-default-font (font font-object)
+(defun (setf default-font) (font-object font)
+  "Change the font-object associated with a font-number in new windows."
   (unless (and (>= font 0) (< font font-map-size))
     (error "Font number ~S out of range." font))
   (dolist (w *window-list*)




From rstrandh at common-lisp.net  Tue Aug 10 12:47:07 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 12:47:07 -0000
Subject: [Phemlock-cvs] CVS update: phemlock/src/bitmap/bit-screen.lisp 
Message-ID: <E1BuW1y-0006UR-00@common-lisp.net>

Update of /project/phemlock/cvsroot/phemlock/src/bitmap
In directory common-lisp.net:/tmp/cvs-serv10336/src/bitmap

Modified Files:
	bit-screen.lisp 
Log Message:
Replaced most trivial defsetf with a corresponding (defun (setf ...) ...)


Date: Tue Aug 10 05:47:06 2004
Author: rstrandh

Index: phemlock/src/bitmap/bit-screen.lisp
diff -u phemlock/src/bitmap/bit-screen.lisp:1.1.1.1 phemlock/src/bitmap/bit-screen.lisp:1.2
--- phemlock/src/bitmap/bit-screen.lisp:1.1.1.1	Fri Jul  9 06:37:58 2004
+++ phemlock/src/bitmap/bit-screen.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/bitmap/bit-screen.lisp,v 1.1.1.1 2004/07/09 13:37:58 gbaumann Exp $")
+  "$Header: /project/phemlock/cvsroot/phemlock/src/bitmap/bit-screen.lisp,v 1.2 2004/08/10 12:47:06 rstrandh Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1123,19 +1123,19 @@
 
 ;;;; Setting window width and height.
 
-;;; %SET-WINDOW-WIDTH  --  Internal
+;;; (SETF WINDOW-WIDTH)  --  Internal
 ;;;
 ;;;    Since we don't support non-full-width windows, this does nothing.
 ;;;
-(defun %set-window-width (window new-value)
+(defun (setf window-width) (new-value window)
   (declare (ignore window))
   new-value)
 
-;;; %SET-WINDOW-HEIGHT  --  Internal
+;;; (SETF WINDOW-HEIGHT)  --  Internal
 ;;;
 ;;;    Can't change window height either.
 ;;;
-(defun %set-window-height (window new-value)
+(defun (setf window-height) (new-value window)
   (declare (ignore window))
   new-value)
 




From rstrandh at common-lisp.net  Tue Aug 10 12:47:08 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 12:47:08 -0000
Subject: [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 
Message-ID: <E1BuW1z-0006gS-00@common-lisp.net>

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)




From rstrandh at common-lisp.net  Tue Aug 10 12:47:08 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 12:47:08 -0000
Subject: [Phemlock-cvs] CVS update: phemlock/src/spell/correlate.lisp
	phemlock/src/spell/flags.lisp 
Message-ID: <E1BuW20-0006pl-00@common-lisp.net>

Update of /project/phemlock/cvsroot/phemlock/src/spell
In directory common-lisp.net:/tmp/cvs-serv10336/src/spell

Modified Files:
	correlate.lisp flags.lisp 
Log Message:
Replaced most trivial defsetf with a corresponding (defun (setf ...) ...)


Date: Tue Aug 10 05:47:08 2004
Author: rstrandh

Index: phemlock/src/spell/correlate.lisp
diff -u phemlock/src/spell/correlate.lisp:1.1.1.1 phemlock/src/spell/correlate.lisp:1.2
--- phemlock/src/spell/correlate.lisp:1.1.1.1	Fri Jul  9 06:38:12 2004
+++ phemlock/src/spell/correlate.lisp	Tue Aug 10 05:47:07 2004
@@ -201,10 +201,9 @@
 (declaim (inline desc-table-ref descriptor-ref))
 (defun desc-table-ref (dictionary index)
   (aref (descriptor-table dictionary) index))
-(defun %set-desc-table-ref (dictionary index value)
-  (setf (aref (descriptor-table dictionary) index) value))
 
-(defsetf desc-table-ref %set-desc-table-ref)
+(defun (setf desc-table-ref) (value dictionary index)
+  (setf (aref (descriptor-table dictionary) index) value))
 
 (defun descriptor-ref (dictionary index)
   (aref (descriptors dictionary) index))


Index: phemlock/src/spell/flags.lisp
diff -u phemlock/src/spell/flags.lisp:1.1.1.1 phemlock/src/spell/flags.lisp:1.2
--- phemlock/src/spell/flags.lisp:1.1.1.1	Fri Jul  9 06:38:12 2004
+++ phemlock/src/spell/flags.lisp	Tue Aug 10 05:47:08 2004
@@ -31,10 +31,8 @@
 (declaim (inline flag-mask))
 (defun flag-mask (char)
   (aref *flag-masks* (char-code char)))
-(defun %set-flag-mask (char value)
+(defun (setf flag-mask) (value char)
   (setf (aref *flag-masks* (char-code char)) value))
-
-(defsetf flag-mask %set-flag-mask)
 
 (dolist (e flag-names-to-masks)
   (let ((char (car e))




From rstrandh at common-lisp.net  Tue Aug 10 12:47:09 2004
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Tue, 10 Aug 2004 12:47:09 -0000
Subject: [Phemlock-cvs] CVS update: phemlock/src/user/netnews.lisp 
Message-ID: <E1BuW20-0006xU-00@common-lisp.net>

Update of /project/phemlock/cvsroot/phemlock/src/user
In directory common-lisp.net:/tmp/cvs-serv10336/src/user

Modified Files:
	netnews.lisp 
Log Message:
Replaced most trivial defsetf with a corresponding (defun (setf ...) ...)


Date: Tue Aug 10 05:47:08 2004
Author: rstrandh

Index: phemlock/src/user/netnews.lisp
diff -u phemlock/src/user/netnews.lisp:1.1.1.1 phemlock/src/user/netnews.lisp:1.2
--- phemlock/src/user/netnews.lisp:1.1.1.1	Fri Jul  9 06:38:33 2004
+++ phemlock/src/user/netnews.lisp	Tue Aug 10 05:47:08 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/user/netnews.lisp,v 1.1.1.1 2004/07/09 13:38:33 gbaumann Exp $")
+  "$Header: /project/phemlock/cvsroot/phemlock/src/user/netnews.lisp,v 1.2 2004/08/10 12:47:08 rstrandh Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -506,7 +506,7 @@
 		following ~S in database file."
 		       group-name))))))))
 
-(defun %set-nn-last-read-message-number (group-name new-value)
+(defun (setf nn-last-read-message-number) (new-value group-name)
   (with-open-file (s (merge-pathnames (value netnews-database-file)
 				      (user-homedir-pathname))
 		     :direction :io :if-does-not-exist :error
@@ -527,8 +527,6 @@
 		  (return t))))
       (write-line group-name s)
       (format s "~14D~%" new-value))))
-
-(defsetf nn-last-read-message-number %set-nn-last-read-message-number)
 
 (defconstant nntp-eof ".
"
   "NNTP marks the end of a textual response with this.  NNTP also recognizes