Function: msb--choose-file-menu

msb--choose-file-menu is a byte-compiled function defined in msb.el.gz.

Signature

(msb--choose-file-menu LIST)

Documentation

Choose file-menu with respect to directory for every buffer in LIST.

Source Code

;; Defined in /usr/src/emacs/lisp/msb.el.gz
(defun msb--choose-file-menu (list)
  "Choose file-menu with respect to directory for every buffer in LIST."
  (setq msb--choose-file-menu-arg-list list)
  (let ((buffer-alist (msb--init-file-alist list))
	(final-list nil)
	(max-clumped-together (if (numberp msb-max-file-menu-items)
				  msb-max-file-menu-items
				10))
	(top-found-p nil)
	(last-dir nil)
	first rest dir buffers old-dir)
    ;; Prepare for looping over all items in buffer-alist
    (setq first (car buffer-alist)
	  rest (cdr buffer-alist)
	  dir (car first)
	  buffers (cdr first))
    (setq msb--choose-file-menu-list (copy-sequence rest))
    ;; This big loop tries to clump buffers together that have a
    ;; similar name. Remember that buffer-alist is sorted based on the
    ;; directory name of the buffers' visited files.
    (while rest
      (let ((found-p nil)
	    (tmp-rest rest)
            item)
	(setq item (car tmp-rest))
	;; Clump together the "rest"-buffers that have a dir that is
	;; a subdir of the current one.
	(while (and tmp-rest
		    (<= (length buffers) max-clumped-together)
		    (>= (length (car item)) (length dir))
		    ;; `completion-ignore-case' seems to default to t
		    ;; on the systems with case-insensitive file names.
		    (eq t (compare-strings dir 0 nil
					   (car item) 0 (length dir)
					   completion-ignore-case)))
	  (setq found-p t)
	  (setq buffers (append buffers (cdr item))) ;nconc is faster than append
	  (setq tmp-rest (cdr tmp-rest)
		item (car tmp-rest)))
	(cond
	 ((> (length buffers) max-clumped-together)
	  ;; Oh, we failed. Too many buffers clumped together.
	  ;; Just use the original ones for the result.
	  (setq last-dir (car first))
	  (push (cons (msb--format-title top-found-p
					 (car first)
					 (length (cdr first)))
		      (cdr first))
		final-list)
	  (setq top-found-p nil)
	  (setq first (car rest)
		rest (cdr rest)
		dir (car first)
		buffers (cdr first)))
	 (t
	  ;; The first pass of clumping together worked out, go ahead
	  ;; with this result.
	  (when found-p
	    (setq top-found-p t)
	    (setq first (cons dir buffers)
		  rest tmp-rest))
	  ;; Now see if we can clump more buffers together if we go up
	  ;; one step in the file hierarchy.
	  ;; If dir isn't changed by msb--strip-dir, we are looking
	  ;; at the machine name component of an ange-ftp filename.
	  (setq old-dir dir)
	  (setq dir (msb--strip-dir dir)
		buffers (cdr first))
	  (if (equal old-dir dir)
	      (setq last-dir dir))
	  (when (and last-dir
		     (or (and (>= (length dir) (length last-dir))
			      (eq t (compare-strings
				     last-dir 0 nil dir 0
				     (length last-dir)
				     completion-ignore-case)))
			 (and (< (length dir) (length last-dir))
			      (eq t (compare-strings
				     dir 0 nil last-dir 0 (length dir)
				     completion-ignore-case)))))
	    ;; We have reached the same place in the file hierarchy as
	    ;; the last result, so we should quit at this point and
	    ;; take what we have as result.
	    (push (cons (msb--format-title top-found-p
					   (car first)
					   (length (cdr first)))
			(cdr first))
		  final-list)
	    (setq top-found-p nil)
	    (setq first (car rest)
		  rest (cdr rest)
		  dir (car first)
		  buffers (cdr first)))))))
    ;; Now take care of the last item.
    (when first
      (push (cons (msb--format-title top-found-p
				     (car first)
				     (length (cdr first)))
		  (cdr first))
	    final-list))
    (setq top-found-p nil)
    (nreverse final-list)))