;;; d-speedbar.el --- Displays a menu of functions/methods in a file
;;; in the right hand window with the current function/method
;;; highlighted.

;; Copyright (C) 2014-2015 Davin Pearson

;; Emacs Lisp Archive Entry
;; Filename: d-speedbar.el
;; Author/Maintainer: m4_davin_pearson
;; Keywords: Current function method C, C++, Lisp, Java and my new language Lisp++
;; Version: 1.1

;;; Commentary:

;; This file is not part of GNU Emacs.

;; This code causes the current function Elisp/C/C++ or method
;; (Java/C++) to be shown highlighted in the right window, alongside a
;; list of all the functions and methods in the file.

;;; m4_limitation_of_warranty

;;; m4_install_instructions(d-speedbar)

;;; Known Bugs:

;;; Version History

;; Version 1.1 Now works properly with multiple frames.  Each frame
;; has its own d-speedbar window.

;; Version 1.0 First stable version.

;;; Code:

(defmacro d-quote (&rest rest)
)

(require 'cl)

(assert (fboundp 'incf))
(assert (fboundp 'cdddr))

(setq prefs-advanced-user-p t)
(require 'diagnose)
(require 'cfm)

(progn
  (kill-local-variable 'd-window-right)
  (kill-local-variable 'd-window-size)
  (kill-local-variable 'd-old-major-mode)
  (make-local-variable 'd-old-method)
  (make-local-variable 'local-old-buffer)
  (make-local-variable 'local-old-window)
  (setq-default d-window-right   nil
                d-window-size    nil
                d-old-major-mode nil
                cursor-in-non-selected-windows t
                )
;;;
;;; TODO PUT BACK: space here
;;;
  (defvar d-speedbar--format-spec "*d-%d*")
  (defvar d-speedbar--regexp-spec "^\\*d-\\([0-9]+\\)\\*$")
  (defvar d-speedbar--map (make-keymap))
  (copy-face 'font-lock-function-name-face 'd-face-speedbar-highlighted)
  (defvar d-frame-window-correspondence nil)
  (defvar d-old-method nil)
  (defvar d-all-smegs  nil)
  (setq local-old-buffer nil)
  (setq local-old-window nil)
  )

(defun d-get-classes ()
  (save-excursion
    (save-match-data
      (goto-char (point-min))
      (setq d-classes nil)
      (while (re-search-forward "^\\(public +\\|abstract +\\)*class \\([A-Z][a-zA-Z0-9_]*\\)" nil t)
        (setq d-classes (cons
                         (cons
                          (buffer-substring-no-properties (match-beginning 2) (match-end 2))
                          (d-what-line))
                         d-classes)))
      (setq d-classes (cons
                       (cons
                        "None"
                      (save-excursion
                        (goto-char (point-max))
                        (d-what-line)))
                       d-classes))
      (setq d-classes (nreverse d-classes)))))

(defun d-get-class ()
  (let ((ptr     d-classes)
        (ptr-old d-classes)
        (done    nil))
    (while (and ptr (not done))
      (if (< (d-what-line) (cdar ptr))
          (progn
            (setq done t)
            ;;(debug 123)
            )
        (setq ptr-old ptr)
        (setq ptr (cdr ptr))
        ;;(debug 123)
        ))
    (if done (car ptr-old) "Not found"))
  )

;;; (d-speedbar--get-current-buffer)
;;; (d-speedbar--get-speedbar-buffer)
;;; (d-speedbar--get-speedbar-window)
;;; (d-speedbar)
(defun d-speedbar--get-current-buffer ()
  (save-excursion
    (let (speedbar-buffer)
      (setq speedbar-buffer (d-speedbar--get-speedbar-buffer))
      ;;(assert (stringp speedbar-buffer))
      (when speedbar-buffer
        (set-buffer speedbar-buffer)
        local-old-buffer))))

;;; (d-speedbar--get-current-window)
(defun d-speedbar--get-current-window ()
  (save-excursion
    (let (speedbar-buffer)
      (setq speedbar-buffer (d-speedbar--get-speedbar-buffer))
      ;;(assert (stringp speedbar-buffer))
      (when speedbar-buffer
        (set-buffer speedbar-buffer)
        local-old-window))))

;;; (setq str " *d-speedbar-0*")
(defun d-speedbar--str-to-count (str)
  (let ((n 0))
    (when (string-match d-speedbar--regexp-spec str)
      (setq n (substring str (match-beginning 1) (match-end 1)))
      (setq n (read n)))
    n))

;;; (setq list d-frame-speedbar-correspondence)
;;; (setq ptr list)
;;; (d-speedbar--get-count)
(defun d-speedbar--get-count ()
  (let ((count 0)
        (done  nil)
        (n     0)
        (ptr   (buffer-list)))
    (setq count 0)
    (while ptr
      (setq n (d-speedbar--str-to-count (buffer-name (car ptr))))
      (setq count (max n count))
      (setq ptr (cdr ptr)))
    (incf count)
  ))

;;; (buffer-live-p (get-buffer speedbar-buffer))
;;; (d-speedbar--get-speedbar-buffer)
(defun d-speedbar--get-speedbar-buffer ()
  (window-buffer (d-speedbar--get-speedbar-window)))
;; (d-speedbar--get-speedbar-buffer)
;; (setq d-frame-window-correspondence nil)
;; (window-buffer new-win)

;;; (window-buffer-name (setq window (car (window-list))))
;;; (window-buffer-name (setq window (nth 1 (window-list))))
;;; (window-buffer-name (setq window (nth 2 (window-list))))
(defun window-buffer-name (window)
  (save-match-data
    (let (str)
      (setq str (prin1-to-string window))
      (setq str (if (string-match "^#<window [0-9]+ on \\([-a-zA-Z0-9_ *.]+\\)>$" str)
                    (substring str (match-beginning 1) (match-end 1))
                  "")))))

(defun d-speedbar--get-window-size ()
  (cond
   ((eq major-mode 'emacs-lisp-mode)
    15)
   ((eq major-mode 'java-mode)
    15)
   ((eq major-mode 'dired-mode)
    5)
   (t
    10)))

;;; (d-speedbar--get-speedbar-window)
(defun d-speedbar--get-speedbar-window ()
  (let ((cons            nil)
        (cb              nil)
        (b               nil)
        (speedbar-buffer nil)
        (done            nil)
        (name            nil)
        (count           0)
        (frame           nil)
        (ptr             nil)
        (a               nil))
    (setq a (assq (selected-frame) d-frame-window-correspondence))
    ;;(message "a=%s" a)
    ;;(sit-for 1)
    (if a
        (cdr a)
      (setq count 0)
      (setq ptr (window-list))
      (while ptr
        (setq speedbar-window (car ptr))
        (assert (d-window-live-p speedbar-window))
        (setq speedbar-buffer (buffer-name (window-buffer speedbar-window)))
        (if (string-match d-speedbar--regexp-spec speedbar-buffer)
            (setq ptr nil))
        (setq ptr (cdr ptr)))
      (when (not (string-match d-speedbar--regexp-spec speedbar-buffer))
        (setq count (d-speedbar--get-count))
        (setq speedbar-buffer (format d-speedbar--format-spec count)))
      ;;(when (not speedbar-buffer)
      (assert (and (windowp speedbar-window) "banana"))
      (assert (d-window-live-p speedbar-window))
      ;;(assert (d-buffer-live-p speedbar-buffer))
      ;;(assert (buffer-live-p speedbar-buffer))
      ;;(set-window-buffer speedbar-window (get-buffer speedbar-buffer))
      (d-quote
        ;;(assert nil)
        (setq done nil)
        (while (not done)
          (setq speedbar-buffer (format d-speedbar--format-spec count))
          (when (not (get-buffer speedbar-buffer))
            (setq d-window-size (d-speedbar--get-window-size))
            (setq new-win (split-window-right (- d-window-size)))
            (assert (d-window-live-p new-win))
            ;;(set-window-buffer new-win (get-buffer speedbar-buffer))
            (setq done t))
          (incf count))
        (assert speedbar-buffer)
        (assert new-win))
      ;; ---------------------------------------------------------------
      (if (d-buffer-live-p speedbar-buffer)
          (setq b (get-buffer speedbar-buffer))
        (setq b (generate-new-buffer speedbar-buffer)))
      (set-window-buffer speedbar-window b)
      (setq cb (buffer-name (current-buffer)))
      (setq cw (selected-window))
      (make-local-variable 'local-old-buffer)
      (make-local-variable 'local-old-window)
      (make-local-variable 'truncate-lines)
      ;;(setq d-frame-window-correspondence (cons (cons (selected-frame) new-win)
      ;;                                          d-frame-window-correspondence))
      (save-excursion
        (set-buffer b)
        (setq truncate-lines t)
        (setq local-old-buffer cb)
        (setq local-old-window cw))
      (setq d-frame-window-correspondence nil)
      speedbar-window
      )
    )
  )
;; (setq d-frame-window-correspondence nil)

(defun d-speedbar ()
  (interactive))

;;; (d-speedbar-new)
(defun d-speedbar-new ()
  (interactive)
  (save-match-data
    (let ((buffer-name (buffer-name)) old-buf new-buf list ptr list2 ptr2 s1 s2 p1 p2 p3
          old-class class spaces speedbar-buffer speedbar-window)
      ;;(d-walk-frames
      ;;(setq speedbar-window (d-speedbar--get-speedbar-window))
      ;;(assert (d-window-live-p speedbar-window))
      (setq ptr (window-list))
      (while ptr
        (when (string-match d-speedbar--regexp-spec (buffer-name (window-buffer (car ptr))))
          (select-window (car ptr))
          (setq speedbar-window (selected-window))
          (setq ptr nil))
        (setq ptr (cdr ptr)))
      ;;(assert (and (windowp speedbar-window) "apple"))
      ;;(assert nil)
      (if (not (d-window-live-p speedbar-window))
          (setq speedbar-window (d-speedbar--get-speedbar-window)))
      (unwind-protect
          (save-excursion
            (progn
              (assert speedbar-window)
              (setq old-buf         (d-speedbar--get-current-buffer))
              (setq speedbar-buffer (window-buffer speedbar-window))
	      (assert speedbar-buffer)
              )
            ;; -------------------------------------------------------------
            (if (not (d-buffer-live-p speedbar-buffer))
                (progn
                  (message "Monday")
                  (sit-for 1)
                  )
              (message "Tuesday")
              (assert (stringp speedbar-buffer))
              (assert speedbar-buffer)
              (set-buffer speedbar-buffer)
              (read-only-mode -1)
              ;;(erase-buffer)
              (use-local-map d-speedbar--map)
              (local-set-key [(return)] 'd-speedbar--goto-method)
              ;;(debug "Rocket")
              (when (d-buffer-live-p old-buf)
                (set-buffer old-buf)
                ;;(debug "Triceratops")
                (kill-local-variable 'd-old-major-mode)
                (setq-default d-old-major-mode major-mode)
                (setq-default spaces (make-string c-basic-offset ? ))
                (progn
                  (kill-local-variable 'd-window-size)
                  (setq list nil)
                  ;;(setq list (cons (list ""
                  ;;                       (if (buffer-file-name) (file-name-nondirectory (buffer-file-name)) (buffer-name))
                  ;;                       "") list))
                  ;;
                  ;;(setq list (cons (list ""
                  ;;                       (make-string 20 ?-)
                  ;;                       "") list))
                  ;;(add-to-end list)
                  (goto-char (point-min))
                  (cond
                   ;; ------------------------------------------------------
                   ((eq major-mode 'dired-mode)
                    (save-excursion
                      (set-buffer speedbar-buffer)
                      (setq d-window-size 10))
                    (setq list2 (directory-files default-directory nil "\\.\\(bat\\|c\\|cc\\|c2j\\|cpp\\|css\\|el\\|h\\|html?\\|hts\\|java\\|js\\|m4\\|php\\|tes\\|tex\\)$"))
                    (setq ptr2 list2)
                    (while ptr2
                      (setq list (cons
                                  (list ""
                                        (car ptr2)
                                        "") list))
                      (setq ptr2 (cdr ptr2))))
                   ;; -----------------------------------------------------
                   ((eq major-mode 'emacs-lisp-mode)
                    (save-excursion
                      (set-buffer speedbar-buffer)
                      (setq d-window-size 20))
                    (save-excursion
                      (set-buffer old-buf)
                      )
;;;                                                                 a-zA-Z0-9_+<>/=:-
                    (while (re-search-forward "(\\(defun\\|defmacro\\|defadvice\\) +\\([a-zA-Z0-9_+<>/=:-]+\\)[ \t\r\n]*\\(([^()]*)\\)?" nil t)
                      (setq list (cons (list (concat "(" (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                                             (buffer-substring-no-properties (match-beginning 2) (match-end 2))
                                             (if (and (match-beginning 3) (match-end 3))
                                                 (buffer-substring-no-properties (match-beginning 3) (match-end 3))
                                               ))
                                       list))
                      ;;(debug "foo")
                      ))
                   ;; ------------------------------------------------------
                   ((eq major-mode 'java-mode)
                    (save-excursion
                      (set-buffer speedbar-buffer)
                      (setq d-window-size 15))
                    (d-get-classes)
;;;                                                1                2                                          3                                        4                                                                                                                                                                  5                               6                               ...
                    (while (re-search-forward (concat "\\(^" spaces "\\)\\(public +\\|private +\\|protected +\\|\\)\\(abstract +\\|static +\\|final +\\|\\)*\\(void +\\|boolean[][]* +\\|byte[][]* +\\|char[][]* +\\|short[][]* +\\|int[][]* +\\|long[][]* +\\|float[][]* +\\|double[][]* +\\|[A-Z][a-zA-Z0-9_]*[][]* +\\|\\)\\([a-zA-Z_]+[a-zA-Z0-9_<>,]*\\)\\(([^()]*);?\\)") nil t)
                      (setq list (cons (list ""
                                             (buffer-substring-no-properties (match-beginning 5) (match-end 5))
                                             (buffer-substring-no-properties (match-beginning 6) (match-end 6))
                                             (d-get-class)
                                             ) list))))
                   ;; ------------------------------------------------------
                   ((eq major-mode 'c++-mode)
                    (save-excursion
                      (set-buffer speedbar-buffer)
                      (setq d-window-size 15))
                    (while (re-search-forward "^\\(void\\|bool\\|int\\|float\\|double\\|[A-Z]+[a-zA-Z0-9_]+\\)[&*]* +\\([a-zA-Z0-9_:]+\\)\\(([^()]*)\\)" nil t)
                      (setq list (cons (list (buffer-substring-no-properties (match-beginning 1) (match-end 1))
                                             (buffer-substring-no-properties (match-beginning 2) (match-end 2))
                                             (buffer-substring-no-properties (match-beginning 3) (match-end 3))) list))))
                   ;; ------------------------------------------------------
                   ((eq major-mode 'c2j-mode)
                    (setq truncate-lines t)
                    (save-excursion
                      (set-buffer speedbar-buffer)
                      (setq d-window-size 20))
                    (while (re-search-forward "\\(^[0-9]+ strobe \".*\";\\)\\(//.*$\\)?" nil t)
                      (setq list (cons (list ""
                                             (buffer-substring-no-properties (match-beginning 1) (match-end 1))
                                             (if (and (match-beginning 2) (match-end 2))
                                                 (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                                             "") list))
                      ;;(debug "Sexy rexy")
                      (if (eq (caddar list) nil)
                          (setcar (cdar list) (concat (cadar list) "\n"))))
                    )
                   ;; ------------------------------------------------------
                   ((eq major-mode 'compilation-mode)
                    (save-excursion
                      (set-buffer speedbar-buffer)
                      (setq d-window-size 20))
                    (setq s1 "^[ \t]*\\(\\*\\)* STROBE=\"[a-zA-Z0-9]*\"")
                    ;;(setq s2 "^\\(make\\|make\\[[0-9]*\\]:\\|cpp\\|Compilation\\|mkdir\\|for\\|java\\|javac\\|rm\\|mv\\|cp\\|cd\\|tar\\|gzip\\)\\( .*$\\)")
                    (setq s2 "^\\(make\\|Compilation\\)\\( .*$\\)")
                    (while (re-search-forward (concat "\\(" s1 "\\|" s2 "\\)") nil t)
                      ;;cd ..; make tar
                      ;;**** STROBE="a"
                      (cond
                       ((save-excursion
                          (save-match-data
                            (beginning-of-line)
                            (looking-at s1)))
                        (setq list (cons (list
                                          ""
                                          (d-trim-string (buffer-substring-no-properties (match-beginning 0) (match-end 0)))
                                          ;;(buffer-substring-no-properties (point-at-bol) (point-at-eol))
                                          ""
                                          )
                                         list)))
                       ((save-excursion
                          (save-match-data
                            (beginning-of-line)
                            (looking-at s2)))
                        (setq list (cons (list
                                          ""
                                          (d-trim-string (buffer-substring-no-properties (match-beginning 0) (match-end 0)))
                                          ;;(buffer-substring-no-properties (match-beginning 3) (match-end 3))
                                          ""
                                          )
                                         list))))))
                   ;; ------------------------------------------------------
                   ((eq major-mode 'php-mode)
                    (setq d-window-size 30)
                    (while (re-search-forward "^[ \t]*function \\([a-zA-Z_][a-zA-Z0-9_]*\\)[ \t]*\\(([^()]*)\\)" nil t)
                      (setq list (cons (list
                                        ""
                                        (buffer-substring-no-properties (match-beginning 1) (match-end 1))
                                        (buffer-substring-no-properties (match-beginning 2) (match-end 2))
                                        )
                                       list))))
                   ;; ------------------------------------------------------
                   ((or (eq major-mode 'text-mode)
                        (eq major-mode 'grep-mode)
                        (eq major-mode 'html-mode)
                        (eq major-mode 'occur-mode)
                        (eq major-mode 'help-mode)
                        (eq major-mode 'fundamental-mode))
                    (setq d-window-size nil))
                   )))
              (set-buffer speedbar-buffer)
              (read-only-mode -1)
              (assert (d-window-live-p speedbar-window))
              (set-window-point speedbar-window (point-min))
              ;;(insert "FART!")
              (setq list (nreverse list))
              (setq ptr list)
              (setq class nil)
              (setq old-class nil)
              (while ptr
                (goto-char (point-max))
                (save-excursion
                  (when (eq d-old-major-mode 'java-mode)
                    (setq old-class class)
                    (setq class (car (nth 3 (car ptr))))
                    (when (not (string= class old-class))
                      (set-buffer speedbar-buffer)
                      (goto-char (point-max))
                      (if (not (eq (point) (point-min)))
                          (insert "\n"))
                      (insert "class " class "\n")
                      (setq p1 (point))
                      (search-backward "class ")
                      (forward-char (length "class "))
                      (setq p2 (point))
                      (put-text-property (point-at-bol) p1 'face 'font-lock-keyword-face)
                      (put-text-property p1 p2             'face 'font-lock-type-face)
                      )))
                (goto-char (point-max))
                (setq p1 (point))
                ;;(insert (nth 0 (car ptr)) " ")
                (setq p2 (point))
                (insert (if (and
                             (not (eq (car ptr) 'frame-configuration))
                             (nth 1 (car ptr))
                             (stringp (nth 1 (car ptr)))
                             (string-match "^make" (nth 1 (car ptr)))
                             d-window-size)
                            (d-split-text (nth 1 (car ptr)) (- d-window-size 4))
                          (if (and (not (eq (car ptr) 'frame-configuration))
                                   (nth 1 (car ptr))
                                   (stringp (nth 1 (car ptr))))
                              (nth 1 (car ptr))
                            (if (and (not (eq (car ptr) 'frame-configuration))
                                     (nth 1 (car ptr)))
                                (prin1-to-string (nth 1 (car ptr)))
                              ""))))
                (setq p3 (point))
                (if (and
                     (not (eq (car ptr) 'frame-configuration))
                     (listp (car ptr))
                     (stringp (nth 2 (car ptr))))
                    (insert (nth 2 (car ptr)) "\n"))
                ;;(put-text-property p1 p2 'face 'bold)
                (put-text-property p2 p3 'face 'default)
                ;;(message "buffer-substring-no-properties=" (buffer-substring-no-properties p2 p3))
                ;;(sit-for 1)
                ;;(debug "foomatic")
                (setq ptr (cdr ptr)))
              ;;(error "Schmu")
              (goto-char (point-min))
              (while (re-search-forward "//.*$" nil t)
                (setq p1 (match-beginning 0))
                (setq p2 (match-end 0))
                (put-text-property p1 p2 'face 'font-lock-comment-face))
              ;; -------------------------------------------------------------
              ))
        ;;(debug "Knife")
        (setq speedbar-buffer (d-speedbar--get-speedbar-buffer))
        (when (and (boundp 'd-window-size) d-window-size)
          (delete-other-windows)
          (setq d-window-right nil)
          (if (fboundp 'split-window-right)
              (setq d-window-right (split-window-right (- d-window-size)))
            (if (fboundp 'split-window-horizontally)
                (setq d-window-right (split-window-horizontally (- d-window-size)))))
          (select-window d-window-right)
          ;;(assert speedbar-buffer)
          (if (and (fboundp 'display-buffer-same-window) (d-window-live-p d-window-right))
              (display-buffer-same-window speedbar-buffer nil)
            (if (and (fboundp 'set-window-buffer) (d-window-live-p d-window-right))
                (set-window-buffer d-window-right speedbar-buffer)
              ))
          ;;(other-window 1)
          )
        ;;(debug "Hole in one")
        ;;(assert speedbar-buffer)
        (when speedbar-buffer
          (set-buffer speedbar-buffer)
          (read-only-mode 1)
          ;;(goto-char (point-min))
          ;;(debug "Hot potato")
          ;;(when (> (count-windows) 0)
          ;;(message "foo!")
          (other-window 1))
        ))
    ;;(debug "Calamansi")
    )
  ;;(d-beeps "Foomatic")
  )

;;;(d-walk-frames (message "speedbar=%s" (cdar ptr-walk)))
;;(message "frame=%s" (caar ptr))
;;(message "speedbar=%s" (cdar ffptr))
(d-quote defmacro d-walk-frames (&rest p)
  `(let ((ptr-walk nil))
     (d-set-frame-speedbar-correspondence)
     (setq ptr-walk d-frame-speedbar-correspondence)
     (while ptr-walk
       ,(cons 'progn p)
       (setq ptr-walk (cdr ptr-walk)))))

(d-quote defun d-set-frame-speedbar-correspondence ()
  (let (list ptr count)
    (setq list (current-frame-configuration))
    (setq ptr list)
    (setq ptr (cdr ptr))
    (setq d-frame-speedbar-correspondence nil)
    (setq count 0)
    (while ptr
      (setq d-frame-speedbar-correspondence (cons (cons (caar ptr) (format " *d-speedbar-%d*" count))
                                                  d-frame-speedbar-correspondence))
      (if (not (d-buffer-live-p (cdar d-frame-speedbar-correspondence)))
          (generate-speedbar-bufferfer (cdar d-frame-speedbar-correspondence)))
      ;;(message "buf=%s" (cdar d-frame-speedbar-correspondence))
      ;;(insert (format "frame=%s" (caar ptr)))
      (setq ptr (cdr ptr))
      (incf count)
      )
    d-frame-speedbar-correspondence
    ))

(defun d-delete-speedbar-window (bufname)
  (when (get-buffer bufname)
    (set-buffer bufname)
    (kill-buffer-and-window)
    (delete-other-windows)
    ))

;;; (d-split "abcdefghijklmnop" 2)
(defun d-split-text (str size)
  (let ((i 0)
        (len (length str))
        (result ""))
    (while (< i len)
      (if (and (/= 0 i) (= 0 (mod i size)))
          (setq result (concat result "\n")))
      (if (and (/= (aref str i) ?\n)
               (/= (aref str i) ?\r))
          (setq result (format "%s%c" result (aref str i))))
      (incf i))
    result))

(progn
  (fset 'd-message-old (symbol-function 'message))
  (kill-local-variable 'd-message-on)
  (setq-default d-message-on t)
  (defun message (&rest args)
    (if d-message-on
        (apply 'd-message-old args)))
  )

;;; (message "foo%s" "bar")
;;; (funcall 'd-message-old "foo%s" "bar")
;;; (message "foo%s" "bar")
;;; (d-message "foo%s%s" "bar" "zip")
;;; (d-speedbar--set--delete-all)
(defun d-speedbar--set--delete-all ()
  (interactive)
  (save-match-data
    (unwind-protect
        (let ((d-message-on nil)
              (speedbar-buffer (d-speedbar--get-speedbar-buffer)))
          (save-window-excursion
            (save-excursion
              (let (p1 p2 done)
                (when (d-window-live-p d-window-right)
                  (cond
                   ((eq major-mode 'emacs-lisp-mode)
                    (select-window d-window-right)
                    (read-only-mode -1)
                    ;;(message "Switched window")
                    ;;(sit-for 1)
                    (goto-char (point-min))
                    (setq done nil)
                    (while (not done)
                      (beginning-of-line)
                      (setq p1 (point))
                      (skip-chars-forward "a-zA-Z0-9_+<>/=:-")
                      ;;(skip-chars-forward "a-zA-Z0-9_-")
                      (setq p2 (point))
                      (if (not (eq p1 p2))
                          (put-text-property p1 p2 'face 'default)
                        (setq done t))
                      (forward-line 1)
                      t))
                   ((or (eq major-mode 'c-mode)
                        (eq major-mode 'c++-mode)
                        (eq major-mode 'php-mode)
                        (eq major-mode 'java-mode)
                        )
                    (select-window d-window-right)
                    (read-only-mode -1)
                    (goto-char (point-min))
                    (while (re-search-forward "[a-zA-Z0-9_:]*(" nil t)
                      (save-excursion
                        (forward-char -1)
                        (setq p2 (point))
                        (skip-chars-backward "a-zA-Z0-9_:")
                        (setq p1 (point))
                        (put-text-property p1 p2 'face 'default)))
                    )
                   ;; --------------------------------------------------
                   ((eq major-mode 'compilation-mode)
                    (select-window d-window-right)
                    (read-only-mode -1)
                    (goto-char (point-min))
                    (while (not (eobp))
                      (beginning-of-line)
                      ;;(skip-chars-forward "* a-zA-Z0-9=\"/.")
                      ;;(assert (remove-text-properties (point-at-bol) (point) 'face))
                      (put-text-property (point-at-bol) (point-at-eol) 'face 'default)
                      (forward-line 1)))
                   ;; ------------------------------------------------
                   ((or (eq major-mode 'c2j-mode)
                        (eq major-mode 'dired-mode))
                    (select-window d-window-right)
                    (read-only-mode -1)
                    (goto-char (point-min))
                    (while (not (eobp))
                      (beginning-of-line)
                      (put-text-property (point-at-bol) (point-at-eol) 'face 'default)
                      (forward-line 1)))
                   ;; --------------------------------------------------
                   )
                  )))))
      ;;(message "cfm--set--delete-all")
      (save-window-excursion
        (save-excursion
          ;;(assert speedbar-buffer)
          (when speedbar-buffer
            (set-buffer speedbar-buffer)
            (read-only-mode 1))))
      ;;(fset 'message (symbol-function 'old-message))
      )))

;; (d-speedbar--set--set-current)
(defun d-speedbar--set--set-current ()
  (interactive)
  (let ((p               nil)
        (d-message-on    t)
        (speedbar-buffer nil)
        (old-buf         nil)
        (ptr             nil))
    (progn
      (setq ptr (window-list))
      (setq old-win (d-speedbar--get-current-window))
      ;;(setq old-buf (d-speedbar--get-current-buffer))
      (setq speedbar-buffer (d-speedbar--get-speedbar-buffer))
      (set-buffer speedbar-buffer)
      ;;(message "old-buf=%s" old-buf)
      ;;(sit-for 3)
      (select-window old-win)
      )
    (save-match-data
      (unwind-protect
          (save-excursion
            (save-excursion
              (set-buffer speedbar-buffer)
              (setq cfm--method nil)
              (read-only-mode -1))
            (select-window old-win)
            ;;(message "old-buf=%s" old-buf)
            ;;(message "buffer-name=%s major-mode=%s" (current-buffer) major-mode)
            ;;(sit-for 3)
            (assert (or (eq major-mode 'c-mode)
                        (eq major-mode 'c++-mode)
                        (eq major-mode 'c2j-mode)
                        (eq major-mode 'php-mode)
                        (eq major-mode 'java-mode)
                        (eq major-mode 'dired-mode)
                        (eq major-mode 'emacs-lisp-mode)
                        (eq major-mode 'fundamental-mode)
                        (eq major-mode 'compilation-mode)))
            (save-window-excursion
              (let (p1 p2 pair pair2 line class)
                (setq-default cfm--method nil)
                (select-window old-win)
		;;(error "one hit wonder")
                ;;(debug "One hit wonder")
                (cond
                 ;; ----------------------------------------------------
                 ((eq major-mode 'emacs-lisp-mode)
                  (progn
                    (progn
                      ;;(debug "bar")
                      (setq-default cfm--new (d-trim-string (cfm--get-defun)))
                      (when (not (string= cfm--new ""))
                        (assert (d-window-live-p d-window-right))
                        (select-window d-window-right)
                        (goto-char (point-min))
                        (setq-default cfm--method (concat "^" cfm--new "("))
                        (when (re-search-forward cfm--method nil t)
                          (beginning-of-line)
                          (setq p1 (point))
                          (skip-chars-forward "a-zA-Z0-9_+<>/=:-")
                          (setq p2 (point))
                          (if (not (eq p1 p2))
                              (put-text-property p1 p2 'face 'd-face-speedbar-highlighted))
                          (beginning-of-line)
                          ;;(insert "k")
                          ;;(debug "foo")
                          (setq p (point))
                          )))))
                 ;; ----------------------------------------------------
                 ((eq major-mode 'java-mode)
                  (save-window-excursion
                    (save-excursion
                      (setq pair-java (cfm--get-method 1))
                      (setq pair2-java (d-get-class))
                      (setq class (if (consp pair2-java) (car pair2-java) nil))
                      (setq cfm--new  (car  pair-java))
                      (setq cfm--args (cadr pair-java))
                      (setq cfm--java-new  cfm--new)
                      (setq cfm--java-args cfm--args)
                      (when (not (string= cfm--new ""))
                        (assert (d-window-live-p d-window-right))
                        (select-window d-window-right)
                        (goto-char (point-min))
                        (if (not (re-search-forward (concat "^class " class "$") nil t))
                            (error "smeg 1"))
                        (setq cfm--method (concat cfm--new "[ \t]*" (regexp-quote cfm--args)))
                        (setq cfm--java-method cfm--method)
                        ;;(if (string-match "hexChar" cfm--java-method) (debug 123))
                        (when (re-search-forward (concat "\\<" cfm--java-method) nil t)
                          (re-search-backward "(")
                          (setq p1 (point))
                          (skip-chars-backward "a-zA-Z0-9_")
                          (setq p2 (point))
                          (put-text-property p2 p1 'face 'd-face-speedbar-highlighted)))
                      (beginning-of-line)
                      (setq p (point))
                      )))
                 ;; ----------------------------------------------------
                 ((eq major-mode 'c++-mode)
                  (save-window-excursion
                    (save-excursion
                      (setq pair (cfm--get-method 0))
                      (setq cfm--new  (car pair))
                      (setq cfm--args (cadr pair))
                      (assert (d-window-live-p d-window-right))
                      (select-window d-window-right)
                      (goto-char (point-min))
                      (setq cfm--method (concat "\\(^\\|[^a-zA-Z0-9_:]\\)" cfm--new (regexp-quote cfm--args)))
                      (if (not (re-search-forward cfm--method nil t))
                          ;;(d-beeps "not found")
                          1
                        (re-search-backward "(")
                        ;;(forward-char -1)
                        (setq p1 (point))
                        (skip-chars-backward "a-zA-Z0-9_:")
                        (setq p2 (point))
                        (put-text-property p2 p1 'face 'd-face-speedbar-highlighted)
                        (setq p (point))
                        ;;(debug "smelly cat")
                        ))))
                 ;; ----------------------------------------------------
                 ((eq major-mode 'c-mode)
                  (save-window-excursion
                    (save-excursion
                      (setq cfm--new (cfm--get-method 1))
                      (assert (d-window-live-p d-window-right))
                      (select-window d-window-right)
                      (goto-char (point-min))
                      (setq cfm--method (concat "\\(^\\|[^a-zA-Z0-9_:]\\)" cfm--new "("))
                      (when (re-search-forward cfm--method nil t)
                        (forward-char -1)
                        (setq p1 (point))
                        (skip-chars-backward "a-zA-Z0-9_:")
                        (setq p2 (point))
                        (put-text-property p2 p1 'face 'd-face-speedbar-highlighted))
                      (setq p (point))
                      )))
                 ;; ----------------------------------------------------
                 ((eq major-mode 'php-mode)
                  (save-excursion
                    (save-window-excursion
                      (setq pair (cfm--get-php-function))
                      (setq cfm--new  (car pair))
                      (setq cfm--args (cdr pair))
                      (when (not (string= cfm--new ""))
                        (assert (d-window-live-p d-window-right))
                        (select-window d-window-right)
                        (goto-char (point-min))
                        (setq cfm--method (concat "^" cfm--new "[ \t]*" cfm--args))
                        ;;(debug 123)
                        (when (re-search-forward cfm--method nil t)
                          (re-search-backward "(")
                          (setq p1 (point))
                          (skip-chars-backward "a-zA-Z0-9_")
                          (setq p2 (point))
                          (put-text-property p2 p1 'face 'd-face-speedbar-highlighted))
                        (beginning-of-line)
                        (setq p (point))
                        ))))
                 ;; ----------------------------------------------------
                 ((eq major-mode 'compilation-mode)
                  (save-excursion
                    (save-window-excursion
                      (let (ptr list)
                        (setq list (d-speedbar--get-compilation-strobes))
                        ;;(setq list (nreverse list))
                        ;;(setq list (mapcar 'regexp-quote list))
                        (setq ptr list)
                        (setq cfm--new-2 (cfm--get-compilation-strobe))
                        (when (not (string= cfm--new-2 ""))
                          (assert (d-window-live-p d-window-right))
                          (select-window d-window-right)
                          (goto-char (point-min))
                          (while ptr
                            (when (not (re-search-forward (concat "^" (car ptr)) nil t))
                              ;;(debug)
                              (message "smeg 12 not found %s" (car ptr))
                              ;;(sit-for 1)
                              )
                            (setq ptr (cdr ptr)))
                          (setq cfm--method-2 (concat "^" (regexp-quote cfm--new-2)))
                          (setq cfm--method cfm--method-2)
                          ;;(debug 123)
                          (forward-line -1)
                          (when (re-search-forward cfm--method-2 nil t)
                            (put-text-property (point-at-bol) (point-at-eol) 'face 'd-face-speedbar-highlighted))
                          ;;(debug)
                          (beginning-of-line))
                        (setq p (window-point))
                        ;;(other-window 1)
                        ;;(debug 456)
                        ))))
                 ;; ----------------------------------------------------
                 ((eq major-mode 'c2j-mode)
                  (save-excursion
                    (beginning-of-line)
                    (when (or (looking-at "^[0-9]+ strobe.*$")
                              (re-search-backward "^[0-9]+ strobe.*$" nil t))
                      (setq cfm--method (buffer-substring-no-properties
                                         (match-beginning 0)
                                         (match-end 0)))
                      ;;(debug 123)
                      (setq cfm--method (substring cfm--method 0 3))
                      (let ((d-message-on t))
                        ;;(message "cfm--method=%s" cfm--method)
                        ;;(sit-for 1)
                        (set-buffer d-speedbar--buf-name)
                        (goto-char (point-min))
                        (if (not (re-search-forward cfm--method nil t))
                            (error "smeg 2"))
                        (put-text-property (point-at-bol)
                                           (point-at-eol)
                                           ;;(+ (point-at-bol) 3)
                                           'face
                                           'd-face-speedbar-highlighted))
                      (setq p (window-point))
                      )))
                 ;; ----------------------------------------------------
                 ((eq major-mode 'dired-mode)
                  ;;(setq d-window-size 10)
                  ;;(beep)
                  (setq line (d-current-line-as-string))
                  (assert (string-match " \\([A-Z][a-zA-Z0-9_.]*$\\)" line))
                  (setq cfm--method (concat "^" (substring line (match-beginning 1) (match-end 1)) "$"))
                  ;;(message "line=%s" line)
                  (set-buffer d-speedbar--buf-name)
                  (goto-char (point-min))
                  (if (not (re-search-forward cfm--method nil t))
                      (error "smeg 3"))
                  (put-text-property (point-at-bol)
                                     (point-at-eol)
                                     'face
                                     'd-face-speedbar-highlighted)
                  (setq p (window-point))
                  )
                 ;; ---------------------------------------------------
                 (t
                  (setq p (window-point))
                  ;;(debug "carrot")
                  )))
              ;;(setq d-old-method cfm--method)
              ))
        (if (or (not (string= d-old-method cfm--method)) d-all-smegs)
            (let (win)
              (unwind-protect
                  (progn ;;save-window-excursion
                    ;;(save-excursion
                    (if (and (= (count-windows) 2)
                             (eq (current-buffer) (d-speedbar--get-speedbar-buffer)))
                        (other-window 1))
                    (setq win (get-buffer-window))
                    (assert (d-window-live-p d-window-right))
                    (select-window d-window-right)
                    (set-window-point (selected-window) p)
                    ;;(d-speedbar)
                    ;;(if cfm--method (re-search-forward cfm--method nil t))
                    (beginning-of-line)
                    (recenter)
                    )
                (select-window win))))
        (save-excursion
          (when (d-buffer-live-p speedbar-buffer)
            (set-buffer speedbar-buffer)
            (read-only-mode 1)))
        (setq d-old-method cfm--method)
        ))))

(defun d-speedbar--turn-on-timers ()
  ;;;;(setq d-speedbar--timer-1 (run-with-idle-timer 0.1 t 'd-speedbar))
  ;;(setq d-speedbar--timer-2 (run-with-idle-timer 0.2 t 'd-speedbar--set--delete-all))
  ;;(setq d-speedbar--timer-3 (run-with-idle-timer 0.4 t 'd-speedbar--set--set-current))
  )

(d-speedbar--turn-on-timers)

;;; (d-speedbar--turn-off-timers)
(defun d-speedbar--turn-off-timers ()
  (cancel-timer d-speedbar--timer-2)
  (cancel-timer d-speedbar--timer-3)
  )

(defun d-speedbar--get-compilation-strobes ()
  (save-match-data
    (save-excursion
      (let (list)
        (progn
          (goto-char (point-min))
          (setq list nil)
          (while (re-search-forward "^\\*\\*\\*\\* STROBE=\"[a-zA-Z0-9_]+\"" (point-at-eol) t)
            (setq list (cons (buffer-substring-no-properties (match-beginning 0) (match-end 0))
                             list)))
          (setq list (mapcar 'regexp-quote list))
          (setq list (nreverse list))
          list)
        ))))

(defun d-speedbar--goto-method ()
  (interactive)
  ;;(d-walk-frames
  (save-match-data
    (let (name args line old-point done old-buf old-win new-win
               count str class start end speedbar-buffer)
      (setq speedbar-buffer (d-speedbar--get-speedbar-buffer))
      ;;; (cons (buffer-name (current-buffer)) speedbar-buffer)
      (if (not (string= (buffer-name (current-buffer)) speedbar-buffer))
          t ;;(error "apple")
        (unwind-protect
            (progn
              ;;(debug 456)
              (set-buffer speedbar-buffer)
              (setq old-buf local-old-buffer)
              (read-only-mode -1)
              (cond
               ;; ------------------------------------------------------
               ((eq d-old-major-mode 'dired-mode)
                (setq f (d-current-line-as-string))
                (find-file f))
               ;; ------------------------------------------------------
               ((eq d-old-major-mode 'java-mode)
                ;;(setq pair (d-get-class))
                ;;(setq class (if (consp pair) (car pair) nil))
                ;;(if foo (debug "Antelope"))
                ;;(setq foo nil)
                (beginning-of-line)
                (if (looking-at "^class \\([A-Za-z0-9_]+\\)$")
                    (save-excursion
                      (setq class (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                      (other-window 1)
                      (goto-char (point-min))
                      (if (not (re-search-forward (concat "^\\(public +\\|abstract +\\|final +\\)*class " class) nil t))
                          (error "smeg 3"))
                      (beginning-of-line)
                      (other-window 1)
                      )
                  (save-excursion
                    (beginning-of-line)
                    (re-search-backward "^class \\([A-Za-z0-9_]+\\)$" nil t)
                    (setq class (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                    ;;(d-beeps "class=%s" class)
                    )
                  (beginning-of-line)
                  (assert (looking-at "\\(^[A-Za-z_][A-Za-z0-9_]*\\)[ \t]*\\(([^()]*);?\\)"))
                  (setq name-java (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                  (setq args-java (if (and (match-beginning 2) (match-end 2))
                                      (buffer-substring-no-properties (match-beginning 2) (match-end 2))))
                  (other-window 1)
                  (goto-char (point-min))
                  (if (not (re-search-forward (concat "^\\(public +\\|protected +\\|private +\\|abstract +\\|final +\\|static +\\)*class " class) nil t))
                      (error "smeg 4"))
                  (setq start (window-point))
                  (beginning-of-line)
                  ;;(debug "regina")
                  (forward-line 1)
                  (assert (looking-at "^{"))
                  ;;(debug "tomales")
                  (forward-sexp 1)
                  (setq end (window-point))
                  (goto-char start)
                  ;;(debug "Carrot")
                  (while (re-search-forward (concat "^" (make-string c-basic-offset ? )  "\\(public +\\|protected +\\|private +\\|final +\\|static +\\|abstract +\\|\\)*[A-Za-z0-9_<>]+[ \t]*" name-java "[ \t]*" (regexp-quote args-java)) end t)
                    )
                  ;;(debug "antelope")
                  (beginning-of-line)))
               ;; ---------------------------------------------------- ---------
               ((or (eq d-old-major-mode 'c-mode) (eq d-old-major-mode 'c++-mode))
                (beginning-of-line)
                (assert (looking-at "\\(^[a-zA-Z0-9_+:-]*\\)[ \t]*\\(([^()]*)\\)"))
                (setq name (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                (setq args (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                (other-window 1)
                (goto-char (point-min))
                (while (and (re-search-forward (concat name "[ \t]*" (regexp-quote args)) nil t)
                            (not (save-match-data
                                   (save-excursion
                                     (forward-line 1)
                                     (beginning-of-line)
                                     (looking-at "^   {"))))))
                (beginning-of-line))
               ;; ----------------------------------------------------
               ((eq d-old-major-mode 'emacs-lisp-mode)
                ;;(debug 789)
                (beginning-of-line)
                (when (looking-at "\\(^[a-zA-Z0-9_+<>/=:-]*\\)[ \t]*\\(([^()]*)\\)")
                  (setq name (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                  (setq args (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                  (set-buffer old-buf)
                  (goto-char (point-min))
                  (while (re-search-forward (concat "(\\(defun\\|defmacro\\|defadvice\\)[ \t]*" name "[ \t]*" (regexp-quote args)) nil t))
                  (other-window 1)
                  ;;(if foo (debug 123))
                  ;;(setq foo nil)
                  (beginning-of-line)
                  ))
               ;; ------------------------------------------------------
               ((eq d-old-major-mode 'compilation-mode)
                (beginning-of-line)
                (when (looking-at "^\\*\\*\\*\\* STROBE=\"[a-zA-Z0-9]*\"")
                  (setq line (concat "^[ \t]*" (regexp-quote (d-trim-string (d-current-line-as-string)))))
                  (set-buffer d-speedbar--buf-name)
                  (other-window 1)
                  (goto-char (point-min))
                  (if (not (re-search-forward line nil t))
                      (error "smeg 4"))
                  (beginning-of-line)))
               ;; ----------------------------------------------------
               ((eq d-old-major-mode 'c2j-mode)
                (beginning-of-line)
                (when (looking-at "^[0-9]+ strobe \"[a-zA-Z0-9]*\";")
                  ;;(setq line (concat "^[ \t]*" (regexp-quote (d-trim-string (substring (d-current-line-as-string) (match-beginning 0) (match-end 0))))))
                  (setq line (concat "^[ \t]*" (regexp-quote (d-trim-string (buffer-substring-no-properties (match-beginning 0) (match-end 0))))))
                  (set-buffer d-speedbar--buf-name)
                  (other-window 1)
                  (goto-char (point-min))
                  (if (not (re-search-forward line nil t))
                      (error "smeg 5"))
                  (beginning-of-line)))
               ;; ----------------------------------------------------
               ((eq d-old-major-mode 'php-mode)
                (beginning-of-line)
                (setq line (d-current-line-as-string))
                (other-window 1)
                (goto-char (point-min))
                (if (not (re-search-forward (concat "^[ \t]*function[ \t]*" (regexp-quote line)) nil t))
                    (error "smeg 6"))
                (beginning-of-line)
                )
               ;; ------------------------------------------------------
               ))
          (when (d-buffer-live-p speedbar-buffer)
            (set-buffer speedbar-buffer)
            (read-only-mode 1)
            (recenter)
            (when (d-buffer-live-p old-buf)
              (set-buffer old-buf)
              (beginning-of-line)
              (recenter)))
          )))))

(defadvice d-compilation-finish-function (after d-speedbar activate)
  (d-speedbar))

(defadvice d-dired-advertised-find-file (after d-speedbar activate)
  (d-speedbar))

(defadvice d-find-file (around d-speedbar activate)
  (unwind-protect
      ad-do-it
    (run-with-timer 0.5 nil 'd-speedbar)))

;;(defadvice find-file (after d-speedbar activate)
;;  ;;(beep)
;;  (d-speedbar))

;;(defadvice switch-to-buffer (around d-speedbar activate)
;;  (delete-other-windows)
;;  ad-do-it
;;  (d-speedbar))

(defadvice info (before d-speedbar activate)
  (delete-other-windows))

(defadvice d-f2 (after d-speedbar activate)
  (d-speedbar))

(defadvice d-shift-f2 (around d-speedbar activate)
  ad-do-it
  (let* ((list (buffer-list))
         (ptr  list))
    (while ptr
      (when (and (not (string-match "^ \\*" (buffer-name (car ptr))))
                 (not (string-match "^\\*" (buffer-name (car ptr)))))
        (switch-to-buffer (car ptr))
        (setq ptr nil))
      (setq ptr (cdr ptr)))))

(defadvice d-f3 (after d-speedbar activate)
  (d-speedbar))

(defadvice d-super-f3 (around d-speedbar activate)
  (unwind-protect
      ad-do-it
    (run-with-timer 10.0 nil 'd-speedbar)))

(global-set-key [f4] 'd-f4)

(defun d-f4 ()
  (interactive)
  ;;(message "d-f4")
  ;;(sit-for 3)
  (if (fboundp 'd-speedbar-new)
      (d-speedbar-new)
    (d-speedbar))
  )

(defadvice d-f9 (around d-speedbar activate)
 ad-do-it
 (d-speedbar))

(defadvice d-shift-f9 (around d-speedbar activate)
  (delete-other-windows)
  ad-do-it
  (d-speedbar))

(global-set-key "\C-ha" 'apropos)

(defadvice describe-function (around d-speedbar activate)
  (when (d-window-live-p d-window-right)
    (select-window d-window-right)
    (other-window 1)
    )
  ad-do-it
  (switch-to-buffer "*Help*")
  (d-speedbar))

;;(defadvice describe-function (around d-speedbar activate)
;;  ad-do-it
;;  (select-window (get-buffer-window "*Help*"))
;;  (delete-other-windows))

(defadvice describe-variable (around d-speedbar activate)
  (when (d-window-live-p d-window-right)
    (select-window d-window-right)
    (other-window 1)
    )
  ad-do-it
  (switch-to-buffer "*Help*")
  (d-speedbar)
  ;;(select-window (get-buffer-window "*Help*")
  ;;(delete-other-windows)
  )

(defadvice occur (around d-speedbar activate)
  (delete-other-windows)
  ad-do-it
  (switch-to-buffer "*Occur*")
  (d-speedbar))

(defadvice grep (before d-speedbar activate)
  (let ((d nil))
    (setq d default-directory)
    (switch-to-buffer "*grep*")
    (setq default-directory d)
    ;;(d-speedbar)
    ))

(defadvice compile (before d-speedbar activate)
  (let ((d nil))
    (setq d default-directory)
    (switch-to-buffer "*compilation*")
    (setq default-directory d)
    (d-speedbar)))

(global-set-key "\C-hf" 'describe-function)

(defadvice Info-exit (after d-speedbar activate)
  (d-speedbar))

;;(global-set-key "\C-hv" 'describe-variable-outer)

(global-set-key "\M-$" 'ispell-word-outer)

;; wristwatch
(defun ispell-word-outer ()
  (interactive)
  (delete-other-windows)
  (call-interactively 'ispell-word)
  )

(defun ispell-highlight-spelling-error-overlay (&rest args)
  "Prevents ispell highlight bug"
  )

(defadvice calendar (around d-speedbar activate)
  (delete-other-windows)
  ad-do-it
  )

;;(global-set-key [(kp-enter)] 'd-speedbar--print-idle-list)

(defun d-speedbar--print-idle-list ()
  (interactive)
  (message (prin1-to-string (describe-variable 'timer-idle-list))))

(setq-default Buffer-menu-use-frame-buffer-list t)

;;(defun d-switch-to-buffer ()
;;  (call-interactively 'switch-to-buffer)
;;  (delete-other-windows))

(defadvice compile-goto-error (around d-speedbar activate)
  (delete-other-windows)
  ad-do-it
  (read-only-mode -1)
  (run-with-timer 0.01 nil 'd-speedbar)
  ;;(d-speedbar)
  )

;;(defadvice grep (around d-speedbar activate)
;;  ad-do-it
;;  (d-speedbar))

(defadvice push-button (around d-speedbar activate)
  ;;(d-delete-speedbar-window) PUT BACK!
  (delete-other-windows)
  ad-do-it
  )

(defadvice other-window (around d-speedbar activate)
  ad-do-it
  ;;(setq d-old-method nil)
  )

(defadvice find-tag (around d-speedbar activate)
  ad-do-it
  (d-speedbar))

(defadvice apropos (around d-speedbar activate)
  (when (d-window-live-p d-window-right)
    (select-window d-window-right)
    (other-window 1))
  ad-do-it
  (when (get-buffer "*Apropos*")
    (select-window (get-buffer-window "*Apropos*"))
    (delete-other-windows)
    )
  )

(defadvice d-comp-enter (around d-speedbar activate)
  ad-do-it
  ;;(select-window (get-buffer-window d-speedbar--buf-name))
  ;;(other-window 1)
  (delete-other-windows)
  (d-speedbar))

(defadvice d-kill-buffer (around d-speedbar activate)
  (delete-other-windows)
  ad-do-it
  ;;(if (string= (buffer-name (current-buffer)) d-speedbar--buf-name)
  ;;    (kill-buffer nil))
  (d-speedbar)
  )

(defadvice occur-mode-goto-occurrence (around d-speedbar activate)
  ad-do-it
  (delete-other-windows)
  )

(d-quote defun d-set-frame-speedbar-correspondence ()
  (setq list (current-frame-configuration))
  (setq ptr list)
  (setq ptr (cdr ptr))
  (setq d-frame-speedbar-correspondence nil)
  (setq count 0)
  (while ptr
    (setq d-frame-speedbar-correspondence (cons (cons (caar ptr) (format d-speedbar--format-spec count))
                                                d-frame-speedbar-correspondence))
    (generate-new-buffer (cdar d-frame-speedbar-correspondence))
    ;;(message "buf=%s" (cdar d-frame-speedbar-correspondence))
    ;;(insert (format "frame=%s" (caar ptr)))
    (setq ptr (cdr ptr))
    (incf count)
    )
  d-frame-speedbar-correspondence
  )

;;(d-set-frame-speedbar-correspondence)

(d-quote defadvice make-frame-command (around d-speedbar activate)
  ad-do-it
  (let ((count 0)
        (done  nil))
  ;;(message "***1 new frame%s" (car d-frame-speedbar-correspondence))
  ;;(sit-for 3)
  (while (not done)
    (setq str (format d-speedbar--format-spec count))
    (when (not (get-buffer str))
      (setq done t)
      (setq d-frame-speedbar-correspondence (cons (cons (selected-frame) str)
                                                  d-frame-speedbar-correspondence)))
    (incf count))
  ;;(message "***2 new frame%s" (car d-frame-speedbar-correspondence))
  ;;(sit-for 3)
  ))

;;; (setq buf speedbar-buffer)
;;; (d-buffer-live-p buf)
(defun d-buffer-live-p (buf)
  (and buf (get-buffer buf) (buffer-live-p (get-buffer buf))))

;;; (setq win (car (window-list)))
;;; (setq win speedbar-window)
(defun d-window-live-p (win)
  (and win (windowp win) (window-live-p win)))

(provide 'd-speedbar)
;; d-speedbar.el ends here

