Function: speedbar-prefix-group-tag-hierarchy

speedbar-prefix-group-tag-hierarchy is a byte-compiled function defined in speedbar.el.gz.

Signature

(speedbar-prefix-group-tag-hierarchy LST)

Documentation

Prefix group names for tag hierarchy LST.

Source Code

;; Defined in /usr/src/emacs/lisp/speedbar.el.gz
(defun speedbar-prefix-group-tag-hierarchy (lst)
  "Prefix group names for tag hierarchy LST."
  (let ((newlst nil)
	(sublst nil)
	(work-list nil)
	(junk-list nil)
	(short-group-list nil)
	(short-start-name nil)
	(short-end-name nil)
	(num-shorts-grouped 0)
	(bins (make-vector 256 nil))
	(diff-idx 0))
    (if (<= (length lst) speedbar-tag-regroup-maximum-length)
	;; Do nothing.  Too short to bother with.
	lst
      ;; Break out sub-lists
      (while lst
	(if (speedbar-generic-list-group-p (car-safe lst))
	    (setq newlst (cons (car lst) newlst))
	  (setq sublst (cons (car lst) sublst)))
	(setq lst (cdr lst)))
      ;; Reverse newlst because it was made backwards.
      ;; Sublist doesn't need reversing because the act
      ;; of binning things will reverse it for us.
      (setq newlst (nreverse newlst)
	    sublst sublst)
      ;; Now, first find out how long our list is.  Never let a
      ;; list get-shorter than our minimum.
      (if (<= (length sublst) speedbar-tag-split-minimum-length)
	  (setq work-list sublst)
	(setq diff-idx (length (speedbar-try-completion "" sublst)))
	;; Sort the whole list into bins.
	(while sublst
	  (let ((e (car sublst))
		(s (car (car sublst))))
	    (cond ((<= (length s) diff-idx)
		   ;; 0 storage bin for shorty.
		   (aset bins 0 (cons e (aref bins 0))))
		  (t
		   ;; stuff into a bin based on ascii value at diff
		   (aset bins (aref s diff-idx)
			 (cons e (aref bins (aref s diff-idx)))))))
	  (setq sublst (cdr sublst)))
	;; Go through all our bins  Stick singles into our
	;; junk-list, everything else as sublsts in work-list.
	;; If two neighboring lists are both small, make a grouped
	;; group combining those two sub-lists.
	(setq diff-idx 0)
	(while (> 256 diff-idx)
	  ;; The bins contents are currently in forward order.
	  (let ((l (aref bins diff-idx)))
	    (if l
		(let ((tmp (cons (speedbar-try-completion "" l) l)))
		  (if (or (> (length l) speedbar-tag-regroup-maximum-length)
			  (> (+ (length l) (length short-group-list))
			     speedbar-tag-split-minimum-length))
		      (progn
			;; We have reached a longer list, so we
			;; must finish off a grouped group.
			(cond
			 ((and short-group-list
			       (= (length short-group-list)
				  num-shorts-grouped))
			  ;; All singles?  Junk list
			  (setq junk-list (append (nreverse short-group-list)
						  junk-list)))
			 ((= num-shorts-grouped 1)
			  ;; Only one short group?  Just stick it in
			  ;; there by itself.  Make a group, and find
			  ;; a subexpression
			  (let ((subexpression (speedbar-try-completion
						"" short-group-list)))
			    (if (< (length subexpression)
				   speedbar-tag-group-name-minimum-length)
				(setq subexpression
				      (concat short-start-name
					      " ("
					      (substring
					       (car (car short-group-list))
					       (length short-start-name))
					      ")")))
			    (setq work-list
				  (cons (cons subexpression
					      short-group-list)
					work-list ))))
			 (short-group-list
			  ;; Multiple groups to be named in a special
			  ;; way by displaying the range over which we
			  ;; have grouped them.
			  (setq work-list
				(cons (cons
                                       (concat short-start-name
					       " to " short-end-name)
                                       (sort (copy-sequence short-group-list)
                                             (lambda (e1 e2)
                                               (string< (car e1)
                                                        (car e2)))))
				      work-list))))
		     ;; Reset short group list information every time.
			(setq short-group-list nil
			      short-start-name nil
			      short-end-name nil
			      num-shorts-grouped 0)))
		  ;; Ok, now that we cleaned up the short-group-list,
		  ;; we can deal with this new list, to decide if it
		  ;; should go on one of these sub-lists or not.
		  (if (< (length l) speedbar-tag-regroup-maximum-length)
		      (setq short-group-list (append l short-group-list)
			    num-shorts-grouped (1+ num-shorts-grouped)
			    short-end-name (car tmp)
			    short-start-name (if short-start-name
						 short-start-name
					       (car tmp)))
		    (setq work-list (cons tmp work-list))))))
	  (setq diff-idx (1+ diff-idx))))
      ;; Did we run out of things?  Drop our new list onto the end.
      (cond
       ((and short-group-list (= (length short-group-list) num-shorts-grouped))
	;; All singles?  Junk list
	(setq junk-list (append short-group-list junk-list)))
       ((= num-shorts-grouped 1)
	;; Only one short group?  Just stick it in
	;; there by itself.
	(setq work-list
	      (cons (cons (speedbar-try-completion "" short-group-list)
			  short-group-list)
		    work-list)))
       (short-group-list
	;; Multiple groups to be named in a special
	;; way by displaying the range over which we
	;; have grouped them.
	(setq work-list
	      (cons (cons (concat short-start-name " to " short-end-name)
			  short-group-list)
		    work-list))))
      ;; Reverse the work list nreversed when consing.
      (setq work-list (nreverse work-list))
      ;; Now, stick our new list onto the end of
      (if work-list
	  (if junk-list
	      (append newlst work-list junk-list)
	    (append newlst work-list))
	(append  newlst junk-list)))))