comparison lisp/msb.el @ 20505:10abc15f305a

Fix copyright notice. (msb--home-dir): Renamed from msb--home-path. (msb--strip-dir): Renamed from msb--strip-path.
author Richard M. Stallman <rms@gnu.org>
date Mon, 22 Dec 1997 02:33:25 +0000
parents 1b8aec1c12f1
children c096aa581013
comparison
equal deleted inserted replaced
20504:1b8aec1c12f1 20505:10abc15f305a
1 ;;; msb.el --- Customizable buffer-selection with multiple menus. 1 ;;; msb.el --- Customizable buffer-selection with multiple menus.
2 2
3 ;; Copyright (C) 1993, 1994, 1995, 1997 Lars Lindberg 3 ;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
4 ;; <Lars.G.Lindberg@capgemini.se>
5 ;; <Lars.G.Lindberg@mailbox.swipnet.se>
6 4
7 ;; Author: Lars Lindberg <Lars.G.Lindberg@capgemini.se> 5 ;; Author: Lars Lindberg <Lars.G.Lindberg@capgemini.se>
8 ;; Created: 8 Oct 1993 6 ;; Created: 8 Oct 1993
9 ;; Lindberg's last update version: 3.33 7 ;; Lindberg's last update version: 3.33
10 ;; Keywords: mouse buffer menu 8 ;; Keywords: mouse buffer menu
337 ;;; 335 ;;;
338 ;;; Internal variables 336 ;;; Internal variables
339 ;;; 337 ;;;
340 338
341 ;; Home directory for the current user 339 ;; Home directory for the current user
342 (defvar msb--home-path 340 (defvar msb--home-dir
343 (condition-case nil 341 (condition-case nil
344 (substitute-in-file-name "$HOME") 342 (substitute-in-file-name "$HOME")
345 ;; If $HOME isn't defined, use nil 343 ;; If $HOME isn't defined, use nil
346 (error nil))) 344 (error nil)))
347 345
454 "Return t if optional BUFFER is an \"invisible\" buffer. 452 "Return t if optional BUFFER is an \"invisible\" buffer.
455 If the argument is left out or nil, then the current buffer is considered." 453 If the argument is left out or nil, then the current buffer is considered."
456 (and (> (length (buffer-name buffer)) 0) 454 (and (> (length (buffer-name buffer)) 0)
457 (eq ?\ (aref (buffer-name buffer) 0)))) 455 (eq ?\ (aref (buffer-name buffer) 0))))
458 456
459 ;; Strip one hierarchy level from the end of PATH. 457 ;; Strip one hierarchy level from the end of DIR.
460 (defun msb--strip-path (path) 458 (defun msb--strip-dir (dir)
461 (save-match-data 459 (save-match-data
462 (cond 460 (cond
463 ((string-match "^\\([^/]*/.+/\\)[^/]+$" path) 461 ((string-match "^\\([^/]*/.+/\\)[^/]+$" dir)
464 (substring path (match-beginning 1) (match-end 1))) 462 (substring dir (match-beginning 1) (match-end 1)))
465 ((string-match "^\\([^/]*/\\)" path) 463 ((string-match "^\\([^/]*/\\)" dir)
466 (substring path (match-beginning 1) (match-end 1))) 464 (substring dir (match-beginning 1) (match-end 1)))
467 (t 465 (t
468 (error "msb: Path '%s' has an unrecognized format" path))))) 466 (error "msb: Directory `%s' has an unrecognized format" dir)))))
469 467
470 ;; Create an alist with all buffers from LIST that lies under the same 468 ;; Create an alist with all buffers from LIST that lies under the same
471 ;; directory will be in the same item as the directory string. 469 ;; directory will be in the same item as the directory string.
472 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) = 470 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) =
473 ...) 471 ...)
480 (function 478 (function
481 (lambda (buffer) 479 (lambda (buffer)
482 (let ((file-name (expand-file-name (buffer-file-name buffer)))) = 480 (let ((file-name (expand-file-name (buffer-file-name buffer)))) =
483 ;LGL 971218 481 ;LGL 971218
484 (when file-name 482 (when file-name
485 (list (cons (msb--strip-path file-name) buffer)))))) 483 (list (cons (msb--strip-dir file-name) buffer))))))
486 list) 484 list)
487 (function (lambda (item1 item2) 485 (function (lambda (item1 item2)
488 (string< (car item1) (car item2))))))) 486 (string< (car item1) (car item2)))))))
489 ;; Now clump buffers togehter that have the same path 487 ;; Now clump buffers togehter that have the same path
490 ;; Make alist that looks like 488 ;; Make alist that looks like
514 (list (cons path buffers)))))) 512 (list (cons path buffers))))))
515 513
516 ;; Format a suitable title for the menu item. 514 ;; Format a suitable title for the menu item.
517 (defun msb--format-title (top-found-p path number-of-items) 515 (defun msb--format-title (top-found-p path number-of-items)
518 (let ((new-path path)) 516 (let ((new-path path))
519 (when (and msb--home-path 517 (when (and msb--home-dir
520 (string-match (concat "^" msb--home-path) path)) 518 (string-match (concat "^" msb--home-dir) path))
521 (setq new-path (concat "~/" 519 (setq new-path (concat "~/"
522 (substring path (match-end 0))))) 520 (substring path (match-end 0)))))
523 (format (if top-found-p "%s... (%d)" "%s (%d)") 521 (format (if top-found-p "%s... (%d)" "%s (%d)")
524 new-path number-of-items))) 522 new-path number-of-items)))
525 523
580 (setq top-found-p t) 578 (setq top-found-p t)
581 (setq first (cons path buffers) 579 (setq first (cons path buffers)
582 rest tmp-rest)) 580 rest tmp-rest))
583 ;; Now see if we can clump more buffers together if we go up 581 ;; Now see if we can clump more buffers together if we go up
584 ;; one step in the file hierarchy. 582 ;; one step in the file hierarchy.
585 (setq path (msb--strip-path path) 583 (setq path (msb--strip-dir path)
586 buffers (cdr first)) 584 buffers (cdr first))
587 (when (and last-path 585 (when (and last-path
588 (or (and (>= (length path) (length last-path)) 586 (or (and (>= (length path) (length last-path))
589 (string= last-path 587 (string= last-path
590 (substring path 0 (length last-path)))) 588 (substring path 0 (length last-path))))