Function: nnmaildir-request-rename-group

nnmaildir-request-rename-group is a byte-compiled function defined in nnmaildir.el.gz.

Signature

(nnmaildir-request-rename-group GNAME NEW-NAME &optional SERVER)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnmaildir.el.gz
(defun nnmaildir-request-rename-group (gname new-name &optional server)
  (let ((group (nnmaildir--prepare server gname))
	(coding-system-for-write nnheader-file-coding-system)
	(buffer-file-coding-system nil)
	(file-coding-system-alist nil)
	srv-dir x groups)
    (catch 'return
      (unless group
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (concat "No such group: " gname))
	(throw 'return nil))
      (when (zerop (length new-name))
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      "Invalid (empty) group name")
	(throw 'return nil))
      (when (eq (aref "." 0) (aref new-name 0))
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      "Group names may not start with \".\"")
	(throw 'return nil))
      (when (save-match-data (string-match "[\0/\t]" new-name))
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (concat "Invalid characters (null, tab, or /) in group name: "
		      new-name))
	(throw 'return nil))
      (if (string-equal gname new-name) (throw 'return t))
      (when (gethash new-name
			 (nnmaildir--srv-groups nnmaildir--cur-server))
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (concat "Group already exists: " new-name))
	(throw 'return nil))
      (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server))
      (condition-case err
	  (rename-file (concat srv-dir gname)
		       (concat srv-dir new-name))
	(error
	 (setf (nnmaildir--srv-error nnmaildir--cur-server)
	       (concat "Error renaming link: " (prin1-to-string err)))
	 (throw 'return nil)))
      ;; FIXME: Why are we making copies of the group and the groups
      ;; hashtable?  Why not just set the group's new name, and puthash the
      ;; group under that new name?
      (setq x (nnmaildir--srv-groups nnmaildir--cur-server)
	    groups (gnus-make-hashtable (hash-table-size x)))
      (maphash (lambda (gname g)
		  (unless (eq g group)
		    (puthash gname g groups)))
		x)
      (setq group (copy-sequence group))
      (setf (nnmaildir--grp-name group) new-name)
      (puthash new-name group groups)
      (setf (nnmaildir--srv-groups nnmaildir--cur-server) groups)
      t)))