Function: gnus-short-group-name

gnus-short-group-name is a byte-compiled function defined in gnus.el.gz.

Signature

(gnus-short-group-name GROUP &optional LEVELS)

Documentation

Collapse GROUP name LEVELS.

Select methods are stripped and any remote host name is stripped down to just the host name.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus.el.gz
(defun gnus-short-group-name (group &optional levels)
  "Collapse GROUP name LEVELS.
Select methods are stripped and any remote host name is stripped down to
just the host name."
  (let* ((foreign "")
	 (depth 0)
	 (skip 1)
	 (levels (or levels
		     gnus-group-uncollapsed-levels
		     (progn
		       (while (string-match "\\." group skip)
			 (setq skip (match-end 0)
			       depth (+ depth 1)))
		       depth))))
    ;; Separate foreign select method from group name and collapse.
    ;; If method contains a server, collapse to non-domain server name,
    ;; otherwise collapse to select method.
    (let* ((colon (string-search ":" group))
	   (server (and colon (substring group 0 colon)))
	   (plus (and server (string-search "+" server))))
      (when server
	(if plus
	    (setq foreign (substring server (+ 1 plus)
				     (string-search "." server))
		  group (substring group (+ 1 colon)))
	  (setq foreign server
		group (substring group (+ 1 colon))))
	(setq foreign (concat foreign ":")))
      ;; Remove braces from name (common in IMAP groups).
      (setq group (replace-regexp-in-string "[][]+" "" group))
      ;; Collapse group name leaving LEVELS uncollapsed elements
      (let* ((slist (split-string group "/"))
	     (slen (length slist))
	     (dlist (split-string group "\\."))
	     (dlen (length dlist))
	     glist
	     glen
	     gsep
	     res)
	(if (> slen dlen)
	    (setq glist slist
		  glen slen
		  gsep "/")
	  (setq glist dlist
		glen dlen
		gsep "."))
	(setq levels (- glen levels))
	(dolist (g glist)
	  (push (if (>= (cl-decf levels) 0)
		    (if (zerop (length g))
			""
		      (substring g 0 1))
		  g)
		res))
	(concat foreign (mapconcat #'identity (nreverse res) gsep))))))