+
+;;;
+;;; Server compaction
+;;;
+
+;; #### FIXME: this function currently fails to update the Group buffer's
+;; #### FIXME: appearance. -- dvl
+(defun gnus-server-compact-server ()
+ "Issue a command to the server to compact all its groups."
+ (interactive)
+ (let ((server (gnus-server-server-name)))
+ (unless server
+ (error "No server on the current line"))
+ (condition-case ()
+ (gnus-get-function (gnus-server-to-method server)
+ 'request-compact)
+ (error
+ (error "This back end doesn't support compaction")))
+ (gnus-message 5 "\
+Requesting compaction of %s... (this may take a long time)"
+ server)
+ (unless (gnus-open-server server)
+ (error "Couldn't open server"))
+ (if (gnus-request-compact server)
+ (gnus-message 5 "Requesting compaction of %s...done" server)
+ (gnus-message 5 "Couldn't compact %s" server))))
+