comparison lisp/speedbar.el @ 89966:d8411455de48

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-32 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-486 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-487 Tweak permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-488 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-489 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-490 Update from CVS: man/fixit.texi (Spelling): Fix typo. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-491 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-494 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-495 Update from CVS: Add missing lisp/mh-e files * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-496 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-499 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-500 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-513 Update from CVS

89965:5e9097d1ad99

;; which controls how tags are layed out.  It is actually a list of
;; functions that filter the data.  The default groups large tag lists
;; into sub-lists.  A long flat list can be used instead if needed.
;; Other filters can be easily added.
;;
;;    AUC-TEX users: The imenu tags for AUC-TEX mode doesn't work very
;; well.  Use the imenu keywords from tex-mode.el for better results.
;;
;; This file requires the library package assoc (association lists)
;;
;;; Developing for speedbar

	    noext (cdr noext)))
    ;;               backup      refdir      lockfile
    (concat nstr "\\|#[^#]+#$\\|\\.\\.?\\'\\|\\.#"))
  "*Regexp matching files we don't want displayed in a speedbar buffer.
It is generated from the variable `completion-ignored-extensions'")

;; this is dangerous to customize, because the defaults will probably
;; change in the future.
(defcustom speedbar-supported-extension-expressions
  (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?"

  :group 'speedbar
  :version "21.1"
  :type '(repeat (regexp :tag "Extension Regexp"))
  :set (lambda (sym val)
	 (setq speedbar-supported-extension-expressions val
	       speedbar-file-regexp (speedbar-extension-list-to-regex val)))
  )

(defvar speedbar-file-regexp
  (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
  "Regular expression matching files we know how to expand.
Created from `speedbar-supported-extension-expression' with the
function `speedbar-extension-list-to-regex'")

(defun speedbar-add-supported-extension (extension)
  "Add EXTENSION as a new supported extension for speedbar tagging.
This should start with a `.' if it is not a complete file name, and
the dot should NOT be quoted in with \\.  Other regular expression

						   (speedbar-frame-mode -1)))))
	      t t)
    (toggle-read-only 1)
    (speedbar-set-mode-line-format)
    (if speedbar-xemacsp
	(set (make-local-variable 'mouse-motion-handler)
	     'speedbar-track-mouse-xemacs)
      (if speedbar-track-mouse-flag
	  (set (make-local-variable 'track-mouse) t))	;this could be messy.
      (setq auto-show-mode nil))	;no auto-show for Emacs
    (run-hooks 'speedbar-mode-hook))
  (speedbar-update-contents)

  "Set the format of the mode line based on the current speedbar environment.
This gives visual indications of what is up.  It EXPECTS the speedbar
frame and window to be the currently active frame and window."
  (if (and (frame-live-p speedbar-frame)
	   (or (not speedbar-xemacsp)
	       (specifier-instance has-modeline-p)))
      (save-excursion
	(set-buffer speedbar-buffer)
	(let* ((w (or (speedbar-frame-width) 20))
	       (p1 "<<")
	       (p5 ">>")

  (save-excursion
    (mouse-set-point e)
    ;; This gets the cursor where the user can see it.
    (if (not (bolp)) (forward-char -1))
    (sit-for 0)
    (if (< emacs-major-version 20)
	(mouse-major-mode-menu e)
      (mouse-major-mode-menu e nil))))

(defun speedbar-hack-buffer-menu (e)
  "Control mouse 1 is buffer menu.
This hack overrides it so that the right thing happens in the main
Emacs frame, not in the speedbar frame.

  (if speedbar-power-click
      (adelete 'speedbar-directory-contents-alist directory))
  ;; find the directory, either in the cache, or build it.
  (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
      (let ((default-directory directory)
	    (dir (directory-files directory nil))
	    (dirs nil)
	    (files nil))
	(while dir
	  (if (not
	       (or (string-match speedbar-file-unshown-regexp (car dir))
		   (string-match speedbar-directory-unshown-regexp (car dir))))
	      (if (file-directory-p (car dir))
		  (setq dirs (cons (car dir) dirs))
		(setq files (cons (car dir) files))))
	  (setq dir (cdr dir)))
	(let ((nl (cons (nreverse dirs) (list (nreverse files)))))
	  (aput 'speedbar-directory-contents-alist directory nl)
	  nl))
      ))

(defun speedbar-directory-buttons (directory index)
  "Insert a single button group at point for DIRECTORY.
Each directory path part is a different button.  If part of the path
matches the user directory ~, then it is replaced with a ~.

	  (speedbar-insert-image-button-maybe (- (point) 2) 3)))))


;;; Build button lists
;;
(defun speedbar-insert-files-at-point (files level)
  "Insert list of FILES starting at point, and indenting all files to LEVEL.
Tag expandable items with a +, otherwise a ?.  Don't highlight ? as we
don't know how to manage them.  The input parameter FILES is a cons
cell of the form ( 'DIRLIST .  'FILELIST )."
  ;; Start inserting all the directories
  (let ((dirs (car files)))
    (while dirs
      (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
			      (car dirs) 'speedbar-dir-follow nil
			      'speedbar-directory-face level)
      (setq dirs (cdr dirs))))
  (let ((lst (car (cdr files)))
	(case-fold-search t))
    (while lst
      (let* ((known (string-match speedbar-file-regexp (car lst)))
	     (expchar (if known ?+ ??))
	     (fn (if known 'speedbar-tag-file nil)))
	(if (or speedbar-show-unknown-files (/= expchar ??))
	    (speedbar-make-tag-line 'bracket expchar fn (car lst)
				    (car lst) 'speedbar-find-file nil
				    'speedbar-file-face level)))
      (setq lst (cdr lst)))))

(defun speedbar-default-directory-list (directory index)
  "Insert files for DIRECTORY with level INDEX at point."
  (speedbar-insert-files-at-point
   (speedbar-file-lists directory) index)
  (speedbar-reset-scanners)
  (if (= index 0)
      ;; If the shown files variable has extra directories, then
      ;; it is our responsibility to redraw them all
      ;; Luckilly, the nature of inserting items into this list means

		     (select-frame lastf)
		     rf)))
	 (newcf (if newcfd newcfd))
	 (lastb (current-buffer))
	 (sucf-recursive (boundp 'sucf-recursive))
	 (case-fold-search t))
    (if (and newcf
	     ;; check here, that way we won't refresh to newcf until
	     ;; its been written, thus saving ourselves some time
	     (file-exists-p newcf)
	     (not (string= newcf speedbar-last-selected-file)))

	 (make-glyph
	  (make-image-specifier
	   (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
	  'buffer)
       (error nil))
     ,docstring))

)))

(defimage-speedbar speedbar-directory-plus
  ((:type xpm :file "sb-dir-plus.xpm" :ascent center))
  "Image used for closed directories with stuff in them.")

(defimage-speedbar speedbar-directory-minus
  ((:type xpm :file "sb-dir-minus.xpm" :ascent center))
  "Image used for open directories with stuff in them.")

(defimage-speedbar speedbar-page-plus
  ((:type xpm :file "sb-pg-plus.xpm" :ascent center))
  "Image used for closed files with stuff in them.")

(defimage-speedbar speedbar-page-minus

  "Image used for open tag groups.")

(defvar speedbar-expand-image-button-alist
  '(("<+>" . speedbar-directory-plus)
    ("<->" . speedbar-directory-minus)
    ("[+]" . speedbar-page-plus)
    ("[-]" . speedbar-page-minus)
    ("[?]" . speedbar-page)
    ("{+}" . speedbar-tag-plus)
    ("{-}" . speedbar-tag-minus)

89966:d8411455de48

;; which controls how tags are layed out.  It is actually a list of
;; functions that filter the data.  The default groups large tag lists
;; into sub-lists.  A long flat list can be used instead if needed.
;; Other filters can be easily added.
;;
;;    AUCTEX users: The imenu tags for AUCTEX mode doesn't work very
;; well.  Use the imenu keywords from tex-mode.el for better results.
;;
;; This file requires the library package assoc (association lists)
;;
;;; Developing for speedbar

	    noext (cdr noext)))
    ;;               backup      refdir      lockfile
    (concat nstr "\\|#[^#]+#$\\|\\.\\.?\\'\\|\\.#"))
  "*Regexp matching files we don't want displayed in a speedbar buffer.
It is generated from the variable `completion-ignored-extensions'")

;; Compiler silencing trick.  The real defvar comes later in this file.
(defvar speedbar-file-regexp)

;; this is dangerous to customize, because the defaults will probably
;; change in the future.
(defcustom speedbar-supported-extension-expressions
  (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?"

  :group 'speedbar
  :version "21.1"
  :type '(repeat (regexp :tag "Extension Regexp"))
  :set (lambda (sym val)
	 (setq speedbar-supported-extension-expressions val
	       speedbar-file-regexp (speedbar-extension-list-to-regex val))))

(defvar speedbar-file-regexp
  (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
  "Regular expression matching files we know how to expand.
Created from `speedbar-supported-extension-expression' with the
function `speedbar-extension-list-to-regex'")

(defcustom speedbar-scan-subdirs nil
  "*Non-nil means speedbar will check if subdirs are empty.
That way you don't have to click on them to find out.  But this
incurs extra I/O, hence it slows down directory display
proportionally to the number of subdirs."
  :group 'speedbar
  :type 'boolean
  :version 21.4)

(defun speedbar-add-supported-extension (extension)
  "Add EXTENSION as a new supported extension for speedbar tagging.
This should start with a `.' if it is not a complete file name, and
the dot should NOT be quoted in with \\.  Other regular expression

						   (speedbar-frame-mode -1)))))
	      t t)
    (toggle-read-only 1)
    (speedbar-set-mode-line-format)
    (if speedbar-xemacsp
	(with-no-warnings
	 (set (make-local-variable 'mouse-motion-handler)
	      'speedbar-track-mouse-xemacs))
      (if speedbar-track-mouse-flag
	  (set (make-local-variable 'track-mouse) t))	;this could be messy.
      (setq auto-show-mode nil))	;no auto-show for Emacs
    (run-hooks 'speedbar-mode-hook))
  (speedbar-update-contents)

  "Set the format of the mode line based on the current speedbar environment.
This gives visual indications of what is up.  It EXPECTS the speedbar
frame and window to be the currently active frame and window."
  (if (and (frame-live-p speedbar-frame)
	   (or (not speedbar-xemacsp)
	       (with-no-warnings
		(specifier-instance has-modeline-p))))
      (save-excursion
	(set-buffer speedbar-buffer)
	(let* ((w (or (speedbar-frame-width) 20))
	       (p1 "<<")
	       (p5 ">>")

  (save-excursion
    (mouse-set-point e)
    ;; This gets the cursor where the user can see it.
    (if (not (bolp)) (forward-char -1))
    (sit-for 0)
    (mouse-major-mode-menu e nil)))

(defun speedbar-hack-buffer-menu (e)
  "Control mouse 1 is buffer menu.
This hack overrides it so that the right thing happens in the main
Emacs frame, not in the speedbar frame.

  (if speedbar-power-click
      (adelete 'speedbar-directory-contents-alist directory))
  ;; find the directory, either in the cache, or build it.
  (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
      (let ((default-directory directory)
	    (case-fold-search read-file-name-completion-ignore-case)
	    dirs files)
	(dolist (file (directory-files directory nil))
	  (or (string-match speedbar-file-unshown-regexp file)
	      (string-match speedbar-directory-unshown-regexp file)
	      (if (file-directory-p file)
		  (setq dirs (cons file dirs))
		(setq files (cons file files)))))
	(let ((nl `(,(nreverse dirs) ,(nreverse files))))
	  (aput 'speedbar-directory-contents-alist directory nl)
	  nl))))

(defun speedbar-directory-buttons (directory index)
  "Insert a single button group at point for DIRECTORY.
Each directory path part is a different button.  If part of the path
matches the user directory ~, then it is replaced with a ~.

	  (speedbar-insert-image-button-maybe (- (point) 2) 3)))))


;;; Build button lists
;;
(defun speedbar-insert-files-at-point (files level directory)
  "Insert list of FILES starting at point, and indenting all files to LEVEL.
Tag expandable items with a +, otherwise a ?.  Don't highlight ? as we
don't know how to manage them.  The input parameter FILES is a cons
cell of the form ( 'DIRLIST .  'FILELIST )."
  ;; Start inserting all the directories
  (dolist (dir (car files))
    (if (if speedbar-scan-subdirs
	    (condition-case nil
		(let ((l (speedbar-file-lists (concat directory dir))))
		  (or (car l) (cadr l)))
	      (file-error))
	  (file-readable-p (concat directory dir)))
	(speedbar-make-tag-line 'angle ?+ 'speedbar-dired dir
				dir 'speedbar-dir-follow nil
				'speedbar-directory-face level)
      (speedbar-make-tag-line 'angle ?  nil dir
			      dir 'speedbar-dir-follow nil
			      'speedbar-directory-face level)))
  (let ((case-fold-search read-file-name-completion-ignore-case))
    (dolist (file (cadr files))
      (let* ((known (and (file-readable-p (concat directory file))
			 (string-match speedbar-file-regexp file)))
	     (expchar (if known ?+ ??))
	     (fn (if known 'speedbar-tag-file nil)))
	(if (or speedbar-show-unknown-files (/= expchar ??))
	    (speedbar-make-tag-line 'bracket expchar fn file
				    file 'speedbar-find-file nil
				    'speedbar-file-face level))))))

(defun speedbar-default-directory-list (directory index)
  "Insert files for DIRECTORY with level INDEX at point."
  (speedbar-insert-files-at-point
   (speedbar-file-lists directory) index directory)
  (speedbar-reset-scanners)
  (if (= index 0)
      ;; If the shown files variable has extra directories, then
      ;; it is our responsibility to redraw them all
      ;; Luckilly, the nature of inserting items into this list means

		     (select-frame lastf)
		     rf)))
	 (newcf (if newcfd newcfd))
	 (lastb (current-buffer))
	 (sucf-recursive (boundp 'sucf-recursive))
	 (case-fold-search read-file-name-completion-ignore-case))
    (if (and newcf
	     ;; check here, that way we won't refresh to newcf until
	     ;; its been written, thus saving ourselves some time
	     (file-exists-p newcf)
	     (not (string= newcf speedbar-last-selected-file)))

	 (make-glyph
	  (make-image-specifier
	   (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
	  'buffer)
       (error nil))
     ,docstring)))))

(defimage-speedbar speedbar-directory-plus
  ((:type xpm :file "sb-dir-plus.xpm" :ascent center))
  "Image used for closed directories with stuff in them.")

(defimage-speedbar speedbar-directory-minus
  ((:type xpm :file "sb-dir-minus.xpm" :ascent center))
  "Image used for open directories with stuff in them.")

(defimage-speedbar speedbar-directory
  ((:type xpm :file "sb-dir.xpm" :ascent center))
  "Image used for empty or unreadable directories.")

(defimage-speedbar speedbar-page-plus
  ((:type xpm :file "sb-pg-plus.xpm" :ascent center))
  "Image used for closed files with stuff in them.")

(defimage-speedbar speedbar-page-minus

  "Image used for open tag groups.")

(defvar speedbar-expand-image-button-alist
  '(("<+>" . speedbar-directory-plus)
    ("<->" . speedbar-directory-minus)
    ("< >" . speedbar-directory)
    ("[+]" . speedbar-page-plus)
    ("[-]" . speedbar-page-minus)
    ("[?]" . speedbar-page)
    ("{+}" . speedbar-tag-plus)
    ("{-}" . speedbar-tag-minus)