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

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

;;; Limitation of Warranty

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or (at
;; your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs, see the file COPYING.  If not, see:
;;
;; <http://www.gnu.org/licenses/gpl-3.0.txt>.


;;; 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
                                 (d-trim-string (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                                 (d-trim-string (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)))
          (setq done t)
        (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))
        ;;(sit-and-message "*** 1 after let form")
        (setq count (d-speedbar--get-count list))
        ;;(sit-and-message "*** 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
    ))

(defun d-get-class-name (x)
  (if (d-get-class-type x)
      (nth 1 x)
    (nth 1 (nth 3 x))))

(defun d-get-class-type (x)
  (string= "class " (nth 0 x)))

;; (setq list-classes *d-classes*)
;; (setq list-methods d-old-list-orig)
(defun d-merge-lists (list-methods)
  ;;(debug "Joni Mitchell: Court And Spark")
  (let (ptr class-name-m class-name-c result)
    (setq ptr list-methods)
    (setq last-class nil)
    (while ptr
      (setq last-class this-class)
      (setq this-class (d-get-class-name (car ptr)))
      (when (not (string= this-class last-class))
        (setq result (cons (list "class " this-class) result)))
      (setq ptr (cdr ptr)))
    (nreverse result)
    (setq d-old-result result)
    ) ;; END LET!
  )

;; (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 p4
          name1 name2 name3 name4 decl1 decl2 decl3 decl4
          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))
          )
        ;; -----------------------------------------------------------
        ;;(sit-and-message "Potato")
        ;; -----------------------------------------------------------
        (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))))
        (setq b new-buf)
        ;;(sit-and-message "before assert new-buf=%s" new-buf)
        (assert new-buf)
        ;;(sit-and-message "before unwind-protect")
        (unwind-protect
            (save-excursion
              (d-delete-speedbar-window)
              ;;(sit-and-message "before setq old-buf")
              (setq old-buf (d-speedbar--get-old-buffer))
              (set-buffer old-buf)
              ;; -------------------------------------------------------
              ;;(sit-and-message "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)
              ;;(sit-and-message "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)
                ;;(sit-and-message "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-nondirs 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
                    (save-excursion
                      (set-buffer old-buf)
                      (setq truncate-lines t))
                    (d-get-classes)
                    ;;                               1                                                                          2                                                                                                                                                                3                               4
                    (setq str1 (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_<>,]*\\)\\(([^()]*);?\\)"))
                    (setq str2 (concat "^[ \t]*\\(public +\\|final +\\|abstract +\\)*\\(class +\\|interface +\\)\\([a-zA-Z_][a-zA-Z0-9_]*\\)"))
                    ;;                           1                                     2                          3                                                                                                                                                                                                                         ...
                    (save-excursion
                      (goto-char (point-min))
                      (setq done nil)
                      (setq p1   nil)
                      (setq p2   nil)
                      (while (not done)
                        ;;(if debug-on-error (debug "Shady bar"))
                        (setq decl  "")
                        (setq name  "")
                        (setq decl1 "")
                        (setq name1 "")
                        (setq decl2 "")
                        (setq name2 "")
                        (beginning-of-line)
                        (setq p (point))
                        ;; ----------------------------------------------
                        (goto-char p)
                        (setq p1 (re-search-forward str1 nil t))
                        (when p1
                          (setq decl1 (buffer-substring-no-properties (match-beginning 3) (match-end 3)))
                          (setq name1 (buffer-substring-no-properties (match-beginning 4) (match-end 4)))
                          ;;(if debug-on-error (debug "So fine"))
                          )
                        ;; ----------------------------------------------
                        (goto-char p)
                        (setq p2 (re-search-forward str2 nil t))
                        (when p2
                          (setq decl2 (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                          (setq name2 (buffer-substring-no-properties (match-beginning 3) (match-end 3)))
                          ;;(if debug-on-error (debug "Times like these"))
                          )
                        ;; ----------------------------------------------
                        (if (and (null p1) (null p2))
                            (progn
                              (setq done t)
                              ;;(if debug-on-error (debug "Thousand dreams"))
                              )
                          (progn
                            ;;(if debug-on-error (debug "I don't know what to say"))
                            (if (null p1) (setq p1 (point-max)))
                            (if (null p2) (setq p2 (point-max)))
                            ;;(if debug-on-error (debug "David Gilmour"))
                            (cond
                             ((<= p1 p2)
                              (setq name name1)
                              (setq decl decl1)
                              (goto-char p1))
                             ((<= p2 p1)
                              ;;(debug "Promised land")
                              (setq name name2)
                              (setq decl decl2)
                              (goto-char p2))
                             (t
                              (assert "Should never happen")))
                            ;;(if debug-on-error (debug "Shady bar"))
                            (setq list (cons (list ""
                                                   decl
                                                   name
                                                   (cfm--get-jtw-class-or-interface)
                                                   ) list))
                            (forward-line 1)
                            ))) ;; END WHILE!
                      )         ;; END SAVE-EXCURSION!
                    ;;(debug "Joni Mitchell: Little Green")
                    (setq *old-list* list)
                    ;;(if debug-on-error (debug "Whole lotta love"))
                    )
                  )
                 ;; ---------------------------------------------------
                 ((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"))
                  (progn
                    (goto-char (point-min))
                    (setq done nil)
                    (setq p1   nil)
                    (setq p2   nil)
                    (setq p3   nil)
                    (setq p4   nil)
                    (while (not done)
                      (setq decl  "")
                      (setq name  "")
                      (setq decl1 "")
                      (setq name1 "")
                      (setq decl2 "")
                      (setq name2 "")
                      (setq decl3 "")
                      (setq name3 "")
                      (setq decl4 "")
                      (setq name4 "")
                      (setq p (point))
                      ;; ----------------------------------------------
                      (goto-char p)
                      (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_<>,]*\\)[ \t]*[();=]") nil t))
                      (when p1
                        (assert (match-beginning 3))
                        (assert (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)
                      (setq p3 (re-search-forward (concat "^[ \t]*\\(public +\\|abstract +\\|final +\\)*"
                                                          "\\(class +\\|interface +\\)"
                                                          "\\([A-Z][a-zA-Z0-9_]*\\)") nil t))
                      (when p3
                        (setq decl3 (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                        (setq name3 (buffer-substring-no-properties (match-beginning 3) (match-end 3))))
                      ;; --------------------------------------------
                      (goto-char p)
                      (setq p4 (re-search-forward "^[ \t]*\\(beginMain\\>\\)" nil t))
                      (when p4
                        (setq decl4 nil)
                        (setq name4 (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
                      ;; -------------------------------------------
                      (if (and (not p1) (not p2) (not p3) (not p4))
                          (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 (not p4) (setq p4 (point-max)))
                          (cond
                           ((and (< p1 p2) (< p1 p3) (< p1 p4))
                            (setq name name1)
                            (setq decl decl1)
                            (goto-char p1))
                           ((and (< p2 p1) (< p2 p3) (< p2 p4))
                            (setq name name2)
                            (setq decl decl2)
                            (goto-char p2))
                           ((and (< p3 p1) (< p3 p2) (< p3 p4))
                            (setq name name3)
                            (setq decl decl3)
                            (goto-char p3))
                           ((and (< p4 p1) (< p4 p2) (< p4 p3))
                            (setq name name4)
                            (setq decl decl4)
                            (goto-char p4))
                           (t
                            (assert nil))))) ;; END IF!
                      (setq list (cons (list ""
                                             decl
                                             name
                                             (cfm--get-jtw-class-or-interface)
                                             ) list))
                      ) ;; END WHILE!
                    ;;(if debug-on-error (debug "Metallica's Carpe Diem Baby"))
                    )
                  ) ;; END JTW-MODE!
                 ;; ------------------------------------------------------
                 ((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))
                          (setq namespace (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                          ))
                      (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 COND!
                ;;(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 (reverse list))
                ;; --------------------------------------------------
                (when (eq d-old-major-mode 'java-mode)
                  ;;(setq d-old-list-orig list)
                  ;;(setq list (d-merge-lists list))
                  ;;(if debug-on-error (debug "Salt"))
                  )
                ;; --------------------------------------------------
                (setq ptr list)
                (setq class nil)
                (setq old-class nil)
                (if (eq d-old-major-mode 'java-mode)
                    (setq *d-java-ptr* ptr))
                (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 debug-on-error (debug "Big Yellow Taxi"))
                      ;;(if (and (string-match "property" decl) debug-on-error) (debug "Evening Falls"))
                      (when (and (not (string= class old-class))
                                 (eq d-old-major-mode 'java-mode))
                        (save-excursion
                          ;; (debug "foo")
                          ;; (set-buffer new-buf)
                          ;; (goto-char (point-max))
                          ;; (if (not (eq (point) (point-min)))
                          ;;     (insert "\n"))
                          ;; (put-text-property 0 (length decl) 'face 'bold decl)
                          ;; (if decl (insert decl))
                          ;; (put-text-property 0 (length class) 'face 'font-lock-type-face class)
                          ;; (if class (insert class "\n"))
                          ;; ;;(if debug-on-error (debug "Handel's Messiah class=%s" class))
                          ;; (read-only-mode -1)
                          ;; (setq old-class class)
                          )
                        )))
                  (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 (or (string= (nth 1 (car ptr)) "class ")
                           (string= (nth 2 (car ptr)) "interface "))
                       "\n" "")
                   (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 (eq d-old-major-mode 'java-mode)
                      (setq *old-list* ptr))
                  ;; (nth 1 (caddr *old-list*))
                  ;;(if debug-on-error (debug "Foomatic"))
                  (if (nth 2 (car ptr))
                      (insert (nth 2 (car ptr)) "\n"))
                  (put-text-property p2 p3 'face 'default)
                  ;; ------------------------------------------------
                  (if (eq d-old-major-mode 'java-mode)
                      (setq *d-was-ptr* ptr))
                  ;;(if debug-on-error (debug "Your time is gonna come"))
                  ;;(if debug-on-error (debug "The Rockarfella Skank"))
                  (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-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)
  ;;(sit-and-message 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))
    (unwind-protect
        (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
                       ;; --------------------------------------------
                       ((and (eq major-mode 'c++-mode)
                             (save-excursion
                               (set-buffer b)
                               (eq (point) (point-min))))
                        (put-text-property (point-at-bol) (point-at-eol) 'face 'default))
                       ;; --------------------------------------------
                       ((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))
                            ;;(sit-and-message 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)
                            )
                        ;;(if debug-on-error (debug "Islands in the sun"))
                        (set-buffer b)
                        (if (and (eobp) (bobp)) (d-speedbar))
                        (read-only-mode -1)
                        ;;(debug "Spinal units")
                        ;; ----------------------------------------------
                        ;;(message "d-speedbar--set--delete-all #1")
                        (save-excursion
                          ;;(debug "Toboganning")
                          (goto-char (point-min))
                          (while (re-search-forward "^\\(class +\\|interface +\\)\\([a-zA-Z_][a-zA-Z0-9_]*\\)$" nil t)
                            ;;(message "d-speedbar--set--delete-all #0")
                            ;;(debug "ah ah")
                            (put-text-property (match-beginning 1) (match-end 1) 'face 'bold)
                            (put-text-property (match-end 1) (match-beginning 2) 'face 'default)
                            (put-text-property (match-beginning 2) (match-end 2) 'face 'font-lock-type-face)
                            ;;(debug "Trouble in transmission")
                            ;;(forward-line 1)
                            )
                          )
                        (save-excursion
                          ;;(debug "Semolina")
                          (goto-char (point-min))
                          (while (re-search-forward "^[a-zA-Z_][a-zA-Z0-9_:]*\\((\\|$\\)" nil t)
                            (save-excursion
                              (beginning-of-line)
                              (setq p1 (point))
                              (skip-chars-forward "a-zA-Z0-9_:")
                              (setq p2 (point))
                              ;;(put-text-property p1 p2 'face 'default)
                              (put-text-property (point-at-bol) (point-at-eol) 'face 'default)
                              ;;(if debug-on-error (debug "Kashmir"))
                              )
                            (forward-line 1)
                            )
                          (goto-char (point-min))
                          (while (re-search-forward "namespace \\([a-zA-Z_][a-zA-Z0-9]*\\)" nil t)
                            ;;(put-text-property (point-at-bol) (point-at-eol) 'face 'default)
                            (put-text-property (point-at-bol) (match-beginning 1) 'face 'bold)
                            (put-text-property (match-beginning 1) (point-at-eol) 'face 'fg:lightred)
                            )
                          )
                        )
                       ;; -----------------------------------------------
                       ((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!
                ))))       ;; END WHEN!
      ;;(sit-and-message 5 "end of defun")
      ;;(assert (stringp b))
      ;;(set-buffer b)
      ;;(if p (goto-char p))
      ;;(widen)
      ;;(message "Widened from inside d-speedbar--set--delete-all")
      ) ;; END UNWIND-PROTECT!
    ))

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

;; (d-speedbar--set--set-current)
(defun d-speedbar--set--set-current ()
  (interactive)
  (block nil
    (let (p (d-message-on t) b w a p1 p2 spaces old-win)
      (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
                (save-excursion
                  (setq spaces (make-string c-basic-offset ? ))
                  (setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
                  (setq b (nth 1 a))
                  (setq w (nth 2 a))
                  (set-buffer b)
                  (setq p (point))
                  (read-only-mode -1))
                (set-buffer (d-speedbar--get-old-buffer))
                (progn;;(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--name (d-trim-string (cfm--get-defun)))
                    ;;(error "cfm--name=%s" cfm--name)
                    (when (not (string= cfm--name ""))
                      ;;(select-window d-window-right)
                      (set-buffer b)
                      (goto-char (point-min))
                      (setq cfm--method (concat "^" (regexp-quote cfm--name) "("))
                      ;;(sit-and-message "City slickers")
                      ;;(debug)
                      (setq cfm--method-2 cfm--method)
                      (when (re-search-forward cfm--method nil t)
                        ;;(sit-and-message "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))
                        ;;(sit-and-message "Rats tails")
                        ;;(debug "Duke Ellington")
                        (when (not (eq p1 p2))
                          (put-text-property p1 p2 'face 'd-face-speedbar-highlighted)
                          )
                        ;;(sit-and-message "Supercalifragulous cfm--method=%s" cfm--method)
                        (beginning-of-line)
                        (setq p (point))
                        ;;(sit-and-message "Double trouble")
                        ;;(insert "k")
                        ;;(debug "foo")
                        ;;(sit-and-message "Ishmael")
                        ))
                    )
                   ;; ------------------------------------------------
                   ((eq major-mode 'java-mode)
                    (save-excursion
                      ;; NOTE: beg of bindings of pair-java and pair2-java
                      (progn;;let (pair-java pair2-java to-find)
                        (setq pair-java-x (cfm--get-method 1))
                        ;;(setq pair-java  xpair-java)
                        (setq pair2-java (d-get-class))
                        ;;(if debug-on-error (debug "The Eagles: One of these nights %s" (nth 0 xpair-java)))
                        (setq to-find (concat "^" (nth 0 pair2-java) " " (nth 1 pair2-java) "[ \t\r\n]"))
                        ;;(debug "Leopard Skin Pill-Box Hat")
                        (if (save-excursion
                              (beginning-of-line)
                              (looking-at to-find))
                            ;;(debug "Rolling Stones: Going Home"))
                            (progn
                              (assert (string-match "^\\^class [A-Z][a-zA-Z0-9_]*\\[ \t\r\n\\]$" to-find))
                              ;;(if debug-on-error (debug "The Eagles: Welcome to the Hotel California"))
                              (set-buffer b)
                              (goto-char (point-min))
                              (re-search-forward to-find)
                              (forward-line -1)
                              (put-text-property (point-at-bol) (point-at-eol) 'face 'd-face-speedbar-highlighted)
                              (beginning-of-line)
                              (setq p (point))
                              ;;(setq d-old-method nil)
                              (recenter)
                              (message "New Kid in Town")
                              ;;(return 'new-kid-in-town)
                              )
                          ;;(debug "Wasted Time")
                          ;;(setq p (point))
                          ;;(return 'in-my-life)
                          (setq decl  (nth 0 pair2-java))
                          (setq class (nth 1 pair2-java))
                          (assert decl)
                          (assert class)
                          (setq cfm--name (nth 0 pair-java-x))
                          (setq cfm--args (nth 1 pair-java-x))
                          ;;(debug "Saeta")
                          ;; NOTE: end of bindings of pair-java-x and pair2-java
                          ;;(if debug-on-error (debug "123"))
                          (setq cfm--java-name cfm--name)
                          (setq cfm--java-args cfm--args)
                          (when (and cfm--java-name cfm--java-args)
                            ;;(if debug-on-error (debug "Stairway to Heaven"))
                            (assert cfm--java-args)
                            (assert cfm--java-name)
                            (setq cfm--method (concat "^" cfm--java-name "[ \t]*" (if (not cfm--java-args) "" (regexp-quote cfm--java-args))))
                            (setq cfm--java-method cfm--method)
                            ;;(if debug-on-error (debug "Kashmir"))
                            (save-excursion
                              (set-buffer b)
                              (goto-char (point-min))
                              (re-search-forward to-find)
                              ;;(if debug-on-error (debug "There's a new kid in town"))
                              ;; ---------------------------
                              ;;(if (string= (car pair-java-x) "foo")
                              ;;    (debug "I'm already standin' on the ground"))
                              ;; -------------------------------------
                              (if (or (not class) (string= class "") (string= class " "))
                                  (debug "Take me to the Mardis Gra"))
                              ;; -------------------------------------
                              ;;(re-search-forward (concat "^" decl class "[ \t\r\n]"))
                              (if (string-match "[a-zA-Z0-9_]$" cfm--java-method)
                                  (setq cfm--java-method (concat cfm--java-method "[ \t\r\n]")))
                              ;;(if debug-on-error (debug-on-error "The Rolling Stones: Right on Baby"))
                              (re-search-forward cfm--java-method)
                              ;;(if debug-on-error (debug "You can call me Al"))
                              ;; ---------------------------------------
                              (beginning-of-line)
                              (setq p1 (point))
                              (skip-chars-forward "a-zA-Z0-9_ ")
                              (setq p2 (point))
                              (put-text-property p1 p2 'face 'd-face-speedbar-highlighted)
                              (beginning-of-line)
                              (if d-kkk (debug "End of block"))
                              (setq p (point))
                              (setq d-old-method nil)
                              (message "It's my life")
                              (return 'its-my-life)
                              ))))))
                   ;; ------------------------------------------------
                   ((eq major-mode 'jtw-mode)
                    (save-excursion
                      (setq pair-decl    (cfm--get-jtw-decl))
                      (setq triple-class (cfm--get-jtw-class-or-interface))
                      (setq class-name (nth 1 triple-class))
                      (setq decl-name  (nth 2 triple-class))
                      ;;(assert (string= class-name "AnimalTest"))
                      ;;(assert (string= decl-name "class "))
                      (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 cfm--jtw-method cfm--method)
                        (setq str (d-current-line-as-string))
                        ;;                   1                           2                            3                          ...
                        (if (string-match "\\(public +\\|abstract +\\)*\\(class\\|interface\\)[ \t]+\\([A-Z][a-zA-Z0-9_]*\\)\\>" str)
                            (save-excursion ;;(and (match-beginning 2) (match-end 2) (match-beginning 3) (match-end 3))
                              (setq decl (substring str (match-beginning 2) (match-end 2)))
                              (assert (string= decl decl-name))
                              (setq name (substring str (match-beginning 3) (match-end 3)))
                              ;;(if debug-on-error (debug "Emma Kirkby sings Handel"))
                              (when t ;;(and (string= (nth 1 triple-class) name) (string= (nth 2 triple-class) (concat decl)))
                                (set-buffer b)
                                (goto-char (point-min))
                                (assert (re-search-forward (concat "^" decl-name " " class-name "\\>") nil t))
                                ;;(assert (re-search-forward (concat decl "[ \t]+" name) nil t))
                                (put-text-property (point-at-bol) (point-at-eol) 'face 'd-face-speedbar-highlighted)
                                (setq p (point))
                                )
                              )
                          (save-excursion
                            ;;(if debug-on-error (debug "Otis Redding: Sitting on the dock of the bay"))
                            (set-buffer b)
                            (goto-char (point-min))
                            (assert (re-search-forward (concat "^" decl-name " " class-name "\\>") nil t))
                            (when (and (not (string= cfm--jtw-method " beginMain"))
                                       (not (string= cfm--jtw-method " ")))
                              (assert (re-search-forward (concat "\\<" cfm--jtw-method "\\>") nil t))
                              (put-text-property (point-at-bol) (point-at-eol) 'face 'd-face-speedbar-highlighted)
                              (setq p (point))
                              )))
                        (setq str (d-current-line-as-string))
                        (if debug-on-error (debug "John Coltrane: Blue Train"))
                        (set-buffer b)
                        (goto-char (point-min))
                        (if (string-match (concat "^" spaces "beginMain\\>") str)
                            (progn
                              ;;(debug "Joni Mitchell: Morning Morgantown")
                              (set-buffer b)
                              (goto-char (point-min))
                              (re-search-forward "^beginMain\\>" nil t)
                              (put-text-property (point-at-bol) (point-at-eol) 'face 'd-face-speedbar-highlighted)
                              (setq p (point)))
                          ;;(if debug-on-error (debug "Ornette Coleman: Peace"))
                          )
                        )
                      )
                    (assert p)
                    ;;(setq p (point))
                    )
                   ;; -----------------------------------------------
                   ((eq major-mode 'c++-mode)
                    ;;(debug "When black friday comes")
                    (let (indent namespace class spaces)
                      (setq p (point))
                      (setq indent 0)
                      (setq namespace (cfm--get-namespace))
                      (if namespace (incf indent))
                      (setq class (cfm--get-class indent))
                      (if class (incf indent))
                      ;;(setq spaces (make-string (* indent c-basic-offset) ? ))
                      ;;(message "Variable class is %s, variable namespace is %s" (prin1-to-string class) (prin1-to-string namespace))
                      ;;(if debug-on-error (debug "Hot Legs"))
                      (save-excursion
                        (if (save-excursion
                              (beginning-of-line)
                              (looking-at (concat "^namespace " namespace)))
                            (save-excursion
                              ;;(debug "In the night you hide from the madman")
                              (set-buffer b)
                              (goto-char (point-min))
                              (re-search-forward (concat "^namespace " namespace))
                              ;;(if debug-on-error (debug "Keep your hat on your head"))
                              (put-text-property (point-at-bol) (point-at-eol) 'face 'd-face-speedbar-highlighted)
                              (setq p (point))
                              )
                          (setq pair (cfm--get-method indent))
                          ;;(if debug-on-error (debug "New Orleans instrumental #1"))
                          (when pair
                            ;;(if debug-on-error (debug "What has been has never been"))
                            (setq cfm--name (car  pair))
                            (setq cfm--args (cadr pair))
                            (setq cfm--c++-name cfm--name)
                            (setq cfm--c++-args cfm--args)
                            (assert (eq major-mode 'c++-mode))
                            (assert (not (eq major-mode 'emacs-lisp-mode)))
                            ;;(if debug-on-error (debug "Things I do"))
                            (set-buffer b)
                            (goto-char (point-min))
                            (if (string= "class" cfm--name)
                                (setq cfm--name (concat cfm--name " ")))
                            ;; ---------------------------------------
                            (setq cfm--method (concat "\\(^\\|[^a-zA-Z0-9_:]+\\)" cfm--name (regexp-quote cfm--args)))
                            (setq cfm--c++-method cfm--method)
                            (assert (boundp 'cfm--c++-method))
                            (assert cfm--c++-method)
                            ;;(if debug-on-error (debug "Shattered dreams, worthless years"))
                            (when namespace
                              ;;(if debug-on-error (debug "Isn't she lovely"))
                              (re-search-forward (concat "^namespace " namespace)))
                            ;;(if debug-on-error (debug "Isn't she lovely II"))
                            ;; ---------------------------------------
                            (when (and class (not (string= class cfm--args)))
                              ;;(message "*** re-search-forward %s" (concat "^class " class "$"))
                              (if (not (re-search-forward (concat "^class " class "$") nil t))
                                  (debug "not looking at class")))
                            (if (re-search-forward cfm--method nil t)
                                (progn
                                  (beginning-of-line)
                                  (setq p1 (point))
                                  (skip-chars-forward "a-zA-Z0-9_: ")
                                  (setq p2 (point))
                                  (put-text-property p1 p2 'face 'd-face-speedbar-highlighted)
                                  (setq p (point))
                                  ;;(if debug-on-error (debug "smelly cat"))
                                  )))
                          (setq cfm--name-2 (cfm--get-cfunction))
                          (when (and cfm--name-2 (not (string= cfm--name-2 "")))
                            ;;(debug "Viagra")
                            (setq cfm--method (concat "^" cfm--name-2 "$"))
                            (set-buffer b)
                            (goto-char (point-min))
                            ;;(if debug-on-error (debug "Stevie Wonder: You've got it bad girl"))
                            (if (and cfm--method (re-search-forward cfm--method nil t))
                                (progn
                                  (beginning-of-line)
                                  (setq p1 (point))
                                  (skip-chars-forward "a-zA-Z0-9_ ")
                                  (setq p2 (point))
                                  (put-text-property p2 p1 'face 'd-face-speedbar-highlighted)
                                  (setq p (point))
                                  )))
                          ;;(if debug-on-error (debug "Kohoutek"))
                          )) ;; SAVE-EXCURSION!
                      ;;(setq p (point))
                      )
                    ;;(debug "Cold potatoes")
                    )
                   ;; ------------------------------------------------
                   ((eq major-mode 'c-mode)
                    (setq cfm--name (cfm--get-method 1))
                    (set-buffer b)
                    (goto-char (point-min))
                    (setq cfm--method (concat "\\(^\\|[^a-zA-Z0-9_:]\\)" cfm--name "("))
                    (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--name "("))
                    (setq cfm--method (concat "^cfunction " cfm--name "\\>"))
                    (when (re-search-forward cfm--method nil t)
                      (forward-char -1)
                      (setq p1 (point))
                      (skip-chars-backward "a-zA-Z0-9_: ")
                      (setq p2 (point))
                      (put-text-property p2 p1 'face 'd-face-speedbar-highlighted)
                      )
                    (setq p (point))
                    ;;(debug "Cold potatoes")
                    )
                   ;; ------------------------------------------------
                   ((eq major-mode 'php-mode)
                    (setq pair (cfm--get-php-function))
                    (setq cfm--name  (car pair))
                    (setq cfm--args (cdr pair))
                    (when (not (string= cfm--name ""))
                      (set-buffer b)
                      ;;(select-window d-window-right)
                      (goto-char (point-min))
                      (setq cfm--method (concat "^" cfm--name "[ \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)
                        )
                      (setq p (point))
                      ))
                   ;; ------------------------------------------------
                   ((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--name-2 (cfm--get-compilation-strobe))
                      (when (and (not (string= cfm--name-2 "")) cfm--name-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--name-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)
                          )
                        (setq p (point))
                        ;;(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))
                          (setq p (point))
                          ))))
                   ;; ------------------------------------------------
                   ((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))
                      (setq p (point))
                      )
                    (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))
                      (setq p (point))
                      ))
                   ;; ------------------------------------------------
                   ((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)
                      (setq p (point))
                      ))
                   ;; ------------------------------------------------
                   ))) ;; END PROGN!
            ;;(if debug-on-error (debug "Michael Jackson: Pretty Young Thing"))
            (when (or (not (string= d-old-method cfm--method)) d-all-smegs)
              (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)))
                            ))
                          (setf (nth 2 a) w))
                        ))
                    (assert p)
                    (assert w)
                    (assert (windowp w))
                    (when (window-live-p w)
                      (select-window w)
                      ;;(set-window-point (selected-window) p)
                      (set-buffer (window-buffer))
                      (goto-char p)
                      (beginning-of-line)
                      (recenter)
                      ;;(if debug-on-error (debug "Rock the boat"))
                      ))
                (select-window old-win)) ;; END UNWIND-PROTECT!
              )
            ;;(widen)
            ;;(message "Widened from inside d-speedbar--set--set-current")
            (setq d-old-method cfm--method)) ;; END UNWIND-PROTECT!
          )))
    'end-of-block
    ;;(message "end of block")
    ))

(setq d-kkk nil)
;; (setq d-all-smegs t)
;; (setq d-all-smegs nil)

(defun d-speedbar--widen ()
  ;;(widen)
  ;;(message "Widened from inside d-speedbar--widen")
  )

;; (d-speedbar--set--set-current)
;; (d-speedbar--set--delete-all)
(defun d-speedbar--turn-on-timers ()
  (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))
  ;;(setq d-speedbar--timer-4 (run-with-idle-timer 0.5 t 'd-speedbar--widen))
  )

(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)
    ;;(cancel-timer d-speedbar--timer-4)
    )
  )

(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 ()
  "Temporarily sets the current buffer to b"
  (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 ()
  "Temporarily sets the current buffer to b"
  (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]*\\)[ \t\r\n]" 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 case-fold-search)
      ;;(sit-and-message 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))
                  (assert (eq (current-buffer) (get-buffer b)))
                  (beginning-of-line)
                  (setq namespace (d-speedbar--get-namespace))
                  (if (string= namespace "void")
                      (message "Namespace is void")
                    (setq class     (d-speedbar--get-class))
                    ;;(if debug-on-error (debug "Supertramp: Bloody well right"))
                    (when (looking-at "\\(^[a-zA-Z0-9_:]+\\)\\(([^()]*)\\)")
                      (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))
                      ;;(if debug-on-error (debug "The Beatles: Wild Honey Pie"))
                      ;;(sit-and-message 2 "*** namespace=%s class=%s" namespace class)
                      (if (not (re-search-forward (concat "^[ \t]*namespace " namespace) nil t))
                          (message "Search failed: namespace=%s" namespace))
                      (if (not (re-search-forward (concat "^[ \t]*class "     class)     nil t))
                          (message "Search failed: class=%s" class))
                      (setq str (concat "\\([a-zA-Z0-9_]+[&*]*[ \t]+\\)+" name (regexp-quote args)))
                      ;;(sit-and-message 5 "str=%s" str)
                      (re-search-forward str nil t)
                      (beginning-of-line)))
                  (when (looking-at "^namespace [a-zA-Z_][a-zA-Z0-9_]*$")
                    (setq name (buffer-substring-no-properties (match-beginning 0) (match-end 0)))
                    (other-window 1)
                    (goto-char (point-min))
                    (re-search-forward (concat "^namespace " namespace))
                    (re-search-forward name))
                  (when (looking-at "^\\(class\\|interface\\) [a-zA-Z0-9_]+$")
                    (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)
                    (re-search-forward (concat "^namespace " namespace "[ \t]*$"))
                    (re-search-forward (concat name "[ \t]*$"))
                    ;;(setq str (concat "^(cfunction (cret [a-zA-Z0-9_]+[&*]*) (cname " name ")"))
                    ;;(re-search-forward str nil t)
                    (beginning-of-line)
                    ;;(debug "Stevie Wonder: Another All day sucker")
                    )
                  ;;(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))

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

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