;;; 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-2016 Davin Pearson

;; Author/Maintainer: Davin Max Pearson <davin.pearson@gmail.com>
;; Version: 1.4
;; Package-Requires: ((cl) (diagnose "1.0") (d-electric "1.17") (d-comp "1.17") (d-keys "1.0"))
;; Keywords: Current function method C, C++, Lisp, Java, my new language _Java_Training_Wheels_ and my new language Lisp++
;; URL: http://davin.50webs.com/research/2010/mopa2e2.html#d-speedbar

;;; 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:

;; None so far!

;;; Version History

;; VERSION 1.4: ADDED: (if (not (d-speedbar--is-speedbar-showing))
;; (d-speedbar)) to the start of d-speedbar--set--delete-all.

;; Version 1.3: FIXED: a bug with d-speedbar in conjunction with dired-mode
;; (put-text-property (point-at-bol) (point-at-eol) 'face' 'default)
;; ->
;; (put-text-property (point-at-bol) (point-at-eol) 'face 'default)
;;

;; Version 1.2 ADDED: support for d-speedbars in jtw-mode (Java
;; Training Wheels)

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

;; Version 1.0 First stable version.

;;; Code:

(require 'cl)
(assert (fboundp 'incf))
(assert (fboundp 'cdddr))
(assert (fboundp 'assert))

(if (not (boundp 'prefs-advanced-user-p))
    (setq prefs-advanced-user-p t))

(require 'diagnose)
(require 'cfm)
(require 'd-electric)
(require 'd-comp)
(require 'd-keys)

(progn
  (make-variable-buffer-local 'd-speedbar-mode)
  (kill-local-variable 'd-window-size)
  (kill-local-variable 'd-old-major-mode)
  (setq-default d-window-size    15
                d-old-major-mode nil
                cursor-in-non-selected-windows t
                )
  (defvar d-speedbar-map (make-keymap))
  ;;; DONE: added space to names format-name and regexp-name
  (defvar d-speedbar--format-name " *d-%d*")
  (defvar d-speedbar--regexp-name "^ \\*d-\\([0-9]+\\)\\*$")
  (copy-face 'font-lock-function-name-face 'd-face-speedbar-highlighted)
  (kill-local-variable 'd-frame--buffer-window-correspondence)
  (defvar d-frame--buffer-window-correspondence (cons (list (selected-frame) "*d-0*" (selected-window)) nil))
  (kill-local-variable 'd-old-method)
  (defvar d-old-method nil)
  (kill-local-variable 'd-all-smegs)
  (defvar d-all-smegs  nil)
  (kill-local-variable 'cfm--method)
  (defvar cfm--method nil)
  )

(defun d-get-classes ()
  (save-excursion
    (save-match-data
      (goto-char (point-min))
      (setq *d-classes* nil)
      (while (re-search-forward "^\\(public[ \t]+\\|abstract[ \t]+\\)*\\(class[ \t]+\\|interface[ \t]+\\)\\([A-Z][a-zA-Z0-9_]*\\)" nil t)
        (setq *d-classes* (cons (list
                                 (buffer-substring-no-properties (match-beginning 2) (match-end 2))
                                 (buffer-substring-no-properties (match-beginning 3) (match-end 3))
                                 (d-what-line))
                                *d-classes*)))
      (setq *d-classes* (cons
                         (list "None"
                               "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 debug-on-error (debug "Cursum Pecficio"))
      (if (< (d-what-line) (nth 2 (car ptr)))
          (progn
            (setq done t)
            ;;(setq ptr nil)
            )
        (setq ptr-old ptr)
        (setq ptr (cdr ptr))
        ))
    (if done (car ptr-old) "Not found"))
  )

(defun d-speedbar--get-old-window ()
  (save-match-data
    (let (ptr result)
      (setq ptr    (window-list))
      (setq result nil)
      (while ptr
        (when (not (string-match d-speedbar--regexp-name
                                 (buffer-name (window-buffer (car ptr)))))
          (setq result (car ptr))
          (setq ptr nil))
        (setq ptr (cdr ptr)))
      result))
  )

;; (d-speedbar--get-old-buffer)
(defun d-speedbar--get-old-buffer ()
  (window-buffer (d-speedbar--get-old-window)))

;;; (setq str " *d-0*")
;;; (d-speedbar--str-to-count str)
(defun d-speedbar--str-to-count (str)
  (save-match-data
    (let ((n 0))
      (if (string-match d-speedbar--regexp-name str)
          (progn
            (setq n (substring str (match-beginning 1) (match-end 1)))
            (setq n (read-str n)))
        (setq n -1)
        n))))

;; (setq ptr (buffer-list))
;; (d-speedbar--get-count (buffer-list))
;; (setq d-message-on t)
(defun d-speedbar--get-count (buffer-list)
  (save-match-data
    (let ((ptr     buffer-list)
          (buf     nil)
          (n       0)
          (m       0)
          (count   0)
          (done    nil)
          (win     nil)
          (found   nil)
          (old-buf (current-buffer)))
      (unwind-protect
          (progn
            (setq count 0)
            (while ptr
              (setq buf (buffer-name (car ptr)))
              (setq n (if (string-match d-speedbar--regexp-name buf)
                          (progn
                            (when (or (not buf) (not (get-buffer buf)) (not (buffer-live-p (get-buffer buf))))
                              (setq found t)
                              (setq ptr nil)
                              )
                            (setq m (d-speedbar--str-to-count buf))
                            m) 0))
              (setq count (max n count))
              (setq ptr (cdr ptr)))
            (when (not found)
              (incf count))
            ) ;; END PROGN!
        (set-buffer old-buf)
        ) ;; END UNWIND-PROTECT!
      count
      )))

;; (setq list (buffer-list))
;; (d-speedbar--get-latest-speedbar-buffer)
(defun d-speedbar--get-latest-speedbar-buffer ()
  (save-match-data
    (save-excursion
      (let* ((list   (buffer-list))
             (count  0)
             (result nil))
        ;;(message-and-sit "*** 1 after let form")
        (setq count (d-speedbar--get-count list))
        ;;(message-and-sit "*** 2 before when")
        (setq result (format d-speedbar--format-name count))
        (assert (stringp result))
        (assert result)
        result
        ))))

(defun d-speedbar--set-window-size ()
  (cond
   ((eq major-mode 'dired-mode)
    (setq d-window-size 10))
   ((eq major-mode 'emacs-lisp-mode)
    (setq d-window-size 20))
   ((eq major-mode 'java-mode)
    (setq d-window-size 20))
   ((eq major-mode 'jtw-mode)
    (setq d-window-size 20))
   ((eq major-mode 'c++-mode)
    (setq d-window-size 20))
   ((eq major-mode 'c2j-mode)
    (setq d-window-size 20))
   ((eq major-mode 'compilation-mode)
    (setq d-window-size 20))
   ((eq major-mode 'php-mode)
    (setq d-window-size 30))
   ((eq major-mode 'makefile-mode)
    (setq d-window-size 20))
   ((or (eq major-mode 'electric-buffer-menu-mode)
        (eq major-mode 'minibuffer-inactive-mode)
        (eq major-mode 'fundamental-mode)
        (eq major-mode 'occur-mode)
        (eq major-mode 'help-mode)
        (eq major-mode 'text-mode)
        (eq major-mode 'messages-buffer-mode)
        )
    (setq d-window-size nil))
   (t
    (setq d-window-size nil)))
  d-window-size)

;; (d-speedbar--is-speedbar-showing)
(defun d-speedbar--is-speedbar-showing ()
  (let ((ptr   (window-list))
        (found nil))
    (while ptr
      (when (string-match d-speedbar--regexp-name (buffer-name (window-buffer (car ptr))))
        (setq found t)
        (setq ptr nil))
      (setq ptr (cdr ptr)))
    found
    ))

;;; (setq alist '((abc . def) (ghi jkl)))
;;; (d-speedbar)
;;; NOTE: sfsasdas
(defun d-speedbar ()
  (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 a speedbar-buf-name speedbar-window)
      (when (and (not (eq major-mode 'minibuffer-inactive-mode))
                 (not (eq major-mode 'electric-buffer-menu-mode)))
        (setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
;;; (setq alist '((abc . "def")))
;;; (assq 'abc alist)
;;; (setcdr (assq 'abc alist) "poo-bear")
        (if a
            (progn
              (setq speedbar-buf-name (nth 1 a))
              (setq speedbar-window   (nth 2 a))
              (assert speedbar-buf-name)
              (assert (stringp speedbar-buf-name))
              (if (not (buffer-live-p speedbar-buf-name))
                  (setq speedbar-buf-name (d-speedbar--get-latest-speedbar-buffer)))
              ;;(assert speedbar-window)
              ;;(assert (windowp speedbar-window))
              ;;(assert (window-live-p speedbar-window))
              ;;(debug "Hot tomales")
              )
          (setq speedbar-buf-name (d-speedbar--get-latest-speedbar-buffer))
          (assert speedbar-buf-name)
          (assert (stringp speedbar-buf-name))
          (setq speedbar-window (get-buffer-window (get-buffer speedbar-buf-name)))
          (setq d-frame--buffer-window-correspondence (cons (list
                                                             (selected-frame)
                                                             speedbar-buf-name
                                                             speedbar-window)
                                                            d-frame--buffer-window-correspondence))
          (setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
          (assert a)
          (setq speedbar-buf-name (nth 1 a))
          (setq speedbar-window   (nth 2 a))
          (assert (window-live-p speedbar-window))
          )
        ;; -----------------------------------------------------------
        ;;(message-and-sit "Potato")
        (d-quote
         (setq ptr (window-list))
         (while ptr
           (when (string-match d-speedbar--regexp-name
                               (buffer-name (window-buffer (car ptr))))
             (setq speedbar-window (car ptr))
             (setq ptr nil))
           (setq ptr (cdr ptr)))
         )
        ;; -----------------------------------------------------------
        ;;(message-and-sit "generate-new-buffer")
        (progn
          (if (and speedbar-buf-name (get-buffer speedbar-buf-name))
              (kill-buffer speedbar-buf-name))
          (setq new-buf (buffer-name (generate-new-buffer speedbar-buf-name))))
        ;;(message-and-sit "before assert new-buf=%s" new-buf)
        (assert new-buf)
        ;;(message-and-sit "before unwind-protect")
        (unwind-protect
            (save-excursion
              (d-delete-speedbar-window)
              ;;(message-and-sit "before setq old-buf")
              (setq old-buf (d-speedbar--get-old-buffer))
              (set-buffer old-buf)
              ;; -------------------------------------------------------
              ;;(message-and-sit "before set-buffer new-buf")
              (assert new-buf)
              (assert (stringp new-buf))
              ;;(assert nil)
              (set-buffer new-buf)
              ;;(erase-buffer)
              ;;(insert "Feng Shui\n")
              (setq d-speedbar-mode t)
              (if (string-match d-speedbar--regexp-name new-buf)
                  (read-only-mode 1)
                )
              (assert d-speedbar-mode)
              (use-local-map d-speedbar-map)
              (local-set-key [(return)] 'd-speedbar--goto-method)
              ;;(message-and-sit "before set-buffer old-buf")
              (set-buffer old-buf)
              (kill-local-variable 'd-old-major-mode)
              (setq-default d-old-major-mode major-mode)
              (setq-default spaces (make-string c-basic-offset ? ))
              (kill-local-variable 'd-window-size)
              (d-speedbar--set-window-size)
              (progn
                (setq list nil)
                (setq list (cons (list ""
                                       (if (buffer-file-name) (file-name-nondirectory (buffer-file-name)) (buffer-name))
                                       "") list))
                (if d-window-size
                    (setq list (cons (list "" ;; 0
                                           (make-string d-window-size ?-) ;; 1
                                           "" ;; 2
                                           nil ;; 3
                                           ) list)))
                (goto-char (point-min))
                (assert old-buf)
                (assert new-buf)
                ;;(message-and-sit "Passed asserts, entering cond form")
                (cond
                 ;; ------------------------------------------------------
                 ((eq major-mode 'dired-mode)
                  (setq list2 (directory-files-subdirs default-directory nil "^[^.]" t))
                  (setq list2 (sort list2 'string<-ignore-case))
                  (setq ptr2 list2)
                  (while ptr2
                    (setq list (cons
                                (list ""
                                      (concat (car ptr2) "/")
                                      "") list))
                    (setq ptr2 (cdr ptr2)));;                                                                                                                                                                                               x
                  (setq list2 (directory-files default-directory nil "\\.\\(bat\\|c\\|cc\\|c2j\\|cpp\\|css\\|el\\|h\\|html?\\|hts\\|java\\|js\\|m4\\|php\\|tes\\|tex\\|jtw\\|txt\\|jpg\\|png\\|bmp\\|xcf\\|tar\\|gz\\|exe\\|flac\\|zip\\)$" t))
                  (setq list2 (sort list2 'string<-ignore-case))
                  (setq ptr2 list2)
                  (while ptr2
                    (setq list (cons
                                (list ""
                                      (car ptr2)
                                      "") list))
                    (setq ptr2 (cdr ptr2)))
                  ;;(run-with-timer 0.25 nil 'd-speedbar--set--set-current)
                  )
                 ;; -----------------------------------------------------
                 ((eq major-mode 'emacs-lisp-mode)
                  (save-excursion
                    (set-buffer new-buf)
                    (setq truncate-lines nil))
                  (save-excursion
                    (set-buffer old-buf)
                    (setq truncate-lines t))
;;;                                                                 -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 old-buf)
                    (setq truncate-lines t))
                  (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 'jtw-mode)
                  ;;(let (done p1 p2 decl name decl1 name1 decl2 name2 decl3 name3)
                  (save-excursion
                    ;;(switch-to-buffer old-buf)
                    ;;(switch-to-buffer new-buf)
                    (set-buffer old-buf)
                    (setq truncate-lines t))
                  (d-get-classes)
                  ;;(if debug-on-error (debug "Demons"))
                  (goto-char (point-min))
                  (setq done nil)
                  (setq p1    nil)
                  (setq p2    nil)
                  (while (not done)
                    (setq decl  "")
                    (setq name  "")
                    (setq decl1 "")
                    (setq name1 "")
                    (setq decl2 "")
                    (setq name2 "")
                    (setq decl3 "")
                    (setq name3 "")
                    (setq p (point))
                    (setq p1 (re-search-forward (concat "^[ \t]*\\(public +\\|private +\\|protected +\\|\\)\\(abstract +\\|final +\\)*"
                                                        "\\(function +\\|method +\\|property +\\|classVar +\\)"
                                                        "\\(void +\\|boolean[][]* +\\|byte[][]* +\\|char[][]* +\\|short[][]* +\\|int[][]* +\\|long[][]* +\\|float[][]* +\\|double[][]* +\\|[A-Z][a-zA-Z0-9_]*[][]* +\\)"
                                                        "\\([a-zA-Z_][a-zA-Z0-9_<>,]*\\) *[();=]") nil t))
                    (when p1
                      (assert (match-beginning 3) (match-end 3))
                      (setq decl1 (buffer-substring-no-properties (match-beginning 3) (match-end 3)))
                      (setq name1 (buffer-substring-no-properties (match-beginning 5) (match-end 5))))
                    (goto-char p)
                    (setq p2 (re-search-forward (concat "^[ \t]*\\(public +\\|private +\\|protected +\\|\\)"
                                                        "\\(abstract +\\|final +\\)*"
                                                        "\\(constructor +\\)"
                                                        "\\([A-Z][a-zA-Z0-9]*\\)") nil t))
                    (when p2
                      (setq decl2 (buffer-substring-no-properties (match-beginning 3) (match-end 3)))
                      (setq name2 (buffer-substring-no-properties (match-beginning 4) (match-end 4))))
                    (goto-char p)
;;;                                 1                                          2                          3                          4
                    (setq p3 (re-search-forward (concat "^[ \t]*\\(public +\\|private +\\|protected +\\|\\)"
                                                        "\\(abstract +\\|final +\\)*"
                                                        "\\(class +\\|interface +\\)"
                                                        "\\([A-Z][a-zA-Z0-9_]*\\)") nil t))
                    (when p3
                      (setq decl3 (buffer-substring-no-properties (match-beginning 3) (match-end 3)))
                      (setq name3 (buffer-substring-no-properties (match-beginning 4) (match-end 4))))
                    (if (and (not p1) (not p2) (not p3))
                        (setq done t)
                      (progn
                        (if (not p1) (setq p1 (point-max)))
                        (if (not p2) (setq p2 (point-max)))
                        (if (not p3) (setq p3 (point-max)))
                        (if (and (< p1 p2) (< p1 p3))
                            (progn
                              (setq name name1)
                              (setq decl decl1)
                              (goto-char p1))
                          (if (and (< p2 p1) (< p2 p3))
                              (progn
                                (setq name name2)
                                (setq decl decl2)
                                (goto-char p2))
                            (if (and (< p3 p1) (< p3 p2))
                                (progn
                                  (setq name name3)
                                  (setq decl decl3)
                                  (goto-char p3))
                              (assert nil))))))
                    (setq list (cons (list ""
                                           decl
                                           name
                                           (cfm--get-jtw-class-or-interface)
                                           ) list)))
                  ;;(if debug-on-error (debug "Metallica's Carpe Diem Baby"))
                  )
                 ;; ------------------------------------------------------
                 ((or (eq major-mode 'c-mode)
                      (eq major-mode 'c++-mode))
                  (let ((p1 0) (p2 0) (p3 0) str1 str2 str3 (done nil))
                    (while (not done)
                      (goto-char (min p1 p2 p3))
                      (save-excursion
                        (progn
                          (setq str1 "^[ \t]*\\(namespace[ \t]+\\)\\([a-zA-Z][a-zA-Z0-9_]*\\)")
                          (setq p1 (re-search-forward str1 nil t)))
                        )
                      (save-excursion
                        (progn
                          (setq str2 "^[ \t]*\\(static[ \t]+\\|inline[ \t]+\\)*\\(void\\|bool\\|int\\|float\\|double\\|[a-zA-Z0-9_<>]+\\)[&*]* +\\([a-zA-Z0-9_:]+\\)\\(([^()]*)\\)")
                          (setq p2 (re-search-forward str2 nil t)))
                        )
                      (save-excursion
                        (progn
                          (setq str3 "^[ \t]*\\([A-Z]+[ \t]+\\)*class[ \t]+\\([a-zA-Z_][a-zA-Z0-9_]*\\)")
                          (setq p3 (re-search-forward str3 nil t)))
                        )
                      (if (and (not p1) (not p2) (not p3))
                          (setq done t)
                        (if (not p1) (setq p1 (point-max)))
                        (if (not p2) (setq p2 (point-max)))
                        (if (not p3) (setq p3 (point-max)))
                        (cond
                         ((and (<= p1 p2) (<= p1 p3))
                          (save-excursion
                            (re-search-forward str1 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))
                            ))
                         ;; ----------------------------------------------
                         ((and (<= p2 p1) (<= p2 p3))
                          (save-excursion
                            (re-search-forward str2 nil t)
                            (setq list (cons (list (buffer-substring-no-properties (match-beginning 2) (match-end 2))
                                                   (buffer-substring-no-properties (match-beginning 3) (match-end 3))
                                                   (buffer-substring-no-properties (match-beginning 4) (match-end 4))) list))
                            ))
                         ;; ----------------------------------------------
                         ((and (<= p3 p1) (<= p3 p2))
                          (save-excursion
                            (re-search-forward str3 nil t)
                            (setq list (cons (list "class"
                                                   (concat "class " (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                                                   "") list))
                            ))
                         ) ;; END COND!
                        )  ;; END IF!
                      )    ;; END WHILE NOT DONE!
                    )      ;; END LET!
                  (goto-char (point-min))
                  (while (re-search-forward "^(\\(cclass\\|cfunction\\) \\([a-zA-Z0-9_]+[*&]*\\|(cret [a-zA-Z0-9_]*) (cname \\([a-zA-Z0-9_]*\\))\\)" nil t)
                    (setq class-or-function (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                    (cond
                     ((string= "cclass" class-or-function)
                      (setq list (cons (list "cclass"
                                             (concat "cclass " (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                                             "")
                                       list)))
                     ;;(cclass (cret void) (cname foo))
                     ((string= class-or-function "cfunction")
                      (setq list (cons (list "cfunction"
                                             (if (and (match-beginning 3) (match-end 3))
                                                 (concat (buffer-substring-no-properties (match-beginning 3) (match-end 3)) "\n"))
                                             nil)
                                       list)))) ;; END COND!
                    ) ;; END WHILE RE-SEARCH-FORWARD!
                  ;;(debug "Hot tomales")
                  ) ;; END EQ MAJOR-MODE CXX-MODE!
                 ;; ------------------------------------------------------
                 ((eq major-mode 'c2j-mode)
                  (setq truncate-lines t)
                  (while (re-search-forward "^[ \t]*\\(\\([0-9]+\\) \\(strobe \".*\";\\)\\|\\([0-9]+\\) label function_\\([a-zA-Z0-9_]+\\);\\)\\(//.*$\\)?" nil t)
                    (setq list (cons (list ""
                                           (concat
                                            (if (and (match-beginning 2) (match-end 2))
                                                (buffer-substring-no-properties (match-beginning 2) (match-end 2))
                                              (if (and (match-beginning 4) (match-end 4))
                                                  (buffer-substring-no-properties (match-beginning 4) (match-end 4))))
                                            " "
                                            (if (and (match-beginning 3) (match-end 3))
                                                (buffer-substring-no-properties (match-beginning 3) (match-end 3))
                                              (if (and (match-beginning 5) (match-end 5))
                                                  (buffer-substring-no-properties (match-beginning 5) (match-end 5)))))
                                           ;;(if (and (match-beginning 3) (match-end 3))
                                           ;;  (buffer-substring-no-properties (match-beginning 3) (match-end 3)))
                                           "") 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 new-buf)
                    (setq truncate-lines t))
                  (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)
                  (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))))
                 ;; ----------------------------------------------------
                 ((eq major-mode 'makefile-mode)
                  (while (re-search-forward "^[-a-zA-Z0-9_+.]+:" nil t)
                    (setq list (cons (list
                                      ""
                                      (concat (buffer-substring-no-properties (match-beginning 0) (match-end 0)))
                                      ""
                                      ""
                                      )
                                     list))))
                 ;; ------------------------------------------------------
                 ) ;; END PROGN!
                ;;(make-local-variable 'local-old-buffer)
                ;;(make-local-variable 'local-old-window)
                ;;(setq local-old-buffer (current-buffer))
                ;;(setq local-old-window (selected-window))
                (set-buffer new-buf)
                (read-only-mode -1)
                (erase-buffer)
                ;;(insert "Feng Shui\n")
                (setq list (nreverse list))
                (setq ptr list)
                (setq class nil)
                (setq old-class nil)
                (while ptr
                  ;;(assert (bobp))
                  (goto-char (point-max))
                  ;;(debug 456)
                  (save-excursion
                    (when (or (eq d-old-major-mode 'jtw-mode)
                              (eq d-old-major-mode 'java-mode))
                      (setq old-class class)
                      ;;(if debug-on-error (debug "Right Here, Right Now!"))
                      ;;(setq ptr (cdr ptr))
                      (setq class (nth 1 (nth 3 (car ptr))))
                      (setq decl  (nth 2 (nth 3 (car ptr))))
                      ;;(if (and (string-match "property" decl) debug-on-error) (debug "Evening Falls"))
                      (when (not (string= class old-class))
                        (save-excursion
                          (set-buffer new-buf)
                          (goto-char (point-max))
                          (if (not (eq (point) (point-min)))
                              (insert "\n"))
                          ;;(beginning-of-line)
                          ;;(if decl (insert decl " "))
                          ;;(setq p1 (point))
                          ;;(if class (insert class "\n"))
                          ;;(setq p2 (point))
                          (progn
                            (read-only-mode -1)
                            ;;(if debug-on-error (debug "Handel's Messiah"))
                            ))
                        )))
                  (goto-char (point-max))
                  (setq p1 (point))
                  ;;(insert (nth 0 (car ptr)) " ")
                  (setq p2 (point))
                  ;;(if debug-on-error (debug "Fucking in Heaven"))
                  (insert
                   (if (and (nth 1 (car ptr)) (string-match "^make" (nth 1 (car ptr))) d-window-size)
                       (d-split (nth 1 (car ptr)) (- d-window-size 4))
                     (if (nth 1 (car ptr))
                         (nth 1 (car ptr)) "")))
                  (setq p3 (point))
                  (if (nth 2 (car ptr))
                      (insert (nth 2 (car ptr)) "\n"))
                  (put-text-property p2 p3 'face 'default)
                  ;;(if debug-on-error (debug "The Rockarfella Skank"))
                  ;;(message "buffer-substring-no-properties=" (buffer-substring-no-properties p2 p3))
                  ;;(sit-for 1)
                  ;;(debug "foomatic")
                  (setq ptr (cdr ptr))) ;; END WHILE PTR!
                (d-fontify-classes-and-interfaces)
                (if (eq major-mode 'dired-mode)
                    (d-speedbar--dired-fontify))
                ;;(d-speedbar--set--delete-all)
                (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)
                  )
                ;; -------------------------------------------------------------
                )) ;; END SAVE-EXCURSION!
          (assert new-buf)
          ;;(message "Black Sabbath: Rat Salad")
          ;;(assert (stringp new-buf))
          (when (and (boundp 'd-window-size) d-window-size
                     (not (eq major-mode 'minibuffer-inactive-mode))
                     (not (eq major-mode 'electric-buffer-menu-mode)))
            ;;(setq new-buf (nth 1 (assq (selected-frame) d-frame--buffer-window-correspondence))
            (cond
             ((fboundp 'split-window-right)
              (setq speedbar-window (split-window-right (- d-window-size))))
             ((fboundp 'split-window-horizontally)
              (setq speedbar-window (split-window-horizontally (- d-window-size)))
              )
             (t
              ))
            ;;(error "Carrot")
            (assert new-buf)
            '(if debug-on-error (error "Prince: Purple Rain"))
            (cond
             ((and (fboundp 'set-window-buffer)
                   (window-live-p speedbar-window)
                   new-buf)
              (set-window-buffer speedbar-window new-buf))
             ((and (fboundp 'display-buffer-same-window)
                   new-buf)
              (display-buffer-same-window new-buf nil))
             (t
              ))
            (select-window speedbar-window)
            )
          ;; -----------------------------------------------------------
          (when a
            (setf (nth 1 a) speedbar-buf-name)
            (setf (nth 2 a) speedbar-window)
            )
          (when (not a)
            (debug "When the doves cry")
            (setq d-frame--buffer-window-correspondence (cons (list (selected-frame) speedbar-buf-name speedbar-window)
                                                              d-frame--buffer-window-correspondence)))
          ;; -------------------------------------------------------------
          (progn
            (set-buffer new-buf)
            (if (string-match d-speedbar--regexp-name new-buf)
                (read-only-mode 1)
              )
            (goto-char (point-min))
            (other-window 1)
            ;;(d-speedbar)
            ;;(d-speedbar--set--delete-all)
            )
          ;;(error "Dance with the Dolphins")
          ) ;; END UNWIND-PROTECT!
        ) ;; END WHEN!
      )))

(defun d-fontify-classes-and-interfaces ()
  (interactive)
  (let (a speedbar-buf-name speedbar-window)
    (setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
    (if a
        (progn
          ;;(if debug-on-error (debug "Bjork: All Neon Like"))
          (setq speedbar-buf-name (nth 1 a))
          (when (not (buffer-live-p speedbar-buf-name))
            (setq speedbar-buf-name (d-speedbar--get-latest-speedbar-buffer))
            (generate-new-buffer speedbar-buf-name))
          ;;(setq speedbar-window   (nth 2 a))
          ;;(assert (window-live-p speedbar-window))
          (assert speedbar-buf-name)
          (assert (stringp speedbar-buf-name))
          )
      ;;(if debug-on-error (debug "Tell me lies"))
      (setq speedbar-buf-name (d-speedbar--get-latest-speedbar-buffer))
      (if (not (buffer-live-p speedbar-buf-name))
          (generate-new-buffer speedbar-buf-name))
      (assert speedbar-buf-name)
      (assert (stringp speedbar-buf-name)))
    (save-excursion
      (set-buffer speedbar-buf-name)
      (goto-char (point-min))
      (read-only-mode -1)
      (while (re-search-forward "^\\(class\\|interface\\) \\([A-Z][a-zA-Z0-9_]*\\)$" nil t)
        (put-text-property (match-beginning 1) (match-end 1) 'face 'font-lock-keyword-face)
        (put-text-property (match-beginning 2) (match-end 2) 'face 'font-lock-type-face)
        )
      ;;(if debug-on-error (debug "Big Love"))
      (read-only-mode 1)
      )))

(defun d-delete-speedbar-window ()
  (let (win)
    (delete-other-windows)
    (setq win (nth 2 (assq (selected-frame) d-frame--buffer-window-correspondence)))
    (if (and (window-live-p win) d-window-size (>= (count-windows) 2))
        (delete-window win))))

(defun d-split (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)
  (defadvice message (around d-speedbar activate)
    (if d-message-on
        ad-do-it))
  )

;;; (d-speedbar--cull-unused-buffers (setq b " *d-11*"))
(defun d-speedbar--cull-unused-buffers (b)
  ;;(message-and-sit 10 "d-speedbar--cull-unused-buffers")
  (assert b)
  (assert (stringp b))
  (let ((ptr (buffer-list)))
    (while ptr
      (if (and (string-match d-speedbar--regexp-name (buffer-name (car ptr)))
               (not (eq (car ptr) (get-buffer b))))
          (kill-buffer (car ptr)))
      (setq ptr (cdr ptr)))
    ))

(defun d-speedbar--dired-fontify ()
  (let ((case-fold-search t))
    (while (not (eobp))
      (setq str (d-current-line-as-string))
      (read-only-mode -1)
      (cond
       ((string-match "/$" str)
        (put-text-property (point-at-bol) (point-at-eol) 'face 'dired-directory)
        )
       ((or (string-match "\\.jpg$" str)
            (string-match "\\.png$" str)
            (string-match "\\.bmp$" str)
            (string-match "\\.xcf$" str)
            )
        (put-text-property (point-at-bol) (point-at-eol) 'face 'fg:lightmagenta)
        )
       ((string-match "\\.flac$" str)
        (put-text-property (point-at-bol) (point-at-eol) 'face 'dc-face-dired-sounds)
        )
       ((or (string-match "\\.tar$" str)
            (string-match "\\.gz$"  str)
            (string-match "\\.zip$"  str)
            )
        (put-text-property (point-at-bol) (point-at-eol) 'face 'fg:lightred)
        )
       ((string-match "\\.exe$" str)
        (put-text-property (point-at-bol) (point-at-eol) 'face 'fg:lightgreen)
        )
       ((string-match "\\.html?$" str)
        (put-text-property (point-at-bol) (point-at-eol) 'face 'font-lock-function-name-face)
        )
       (t
        (put-text-property (point-at-bol) (point-at-eol) 'face 'default)
        ))
      (forward-line 1))))

;;; (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)
;;; (d-speedbar--set--set-current)
(defun d-speedbar--set--delete-all ()
  (interactive)
  (let ((d-message-on t)
        (w            nil)
        p1 p2 done b p)
    (if (and (not (eq major-mode 'text-mode))
             (not (eq major-mode 'package-mode))
             (not (d-speedbar--is-speedbar-showing)))
        (d-speedbar))
    (when (and (not (eq major-mode 'minibuffer-inactive-mode))
               (not (eq major-mode 'electric-buffer-menu-mode)))
      (save-match-data
        (if (string-match d-speedbar--regexp-name (buffer-name))
            (progn
              ;;(error "Looking at d-speedbar")
              ;;(message "looking at (buffer-name)=%s" (buffer-name))
              ;;(if (and (eobp) (bobp)) (d-speedbar))
              (read-only-mode -1)
              (setq b (buffer-name (current-buffer)))
              ;;(setq p (point))
              ;; do nothing else
              )
          (unwind-protect
              (save-window-excursion
                (save-excursion
                  ;;(d-speedbar)
                  (setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
                  (assert a)
                  (setq b (nth 1 a))
                  (setq w (nth 2 a))
                  (assert w)
                  (assert (windowp w))
                  (assert (stringp b))
                  ;;(if debug-on-error (error "Schmu"))
                  ;;(assert (window-live-p w))
                  (if b
                      (d-speedbar--cull-unused-buffers b))
                  (if (or (not b) (not (stringp b))
                          (not (get-buffer b))
                          (and (get-buffer b)
                               (not (buffer-live-p (get-buffer b)))))
                      (save-excursion
                        (error "Dallas")
                        (setq b (d-speedbar--get-latest-speedbar-buffer))
                        (setf (nth 1 a) b)
                        (setf (nth 2 a) w)
                        (generate-new-buffer b)
                        ;;(if (get-buffer b) (set-buffer b))
                        ;;(d-speedbar)
                        )
                    ;;(message "Not Dallas")
                    ;;(d-speedbar)
                    )
                  (assert b)
                  (assert (stringp b))
                  (assert (buffer-live-p (get-buffer b)))
                  ;;(assert (and 'a-sailboat-in-the-moonlight (assq (selected-frame) d-frame--buffer-window-correspondence)))
                  ;;(assert (and 'me-myself-and-i (nth 1 (assq (selected-frame) d-frame--buffer-window-correspondence))))
                  (setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
                  (if a
                      (setf (nth 1 a) b))
                  ;;(error "Duke Ellington's Newport Up")
                  (cond
                   ;; ------------------------------------------------
                   ((eq major-mode 'emacs-lisp-mode)
                    (set-buffer b)
                    (if (and (eobp) (bobp)) (d-speedbar))
                    (setq p (point))
                    (read-only-mode -1)
                    ;;(message "Switched window")
                    ;;(sit-for 1)
                    (goto-char (point-min))
                    (while (not (eobp))
                      ;; "Suzie Salmon")
                      (beginning-of-line)
                      (setq p1 (point))
                      (skip-chars-forward "-a-zA-Z0-9_+<>/=:!")
                      (setq p2 (point))
                      ;;(if debug-on-error (debug "Black Sabbath: Laguna Sunrise"))
                      (when (not (eq p1 p2))
                        ;;(message-and-sit 10 "func=%s" (buffer-substring-no-properties p1 p2))
                        (put-text-property p1 p2 'face 'default)
                        )
                      (forward-line 1))
                    (assert (and 'story-of-bo-diddley p))
                    )
                   ;; ------------------------------------------------
                   ((or (eq major-mode 'c-mode)
                        (eq major-mode 'c++-mode)
                        (eq major-mode 'php-mode)
                        (eq major-mode 'java-mode)
                        )
                    ;;(error "Wrong mode #1")
                    (set-buffer b)
                    (if (and (eobp) (bobp)) (d-speedbar))
                    (read-only-mode -1)
                    (setq p (point))
                    (goto-char (point-min))
                    (while (re-search-forward "[a-zA-Z_][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)
                    (set-buffer b)
                    (if (and (eobp) (bobp)) (d-speedbar))
                    (read-only-mode -1)
                    (setq p (point))
                    ;;(error "Wrong mode #2")
                    (goto-char (point-min))
                    (while (not (eobp))
                      (beginning-of-line)
                      ;;(skip-chars-forward "* a-zA-Z0-9=\"/.")
                      (put-text-property (point-at-bol) (point-at-eol) 'face 'default)
                      (forward-line 1)))
                   ;; ------------------------------------------------
                   ((eq major-mode 'jtw-mode)
                    (set-buffer b)
                    (read-only-mode -1)
                    (if (and (eobp) (bobp)) (d-speedbar))
                    (setq p (point))
                    ;;(error "Wrong mode #3")
                    (goto-char (point-min))
                    (while (not (eobp))
                      (beginning-of-line)
                      (if (looking-at "^\\(class\\|interface\\)\\([ \t]+\\)\\([A-Z][a-zA-Z0-9_]*\\)$")
                          (progn
                            (put-text-property (match-beginning 1) (match-end 1) 'face 'font-lock-keyword-face)
                            (put-text-property (match-beginning 2) (match-end 2) 'face 'default)
                            (put-text-property (match-beginning 3) (match-end 3) 'face 'font-lock-type-face)
                            )
                        (put-text-property (point-at-bol) (point-at-eol) 'face 'default)
                        )
                      (forward-line 1)))
                   ;; ------------------------------------------------
                   ((eq major-mode 'dired-mode)
                    (let ((case-fold-search t))
                      (set-buffer b)
                      (setq p (point))
                      (if (and (eobp) (bobp)) (d-speedbar))
                      ;;(error "Wrong mode #4")
                      (d-speedbar--dired-fontify)
                      ))
                   ;; --------------------------------------------------
                   ((eq major-mode 'makefile-mode)
                    (let ((case-fold-search t))
                      (set-buffer b)
                      (setq p (point))
                      (if (and (eobp) (bobp)) (d-speedbar))
                      ;;(error "Wrong mode #4")
                      (while (not (eobp))
                        (setq str (d-current-line-as-string))
                        (read-only-mode -1)
                        (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)
                        (eq major-mode 'fundamental-mode))
                    (set-buffer b)
                    (if (and (eobp) (bobp)) (d-speedbar))
                    ;;(error "Wrong mode #5")
                    (read-only-mode -1)
                    (setq p (point))
                    (goto-char (point-min))
                    (while (not (eobp))
                      (beginning-of-line)
                      (put-text-property (point-at-bol) (point-at-eol) 'face 'default)
                      (forward-line 1)))
                   ;; --------------------------------------------------
                   ))) ;; END SAVE-WINDOW-EXCURSION!
            ;;(message "cfm--set--delete-all")
            (save-window-excursion
              (save-excursion
                ;;(setq w (nth 2 (assq (selected-frame) d-frame--buffer-window-correspondence)))
                ;;(assert w)
                ;;(assert (window-live-p w))
                ;;(select-window w)
                ;;(read-only-mode 1)
                ))) ;; END UNWIND-PROTECT!
          ))
      ;;(message-and-sit 5 "end of defun")
      (assert (stringp b))
      (set-buffer b)
      (if p
          (goto-char p))
      )))

;; (message-and-sit 10 (setq args '("abc d=%d=" 123)))
(defun message-and-sit (time &rest args)
  (apply 'message args)
  (sit-for time)
  )
;;; (message-and-sit "abc")

;; (d-speedbar--set--set-current)
(defun d-speedbar--set--set-current ()
  (interactive)
  (let (p (d-message-on t) b w a p1 p2)
    (save-match-data
      (if (string-match d-speedbar--regexp-name (buffer-name))
          (progn
            ;;(message "d-speedbar--set--set-current (buffer-name)=%s" (buffer-name))
            (read-only-mode 1)
            )
        (unwind-protect
            (progn
              ;;(message "d-speedbar--set--set-current in unwind-protect form")
              (save-excursion
                (setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
                (setq b (nth 1 a))
                (setq w (nth 2 a))
                (set-buffer b)
                (read-only-mode -1))
              (set-buffer (d-speedbar--get-old-buffer))
              (let (p1 p2 pair pair2 line class)
                (setq-default cfm--method nil)
                (set-buffer (d-speedbar--get-old-buffer))
                (d-speedbar--set-window-size)
                ;;(error "Smag")
                (cond
                 ;; ------------------------------------------------
                 ((eq major-mode 'emacs-lisp-mode)
                  (setq-default cfm--new (d-trim-string (cfm--get-defun)))
                  ;;(error "cfm--new=%s" cfm--new)
                  (when (not (string= cfm--new ""))
                    ;;(select-window d-window-right)
                    (set-buffer b)
                    (goto-char (point-min))
                    (setq cfm--method (concat "^" (regexp-quote cfm--new) "("))
                    ;;(message-and-sit "City slickers")
                    ;;(debug)
                    (setq cfm--method-2 cfm--method)
                    (when (re-search-forward cfm--method nil t)
                      ;;(message-and-sit "Calamansi")
                      ;;(sit-for 1)
                      (beginning-of-line)
                      (setq p1 (point))
                      (skip-chars-forward "-a-zA-Z0-9_+<>/=:!")
                      ;;(debug "Hole in one")
                      (setq p2 (point))
                      (setq d-str (buffer-substring-no-properties p1 p2))
                      ;;(message-and-sit "Rats tails")
                      ;;(debug "Duke Ellington")
                      (when (not (eq p1 p2))
                        (put-text-property p1 p2 'face 'd-face-speedbar-highlighted)
                        )
                      ;;(message-and-sit "Supercalifragulous cfm--method=%s" cfm--method)
                      (beginning-of-line)
                      ;;(message-and-sit "Double trouble")
                      ;;(insert "k")
                      ;;(debug "foo")
                      ;;(message-and-sit "Ishmael")
                      ))
                  )
                 ;; ------------------------------------------------
                 ((eq major-mode 'java-mode)
                  (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 ""))
                    (set-buffer b)
                    ;;(select-window d-window-right)
                    (goto-char (point-min))
                    (if (not (re-search-forward (concat "^class " class "$") nil t))
                        (message "smeg 1 not found class=%s" class)
                      (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 "(" nil t)
                        (setq p1 (point))
                        (skip-chars-backward "a-zA-Z0-9_")
                        (setq p2 (point))
                        (put-text-property p2 p1 'face 'd-face-speedbar-highlighted)
                        ))
                    )
                  )
                 ;; ------------------------------------------------
                 ((eq major-mode 'jtw-mode)
                  (setq pair-decl    (cfm--get-jtw-decl))
                  (setq triple-class (cfm--get-jtw-class-or-interface))
                  (when (and pair-decl triple-class)
                    (setq cfm--decl (car pair-decl))
                    (setq cfm--name (cdr pair-decl))
                    (setq cfm--old  (concat cfm--decl " " cfm--name))
                    (setq cfm--method cfm--old)
                    (setq str (d-current-line-as-string))
                    (if (string-match "\\<\\(class\\|interface\\)[ \t]+\\([a-zA-Z0-9_]+\\)\\>" str)
                        (progn
                          (setq decl (substring str (match-beginning 1) (match-end 1)))
                          (setq name (substring str (match-beginning 2) (match-end 2)))
                          (when (and (string= (nth 1 triple-class) name) (string= (nth 2 triple-class) decl))
                            (set-buffer b)
                            ;;(message "sitting")
                            ;;(sit-for 10)
                            (goto-char (point-min))
                            (re-search-forward (concat decl "[ \t]+" name) nil t)

                            (put-text-property (point-at-bol) (point-at-eol) 'face 'd-face-speedbar-highlighted)
                            ;;(if debug-on-error (debug "Emma Kirkby sings Handel"))
                            ))
                      (set-buffer b)
                      ;;(switch-to-buffer b)
                      (goto-char (point-min))
                      (re-search-forward (concat "\\<" (nth 2 triple-class) "[ \t]+" (nth 1 triple-class) "\\>") nil t)
                      (setq fock cfm--method)
                      (when (re-search-forward cfm--method nil t)
                        (put-text-property (point-at-bol) (point-at-eol) 'face 'd-face-speedbar-highlighted)
                        ;;(message-and-sit 10 "sitting")
                        ;;(if debug-on-error (debug "The Pure Voice of Emma Kirkby"))
                        ;;(message-and-sit 10 "fock=%s triple-class=%s pair-decl=%s" fock triple-class pair-decl)
                        )
                      )
                    )
                  )
                 ;; ------------------------------------------------
                 ((eq major-mode 'c++-mode)
                  (let (indent)
                    (setq indent 0)
                    (if (setq namespace (cfm--get-namespace))    (incf indent))
                    (if (setq class     (cfm--get-class indent)) (incf indent))
                    (setq pair (cfm--get-method indent))
                    (when pair
                      (setq cfm--new  (car pair))
                      (setq cfm--args (cadr pair))
                      (set-buffer b)
                      ;;(select-window d-window-right)
                      (goto-char (point-min))
                      (setq cfm--method (concat "\\(^\\|[^a-zA-Z0-9_:]+\\)" cfm--new (regexp-quote cfm--args)))
                      (if (re-search-forward cfm--method nil t)
                          (progn
                            (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)
                            ;;(debug "smelly cat")
                            )))
                    (setq cfm--new-2 (cfm--get-cfunction))
                    (when cfm--new-2
                      ;;(debug "Viagra")
                      (setq cfm--method (concat "^" cfm--new-2 "$"))
                      (set-buffer b)
                      (goto-char (point-min))
                      (if (and cfm--method (re-search-forward cfm--method nil t))
                          (progn
                            (end-of-line)
                            (setq p1 (point))
                            (skip-chars-backward "a-zA-Z0-9_ ")
                            (setq p2 (point))
                            (put-text-property p2 p1 'face 'd-face-speedbar-highlighted)
                            )))
                    ;;(debug "Cold potatoes")
                    ))
                 ;; ------------------------------------------------
                 ((eq major-mode 'c-mode)
                  (setq cfm--new (cfm--get-method 1))
                  (set-buffer b)
                  ;;(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 cfm--method (concat "\\(^\\|[^a-zA-Z0-9_:]\\)" cfm--new "("))
                  (setq cfm--method (concat "^cfunction " 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)
                    )
                  ;;(debug "Cold potatoes")
                  )
                 ;; ------------------------------------------------
                 ((eq major-mode 'php-mode)
                  (setq pair (cfm--get-php-function))
                  (setq cfm--new  (car pair))
                  (setq cfm--args (cdr pair))
                  (when (not (string= cfm--new ""))
                    (set-buffer b)
                    ;;(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)
                      )
                    ))
                 ;; ------------------------------------------------
                 ((eq major-mode 'compilation-mode)
                  (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 (and (not (string= cfm--new-2 "")) cfm--new-2)
                      (set-buffer b)
                      ;;(select-window d-window-right)
                      (goto-char (point-min))
                      (while ptr
                        (when (not (re-search-forward (concat "^" (car ptr)) nil t))
                          (message "smeg 2 not found %s" (car ptr))
                          )
                        (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)
                      ))
                  )
                 ;; ------------------------------------------------
                 ((eq major-mode 'c2j-mode)
                  (save-excursion
                    (d-quote save-excursion
                             (set-buffer b)
                             (beginning-of-line)
                             (setq p1 (point))
                             (skip-chars-forward "0-9")
                             (setq p2 (point))
                             (setq n (buffer-substring-no-properties p1 p2))
                             (beginning-of-line)
                             (message "n=%s" n)
                             (sleep-for 1)
                             )
                    (beginning-of-line)
                    (when (or ;;(looking-at "^[0-9]+ strobe.*$")
                           (looking-at         (concat "^[ \t]*\\([0-9]+\\) \\(strobe \"[a-za-Z0-9_]+\";\\|label function_\\([a-zA-Z0-9_]+\\);\\)"))
                           (re-search-backward (concat "^[ \t]*\\([0-9]+\\) \\(strobe \"[a-zA-Z0-9_]+\";\\|label function_\\([a-zA-Z0-9_]+\\);\\)") nil t))
                      (setq cfm--method (concat (buffer-substring-no-properties (match-beginning 1) (match-end 1))
                                                " "
                                                (if (and (match-beginning 3) (match-end 3))
                                                    (buffer-substring-no-properties (match-beginning 3) (match-end 3))
                                                  (buffer-substring-no-properties (match-beginning 2) (match-end 2)))))
                      (if (eq major-mode 'c2j-mode)
                          (setq cfm--method--debugging cfm--method))
                      ;;(debug 123)
                      ;;(setq cfm--method (substring cfm--method 0 3))
                      ;;(message (format "Smegulator cfm--method=%s" cfm--method))
                      ;;(sit-for 5)
                      (let ((d-message-on t))
                        (set-buffer b)
                        ;;(set-buffer d-speedbar--buf-name)
                        (goto-char (point-min))
                        (if (not (re-search-forward cfm--method nil t))
                            (message "smeg 3 not found cfm--method=%s" cfm--method)
                          (put-text-property (point-at-bol)
                                             (point-at-eol)
                                             ;;(+ (point-at-bol) 3)
                                             'face
                                             'd-face-speedbar-highlighted))))
                    ))
                 ;; ------------------------------------------------
                 ((eq major-mode 'dired-mode)
                  (setq line (d-current-line-as-string))
                  (when (string-match " \\([-+$a-zA-Z0-9_.]*\\)$" line)
                    (setq cfm--method (concat "^" (regexp-quote (substring line (match-beginning 1) (match-end 1))) "/?$"))
                    ;;(message "line=%s" line)
                    (set-buffer b)
                    ;;(set-buffer d-speedbar--buf-name)
                    (goto-char (point-min))
                    (if (not (re-search-forward cfm--method nil t))
                        t ;;(message "smeg 4 cfm--method=%s" cfm--method)
                      (put-text-property (point-at-bol)
                                         (point-at-eol)
                                         'face
                                         'd-face-speedbar-highlighted))
                    )
                  (when (string-match " \\([-+$a-zA-Z0-9_.]*\\) -> [-+$a-zA-Z0-9_.]*" line)
                    (setq cfm--method (concat "^" (regexp-quote (substring line (match-beginning 1) (match-end 1))) "/?"))
                    (set-buffer b)
                    (goto-char (point-min))
                    (if (re-search-forward cfm--method nil t)
                        (put-text-property (point-at-bol)
                                           (point-at-eol)
                                           'face
                                           'd-face-speedbar-highlighted))
                    ))
                 ;; ------------------------------------------------
                 ((eq major-mode 'makefile-mode)
                  (setq line (d-current-line-as-string))
                  (when (string-match "^[-a-zA-Z0-9_.]+:" line)
                    (setq cfm--method (concat "^" (substring line (match-beginning 0) (match-end 0)) "$"))
                    ;;(message "line=%s" line)
                    (set-buffer b)
                    ;;(set-buffer d-speedbar--buf-name)
                    (goto-char (point-min))
                    (if (not (re-search-forward cfm--method nil t))
                        (message "smeg 5 cfm--method=%s" cfm--method))
                    (put-text-property (point-at-bol)
                                       (point-at-eol)
                                       'face
                                       'd-face-speedbar-highlighted)
                    ))
                 ;; ------------------------------------------------
                 (t
                  ;;(message-and-sit 5 "major-mode=%s" major-mode)
                  ;;(assert (eq major-mode 'fundamental-mode))
                  ;;(debug "carrot")
                  ))
                ;;(beginning-of-line)
                (setq p (point))
                )) ;; END PROGN!
          ;;(message "before if")
          (if (or (not (string= d-old-method cfm--method)) d-all-smegs)
              (let (old-win)
                (unwind-protect
                    (progn
                      ;;(message "after if")
                      (setq old-win (selected-window))
                      (when d-window-size
                        (assert d-window-size)
                        (assert (integerp d-window-size))
                        (when (or (not w) (not (windowp w)) (not (window-live-p w)))
                          (when (and d-window-size
                                     (not (eq major-mode 'minibuffer-inactive-mode))
                                     (not (eq major-mode 'electric-buffer-menu-mode)))
                            (cond
                             ((fboundp 'split-window-right)
                              (setq w (split-window-right (- d-window-size))))
                             ((fboundp 'split-window-horizontally)
                              (setq w (split-window-horizontally (- d-window-size)))
                              )
                             (t
                              ))
                            (setf (nth 2 a) w))
                          ))
                      (assert w)
                      (assert (windowp w))
                      (when (window-live-p w)
                        (select-window w)
                        (set-window-point (selected-window) p)
                        (set-buffer (window-buffer))
                        ;;(d-speedbar)
                        (goto-char p)
                        ;;(d-beeps "p=%s" p)
                        (beginning-of-line)
                        (recenter)
                      ;;(if debug-on-error (debug "Rock the boat"))
                        ))
                  (select-window old-win)) ;; END UNWIND-PROTECT!
                ))
          (let (old-win)
            ;;(unwind-protect
            (progn
              ;;(setq old-win (selected-window))
              ;;(select-window w)
              ;;(read-only-mode 1)
              ;;(recenter)
              ;;(message-and-sit "set read-only-mode to 1")
              )
            ;;(select-window old-win)
            )
          (setq d-old-method cfm--method)
          ;;(error "Smegulator")
          ) ;; END UNWIND-PROTECT!
        ))))
;; (setq d-all-smegs t)
;; (setq d-all-smegs nil)

;;; (d-speedbar--set--set-current)
;;; (d-speedbar--set--delete-all)
(defun d-speedbar--turn-on-timers ()
  ;;(setq d-speedbar--timer-1 (run-with-idle-timer 0.2 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))
  )

(if (or (not (boundp 'd-speedbar--timer-2)) (not (boundp 'd-speedbar--timer-3))
        (and (not (timerp d-speedbar--timer-2)) (not (timerp d-speedbar--timer-3))))
    (d-speedbar--turn-on-timers))

(defun d-speedbar--turn-off-timers ()
  (progn
    ;;(cancel-timer d-speedbar--timer-1)
    (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--get-namespace ()
  (let (b namespace)
    (save-excursion
      (setq b (nth 1 (assq (selected-frame) d-frame--buffer-window-correspondence)))
      (when (or (not b) (not (stringp b)))
        (setq b (d-speedbar--get-latest-speedbar-buffer))
        (generate-new-buffer b))
      (set-buffer b)
      (if (re-search-backward "^namespace \\([a-zA-Z][a-zA-Z]*\\)$" nil t)
          (setq namespace (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
      )
    )
  )

(defun d-speedbar--get-class ()
  (let (b class)
    (save-excursion
      (setq b (nth 1 (assq (selected-frame) d-frame--buffer-window-correspondence)))
      (when (or (not b) (not (stringp b)))
        (setq b (d-speedbar--get-latest-speedbar-buffer))
        (generate-new-buffer b))
      (set-buffer b)
      (if (re-search-backward "^class \\([a-zA-Z][a-zA-Z]*\\)$" nil t)
          (setq class (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
      )
    )
  )

(defun d-speedbar--goto-method ()
  (interactive)
  (save-match-data
    (let (f
          name args line old-point done old-buf new-buf old-win new-win
          count str namespace class start end b name decl goto looking-at
          goto-name goto-decl)
      ;;(message-and-sit 5 "d-speedbar--goto-method")
      (setq b (nth 1 (assq (selected-frame) d-frame--buffer-window-correspondence)))
      (when (or (not b) (not (stringp b)))
        (setq b (d-speedbar--get-latest-speedbar-buffer))
        (generate-new-buffer b))
      (if (string= (buffer-name (current-buffer)) (buffer-name (get-buffer b)))
          (unwind-protect
              (progn
                (setq old-buf (d-speedbar--get-old-buffer))
                (set-buffer b)
                (read-only-mode -1)
                (cond
                 ;; ------------------------------------------------------
                 ((eq d-old-major-mode 'dired-mode)
                  (setq f (concat default-directory "/" (d-current-line-as-string)))
                  (other-window 1)
                  (save-excursion
                    (d-find-file f))
                  (push-mark)
                  ;;(d-speedbar)
                  )
                 ;; ------------------------------------------------------
                 ((eq d-old-major-mode 'jtw-mode)
                  (setq looking-at nil)
                  (setq str "^\\(class\\|interface\\)[ \t]+\\([A-Z][a-zA-Z0-9_]*\\)$")
                  (when (save-excursion
                          (or (progn
                                (beginning-of-line)
                                (setq looking-at t)
                                (looking-at str))
                              (progn
                                (beginning-of-line)
                                (setq looking-at nil)
                                (re-search-backward str nil t))))
                    ;;(debug "Black Sabbath: Paranoid")
                    (if looking-at
                        (progn
                          (setq decl (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                          (setq name (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                          (other-window 1)
                          (goto-char (point-min))
                          (setq goto (concat decl "[ \t]+" name "\\>"))
                          (re-search-forward goto nil t)
                          (beginning-of-line)
                          ;;(d-beeps "str=%s" str)
                          ;;(if debug-on-error (debug "Charlie Parker: Bop"))
                          )
                      (setq decl (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                      (setq name (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                      (setq goto (d-current-line-as-string))
                      (assert (string-match "^\\(classVar\\|function\\|method\\|property\\|constructor\\) \\([a-zA-Z0-9]+\\)[ \t]*[;()]?$" goto))
                      (setq goto-decl (substring goto (match-beginning 1) (match-end 1)))
                      (setq goto-name (substring goto (match-beginning 2) (match-end 2)))
                      ;;(if debug-on-error (debug "Black Sabbath: Orchid"))
                      (other-window 1)
                      (goto-char (point-min))
                      (re-search-forward (concat "\\<" decl " " name "\\>") nil t)
                      (if (string-match goto-decl "constructor")
                          (re-search-forward (concat goto-decl "[ \t]+" goto-name "(") nil t)
                        (re-search-forward (concat goto-decl "[ \t]+[a-zA-Z0-9_]+[][]*[ \t]+" goto-name "[ \t]*[;()]?") nil t))
                      ;;(if debug-on-error (debug "Charles Mingus: The Black Saint and the Sinner Lady"))
                      )
                    (beginning-of-line)
                    (push-mark)
                    ))
                 ;; --------------------------------------------------
                 ((eq d-old-major-mode 'java-mode)
                  (beginning-of-line)
                  (if (looking-at "^class \\([A-Za-z_][a-zA-Z0-9_]+\\)$")
                      (progn
                        (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))
                            (message "smeg 6 class=%s" class)
                          (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)
                    (if (eq d-old-major-mode 'java-mode)
                        (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))
                        (message "smeg 7")
                      (setq start (point))
                      (beginning-of-line)
                      ;;(debug "regina")
                      (forward-line 1)
                      (assert (looking-at "^{"))
                      ;;(debug "tomales")
                      (forward-sexp 1)
                      (setq end (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)
                        (d-quote (not (and (save-excursion
                                             (re-search-forward "{" (point-at-eol) t))
                                           (save-match-data
                                             (save-excursion
                                               (forward-line 1)
                                               (beginning-of-line)
                                               (looking-at (concat "^" (make-string c-basic-offset ? ) "{"))))))))
                      ;;(debug "antelope")
                      (beginning-of-line))
                    (push-mark)
                    ))
                 ;; ---------------------------------------------------- ---------
                 ((or (eq d-old-major-mode 'c-mode) (eq d-old-major-mode 'c++-mode))
                  (beginning-of-line)
                  (setq namespace (d-speedbar--get-namespace))
                  (setq class     (d-speedbar--get-class))
                  (if (looking-at "\\(^[-a-zA-Z0-9_+:]+\\)[ \t]*\\(([^()]*)\\)")
                      (progn
                        (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))
                        (re-search-forward (concat "^[ \t]*namespace " namespace) nil t)
                        (re-search-forward (concat "^[ \t]*class "     class)     nil t)
                        (setq str (concat name "[ \t]*" (regexp-quote args)))
                        ;;(message-and-sit 5 "str=%s" str)
                        (while (and (re-search-forward str nil t)
                                    (save-match-data
                                      (save-excursion
                                        (forward-line 1)
                                        (beginning-of-line)
                                        (not (looking-at "^   {"))))))
                        (beginning-of-line))
                    (if (looking-at "^[a-zA-Z0-9_]+")
                        (progn
                          (setq name (buffer-substring-no-properties (match-beginning 0) (match-end 0)))
                          (other-window 1)
                          (goto-char (point-min))
                          (re-search-forward (concat "^[ \t]*namespace " namespace) nil t)
                          (re-search-forward (concat "^[ \t]*class "     class)     nil t)
                          (setq str (concat "^(cfunction (cret [a-zA-Z0-9_]+[&*]*) (cname " name ")"))
                          (re-search-forward str nil t)
                          (beginning-of-line)
                          )))
                  ;;(debug "Cold potatoes")
                  (push-mark)
                  )
                 ;; ----------------------------------------------------
                 ((eq d-old-major-mode 'emacs-lisp-mode)
                  (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)))
                    (other-window 1)
                    ;;(error "Foo")
                    (goto-char (point-min))
                    (re-search-forward (concat "(\\(defun\\|defmacro\\|defadvice\\)[ \t]*" (regexp-quote name) "[ \t]*" (regexp-quote args)) nil t)
                    (beginning-of-line)
                    (push-mark)
                    ))
                 ;; --------------------------------------------------
                 ((eq d-old-major-mode 'makefile-mode)
                  (beginning-of-line)
                  (when (looking-at "\\(^[a-zA-Z0-9_+<>/=:-]*\\)")
                    (setq name (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                    (other-window 1)
                    (goto-char (point-min))
                    (while (re-search-forward name nil t))
                    (beginning-of-line)
                    (push-mark)
                    ))
                 ;; ------------------------------------------------------
                 ((eq d-old-major-mode 'compilation-mode)
                  (let (count c done)
                    (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)))))
                      (d-quote progn
                        (setq p (point))
                        (save-excursion
                          (goto-char (point-min))
                          (setq count 0)
                          (while (and (re-search-forward line nil t) (< (point) p))
                            (incf count)))
                        (message "count=%d" count)
                        (sit-for 5)
                        )
                      (other-window 1)
                      (goto-char (point-min))
                      (re-search-forward line nil t)
                      (d-quote
                       (setq c 0)
                       (setq done nil)
                       (while (and (< c count) (not done))
                         (if (re-search-forward line nil t)
                             (incf c)
                           (setq done t)))
                       (message "c=%d" c)
                       (sit-for 5)
                       )
                      (beginning-of-line)))
                  (push-mark)
                  )
                  ;; ----------------------------------------------------
                 ((eq d-old-major-mode 'c2j-mode)
                  (beginning-of-line)
                  (when (looking-at "^[ \t]*[0-9]+ strobe \"[a-zA-Z0-9_-]*\";")
                    (setq line (concat "^[ \t]*" (regexp-quote (d-trim-string (d-current-line-as-string)))))
                    (other-window 1)
                    (goto-char (point-min))
                    (if (not (re-search-forward line nil t))
                        (message "smeg 8 line=%s" line))
                    (beginning-of-line))
                  (when (and (looking-at "^[ \t]*[0-9]+ [a-zA-Z_][a-zA-Z0-9_]*[^\"]")
                             (not (looking-at "^[ \t]*[0-9]+ strobe \"[a-zA-Z0-9_-]*\";")))
                    (setq line (concat "^[ \t]*[0-9]+ label function_" (regexp-quote (substring (d-trim-string (d-current-line-as-string)) 5))))
                    (other-window 1)
                    (goto-char (point-min))
                    (if (not (re-search-forward line nil t))
                        (message "smeg 9 line=%s" line))
                    (beginning-of-line))
                  (push-mark)
                  )
                 ;; ----------------------------------------------------
                 ((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))
                      (message "smeg 10 line=%s" line))
                  ;;(message "line=%s" (regexp-quote line))
                  ;;(beep)
                  ;; ;;(setq d-message-on t)
                  ;;(message "* Pressed enter on php-mode speedbar")
                  ;;(debug "banana line=%s" line)
                  (beginning-of-line)
                  (push-mark)
                  )
                 ;; ------------------------------------------------------
                 ))
            (progn
              (set-buffer b)
              ;;(read-only-mode 1)
              (recenter)
              (set-buffer old-buf)
              (beginning-of-line)
              (recenter)
              ))
        ;;(error "Ding!")
        ))))

(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
    (if (string-match d-speedbar--regexp-name (buffer-name (current-buffer)))
      (kill-buffer))
    ;;(run-with-timer 2.0 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))

(global-set-key [f1] 'info)

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

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

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

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

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

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

(defadvice d-f4 (after d-speedbar activate)
  (if (fboundp 'd-speedbar-new)
      (d-speedbar-new)
    (d-speedbar)))

(defadvice d-super-f3 (around d-speedbar activate)
  (unwind-protect
      ad-do-it
    (run-with-timer 10.0 nil '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 apropos (around d-speedbar activate)
  ad-do-it
  (let ((w (nth 2 (assq (selected-frame) d-frame--buffer-window-correspondence))))
    (when (window-live-p w)
      (select-window w)
      (other-window 1)
      )
    (switch-to-buffer "*Apropos*")
    (delete-other-windows)
    )
  )

(defadvice describe-function (around d-speedbar activate)
  (let ((w (nth 2 (assq (selected-frame) d-frame--buffer-window-correspondence))))
    (when (window-live-p w)
      (select-window w)
      (other-window 1)
      )
    ad-do-it
    (switch-to-buffer "*Help*")
    (delete-other-windows)
    )
  )

(defadvice describe-variable (around d-speedbar activate)
  (let ((w (nth 2 (assq (selected-frame) d-frame--buffer-window-correspondence))))
    (when (window-live-p w)
      (select-window w)
      (other-window 1)
      )
    ad-do-it
    (switch-to-buffer "*Help*")
    (delete-other-windows)
    ))

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

(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)
  (text-mode)
  (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)
  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 d-shift-f2 (around d-speedbar activate)
  ad-do-it
  (save-match-data
    (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-comp-enter (around d-speedbar activate)
  ad-do-it
  (delete-other-windows)
  (d-speedbar))

(defadvice d-kill-buffer (around d-speedbar activate)
  (delete-other-windows)
  ad-do-it
  (save-match-data
    ;;(delete-other-windows)
    (if (string-match d-speedbar--regexp-name (buffer-name (current-buffer)))
        (kill-buffer nil))
    ;;(d-beeps "hello")
    ;;(setq d-old-method nil)
    (d-speedbar)
    ))

(defadvice kill-buffer (around d-speedbar activate)
  ad-do-it
  (save-match-data
    (if (string-match d-speedbar--regexp-name (buffer-name (current-buffer)))
        (kill-buffer nil))
    ;;(d-speedbar)
    )
  )

(defun kp-enter ()
  (interactive)
  ;;(save-excursion
  (find-file "~/bat")
  (goto-char (point-max))
  (read-only-mode -1)
  (insert (format "major-mode=%s foo=%s\n" major-mode (if (boundp 'foo) foo)))
  (insert "456\n")
  )

(global-set-key [(kp-enter)] 'kp-enter)

(add-hook 'electric-buffer-menu-mode-hook 'd-speedbar-electric-hook)

(defun d-speedbar-electric-hook ()
  (define-key electric-buffer-menu-mode-map [kp-enter] 'kp-enter)
  )

(defun d-query-replace ()
  (interactive)
  (d-delete-speedbar-window)
  (call-interactively 'query-replace)
  (d-speedbar)
  ;;(widen)
  ;;(setq from-string (read-from-minibuffer "Replace: " nil nil nil 'query-replace-history))
  ;;(setq dest-string (read-from-minibuffer "With: "    nil nil nil 'query-replace-history))
  ;;(query-replace from-string dest-string nil (point-min) (point-max))
  ;;(query-replace from-string dest-string nil nil nil)
  ;;(read-from-minibuffer prompt &optional initial-contents keymap read hist default-value inherit-input-method)
  )

(global-set-key "\M-%" 'd-query-replace)
;;(global-set-key "\M-%" 'query-replace)

(defadvice describe-text-properties (around d-speedbar activate)
  (delete-other-windows)
  ad-do-it
  (delete-window)
  )

(defadvice describe-mode (around d-speedbar activate)
  (delete-other-windows)
  ad-do-it
  (delete-window))

(defadvice list-faces-display (around d-speedbar activate)
  (delete-other-windows)
  ad-do-it
  (delete-window)
  )

(d-quote advice-add 'describe-mode :around
            #'(lambda (&optional buffer)
                "d-speedbar"
                (delete-other-windows
                (describe-mode buffer))))

(defadvice execute-extended-command (around d-speedbar activate)
  (delete-other-windows)
  ad-do-it)

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

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