GNU   davin.50webs.com/research
Bringing to you notes for the ages

       Main Menu          Research Projects         Photo Album            Curriculum Vitae      The Greatest Artists
    Email Address       Computer Games          Web Design          Java Training Wheels      The Fly (A Story)   
  Political Activism   Bob Dylan Quotes+       My Life Story          Smoking Cessation          Other Links      
Debugging Macros     String Class I     Linked List System I Java for C Programmers Naming Convention
    String Class II         How I use m4              Strings III                 Symmetrical I/O             Linked Lists II     
Run-Time Type Info   Virtual Methods      An Array System        Science & Religion            Submodes       
  Nested Packages      Memory Leaks    Garbage Collection      Internet & Poverty      What is Knowledge?
Limits of Evolution   Emacs Additions      Function Plotter           Romantic Love        The Next Big Thing
    Science Fiction     Faster Compilation Theory of Morality         Elisp Scoping               Elisp Advice      
  S.O.G.M. Pattern       Safe Properties         School Bullying          Charisma Control          Life and Death    
     Splitting Java          Multiple Ctors       Religious Beliefs         Conversation 1           Conversation 2    
   J.T.W. Language    Emacs Additions II      Build Counter             Relation Plotter          Lisp++ Language  
  Memory Leaks II   Super Constructors CRUD Implementation Order a Website Form There Is An Afterlife
More Occam's Razor C to Java Translator Theory of Morality II


d-speedbar.el

    

;;; 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 <http://davin.50webs.com>
;; Version: 1.5
;; 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 detail.
;;
;; 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>.


;;; Install Instructions:

;; See the following URL for the latest info and a tarball:
;;
;; <http://davin.50webs.com/research/2010/mopa2e2.html#d-speedbar>
;;
;; Then untar the tarball to a folder pointed to by the Emacs variable
;; load-path and add the following line to your ~/.emacs file.
;;
;; (require 'd-speedbar)

;;; Known Bugs:

;; None so far!

;;; Version History

;; Version 1.5: ADDED: support for classes inside of classes etc.

;; 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 '*old-major-mode*)
  (setq-default d-window-size    15
                *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  t)
  (kill-local-variable 'cfm--method)
  (defvar cfm--method nil)
  (setq spec-maxpdl-size 500)
  )

;;; (d-get-classes-and-methods c-basic-offset major-mode d-speedbar--java-meth-regexp d-speedbar--java-class-regexp)
(defun d-get-classes-and-methods (c-basic-offset meth-regexp class-regexp)
  (interactive)
  ;;(if debug-on-error (debug "Close to me.  All my wildest dreams come true."))
  (save-excursion
    (when (not (d-speedbar--is-local-buffer))
      (message "Wrong major mode #1 *major-mode*=%s" *major-mode*))
    (d-speedbar--set-indicies)
    (goto-char (point-min))
    (setq *d-classes-and-methods* nil)
    (d-get-classes-and-methods-inner 0 c-basic-offset meth-regexp class-regexp)
    (setq *d-classes-and-methods* (reverse *d-classes-and-methods*))
    (setq *fart* *d-classes-and-methods*)
    ;;(message "*d-classes-and-methods*=%s" *d-classes-and-methods*)
    ;;(if debug-on-error (debug "Let's call the whole thing off"))
    *d-classes-and-methods*
    )
  )

(progn

  ;;                                      1          2                                                      3                                                 4                                                                                                                                                                                     .
  (setq d-speedbar--java-meth-regexp-pre          "\\(public[ \t]+\\|private[ \t]+\\|protected[ \t]+\\|\\)\\(abstract[ \t]+\\|final[ \t]+\\|static[ \t]+\\)*\\(void[ \t]+\\|boolean[][]*[ \t]+\\|char[][]*[ \t]+\\|short[][]*[ \t]+\\|int[][]*[ \t]+\\|long[][]*[ \t]+\\|float[][]*[ \t]+\\|double[][]*[ \t]+\\|[A-Z][a-zA-Z0-9_<,>]*[][]*[ \t]+\\)")
  ;;                                                                             4    5                       6                          .
  (setq d-speedbar--java-meth-regexp      (concat d-speedbar--java-meth-regexp-pre "\\([a-z][a-zA-Z0-9_]*\\)\\(([^0-9()][^()]*)\\|()\\)"))

  ;;                                      1          2                                                .
  (setq d-speedbar--java-class-regexp-pre         "\\(public[ \t]+\\|abstract[ \t]+\\|final[ \t]+\\)*")
  ;;                                                                              2    3                            4                       .
  (setq d-speedbar--java-class-regexp     (concat d-speedbar--java-class-regexp-pre "\\(class\\|interface\\)[ \t]+\\([A-Z][a-zA-Z0-9_]*\\)"))

  ;;                                      1          2                                                      3                                  4                                5                                                                                                                                                                                        .
  (setq d-speedbar--jtw-meth-regexp-pre           "\\(public[ \t]+\\|private[ \t]+\\|protected[ \t]+\\|\\)\\(final[ \t]+\\|abstract[ \t]+\\)*\\(method[ \t]+\\|function[ \t]+\\)\\(void[ \t]+\\|boolean[][]*[ \t]+\\|char[][]*[ \t]+\\|short[][]*[ \t]+\\|int[][]*[ \t]+\\|long[][]*[ \t]+\\|float[][]*[ \t]+\\|double[][]*[ \t]+\\|[A-Z_][a-zA-Z0-9_<,>]*[][]*[ \t]+\\)")
  ;;                                                                            5    6                       7                          .
  (setq d-speedbar--jtw-meth-regexp       (concat d-speedbar--jtw-meth-regexp-pre "\\([a-z][a-zA-Z0-9_]*\\)\\(([^0-9()][^()]*)\\|()\\)"))

  ;;                                      1          2                                                .
  (setq d-speedbar--jtw-class-regexp-pre          "\\(public[ \t]+\\|abstract[ \t]+\\|final[ \t]+\\)*")
  ;;                                                                             2    3                            4                       .
  (setq d-speedbar--jtw-class-regexp      (concat d-speedbar--jtw-class-regexp-pre "\\(class\\|interface\\)[ \t]+\\([A-Z][a-zA-Z0-9_]*\\)"))

  ;;                                      1          2                                                                                3                                             4                                                          5                         .
  (setq d-speedbar--c++-meth-regexp               "\\([A-Z0-9]+[ \t]+\\|extern[ \t]+\\|inline[ \t]+\\|static[ \t]+\\|const[ \t]+\\|struct[ \t]+\\)*\\([a-zA-Z_][a-zA-Z0-9_<,]*[> ]*[&*]*\\)[ \t]+\\([a-zA-Z_][a-zA-Z0-9_:~]*\\|operator[ \t]*[-!%^&*=<>]+\\)\\(([^()0-9][^()]*)\\|()\\)")

  ;;                                      1          2                     3                            4                             .
  (setq d-speedbar--c++-class-regexp              "\\([A-Z0-9]+[ \t]+\\)*\\(class\\|namespace\\)[ \t]+\\([a-zA-Z_][a-zA-Z0-9_]*\\>\\)")

  ;;                                      1           2                                                                          3             4                                                   .
  (setq d-speedbar--lisp++-meth-regexp            "(\\(cfriend\\|cfunction\\|cmethod\\|c-static-method\\) (cret [^()]*) (cname \\([^()]*\\)) \\((carg [^()]*)\\|(cargs *\\((carg [^()]*) *\\)*)\\)")

  ;;                                      1           2            3                          .
  (setq d-speedbar--lisp++-class-regexp           "(\\(cclass\\) \\([a-zA-Z_][a-zA-Z0-9_]*\\)")
  ;; NOTE: there are no interfaces in C++
  (kill-local-variable '*fart*)
  (defvar *fart* nil)
  )

;;;
;;; NOTE: plus one here to each of the indicies
;;; (re-search-forward (concat space-regexp meth-regexp|class-regexp) nil t)
;;;
(defun d-speedbar--set-indicies ()
  (cond
   ((eq *major-mode* 'java-mode)
    (setq d-meth-decl-index -1)
    (setq d-meth-name-index  5)
    (setq d-meth-args-index  6)
    (setq d-class-decl-index 3)
    (setq d-class-name-index 4)
    )
   ((eq *major-mode* 'jtw-mode)
    (setq d-meth-decl-index  4)
    (setq d-meth-name-index  6)
    (setq d-meth-args-index  7)
    (setq d-class-decl-index 3)
    (setq d-class-name-index 4)
    )
   ((or (eq *major-mode* 'c-mode)
        (eq *major-mode* 'c++-mode))
    (setq d-meth-decl-index -1)
    (setq d-meth-name-index  4)
    (setq d-meth-args-index  5)
    (setq d-class-decl-index 3)
    (setq d-class-name-index 4)
    )
   ((eq *major-mode* 'lisp++-mode)
    (setq d-meth-decl-index 2)
    (setq d-meth-name-index 3)
    (setq d-meth-args-index 4)
    (setq d-class-decl-index 2)
    (setq d-class-name-index 3)
    )
   ) ;; END COND!
  )

;;; (setq tab "   ")
;;; (setq tab-old "   ")
;;; (d-get-classes-and-methods-inner 0 c-basic-offset meth-regexp class-regexp)
(defun d-get-classes-and-methods-inner (offset c-basic-offset meth-regexp class-regexp)
  ;;(message "*** Called d-get-classes-and-methods-inner with offset=%d *major-mode*=%s" offset *major-mode*)
  (setq *major-mode* major-mode)
  (message "* d-get-classes-and-methods-inner")
  (if (d-speedbar--is-foreign-buffer)
      nil
    (assert (d-speedbar--is-local-buffer))
    (let (i tab done p-orig p-meth-array p-class-array
            function-name-array function-args-array
            class-decl-array class-name-array tab-array
            tab-array-narrow min-class-or-method min-found-class
            min-found-method length found min-found min-i
            p-begin-main-array found-deeper)
      (while (not done)
        (setq found-deeper nil)
        (setq done         nil)
        (while (and (not done) (not found-deeper))
          (assert (not (string-match d-speedbar--regexp-name (buffer-name))))
          (setq length                   (1+ offset))
          (setq function-decl-array      (make-vector length nil))
          (setq function-name-array      (make-vector length nil))
          (setq function-args-array      (make-vector length nil))
          (setq class-decl-array         (make-vector length nil))
          (setq class-name-array         (make-vector length nil))
          (setq namespace-name-array     (make-vector length nil))
          (setq p-meth-array             (make-vector length nil))
          (setq p-class-array            (make-vector length nil))
          (setq p-namespace-array        (make-vector length nil))
          (setq p-begin-main-array       (make-vector length nil))
          (setq tab-array                (make-vector length nil))
          (setq tab-array-narrow         (make-vector length nil))
          (setq i 0)
          (while (< i length)
            (setf (aref tab-array        i) (make-string (* c-basic-offset i) ? ))
            (setf (aref tab-array-narrow i) (make-string i ? ))
            (incf i))
          ;;(when debug-on-error
          ;;  (setq debug-on-error nil)
          ;;  (debug "Holy smoke!"))
          ;; ---------------------------------------------------------
          (setq i 0)
          (setq p-orig (point))
          (while (< i length)
            (progn
              (goto-char p-orig)
              (setf (aref p-meth-array i) (re-search-forward (concat "^\\(" (aref tab-array i) "\\)" meth-regexp ";?") nil t))
              ;;(when debug-on-error
              ;;  (setq debug-on-error nil)
              ;;  (debug "Evel Keneval"))
              (when (aref p-meth-array i)
                (setf (aref function-name-array i) (buffer-substring-no-properties (match-beginning d-meth-name-index) (match-end d-meth-name-index)))
                (when (and (match-beginning d-meth-args-index) (match-end d-meth-args-index))
                  (setf (aref function-args-array i) (buffer-substring-no-properties (match-beginning d-meth-args-index) (match-end d-meth-args-index)))
                  (setf (aref function-args-array i) (concat (aref function-args-array i) ";")))
                ;;(d-debug "Saturated Fats")
                ))
            (progn
              (goto-char p-orig)
              (setf (aref p-class-array i) (re-search-forward (concat "^\\(" (aref tab-array i) "\\)" class-regexp) nil t))
              ;;(save-match-data
              ;;(if debug-on-error (debug "Bob Dylan: It rolls and falls all down her breast")))
              ;;(if debug-on-error (debug "Bob Dylan: Throw my ticket out the window"))
              (when (aref p-class-array i)
                (setf (aref class-decl-array i) (d-trim-string (buffer-substring-no-properties (match-beginning d-class-decl-index) (match-end d-class-decl-index))))
                (setf (aref class-name-array i) (buffer-substring-no-properties (match-beginning d-class-name-index) (match-end d-class-name-index)))
                ))
            (progn
              (goto-char p-orig)
              (cond
               ((eq *major-mode* 'c++-mode)
                ;;(d-beeps "mangina")
                (setf (aref p-namespace-array i) (re-search-forward (concat "^\\(" (aref tab-array i) "\\)namespace \\([a-z]+\\)[ \t]*$") nil t))
                (setq namespace-decl "namespace")
                )
               ((eq *major-mode* 'lisp++-mode)
                ;;(d-beeps "manky poo")
                (setf (aref p-namespace-array i) (re-search-forward (concat "^\\(" (aref tab-array i) "\\)(cnamespace \\([a-z]+\\)[ \t]*$") nil t))
                (setq namespace-decl "cnamespace")
                ;;(when debug-on-error
                ;;  (setq debug-on-error nil)
                ;;  (debug "Lamprey"))
                )) ;; END COND!
              ;;(d-beeps "*major-mode*=%s" *major-mode*)
              (setq stri (if (and (match-beginning 2) (match-end 2))
                             (buffer-substring-no-properties (match-beginning 2) (match-end 2))))
              ;;(when (and (not stri) debug-on-error)
              ;;  (setq debug-on-error nil)
              ;;  (debug "Foley Artist"))
              ;;(d-beeps "stri=%s" stri)
              (setf (aref namespace-name-array i) stri)
              (d-quote
               when debug-on-error
               (setq debug-on-error nil)
               (debug "Hellhound on my trail"))
              )
            (when (eq *major-mode* 'jtw-mode)
              (goto-char p-orig)
              (setf (aref p-begin-main-array i) (re-search-forward (concat "\\(^" (aref tab-array i) "\\)beginMain\\>") nil t))
              )
            ;;(message "*** class=%s" (aref class-name-array i))
            ;;(goto-char p-orig)
            (incf i)
            ) ;; END while!
          ;;(if debug-on-error (debug "Sooner or later you shall return"))
          ;;(if debug-on-error (debug "How many more times?"))
          ;;(when debug-on-error
          ;;  (setq debug-on-error nil)
          ;;  (debug "*** Bernstein conducts Bernstein" class-name-array function-name-array namespace-name-array))
          ;; -------------------------------------------------------------
          (block nil
            (setq found nil)
            (setq i     0)
            (while (< i length)
              (when (or (aref p-meth-array i) (aref p-class-array i) (aref p-begin-main-array i) (aref p-namespace-array i))
                ;;(when debug-on-error
                ;;  (setq debug-on-error nil)
                ;;  (debug "Before#1 set to (point-max)"))
                (setq found t)
                (return nil))
              (incf i))
            ) ;; END BLOCK!
          (if (not found)
              (progn
                (setq done t)
                ;;(when debug-on-error
                ;;  (setq debug-on-error nil)
                ;;  (debug "Before#2 set to (point-max)"))
                )
            ;;(when debug-on-error
            ;;  (setq debug-on-error nil)
            ;;  (debug "Before#3 set to (point-max)"))
            (setq i 0)
            (while (< i length)
              (if (not (aref p-meth-array i))
                  (setf (aref p-meth-array i) (point-max)))
              (if (not (aref p-class-array i))
                  (setf (aref p-class-array i) (point-max)))
              (if (not (aref p-namespace-array i))
                  (setf (aref p-namespace-array i) (point-max)))
              (if (not (aref p-begin-main-array i))
                  (setf (aref p-begin-main-array i) (point-max)))
              (incf i))
            ;;(if debug-on-error
            ;;    (debug "Robert Johnson: Hot Tomales And They'Re Red Hot"))
            ;; -----------------------------------------------------------
            (setq min-found (point-max))
            (setq min-i     -1)
            (setq i         0)
            (while (< i length)
              ;;(if (and debug-on-error (= i 1)) (debug "No easy way to find the calamansies"))
              (when (< (aref p-meth-array i) min-found)
                (setq min-found            (aref p-meth-array i))
                (setq min-found-method     (aref p-meth-array i))
                (setq min-found-namespace  nil)
                (setq min-found-begin-main nil)
                (setq min-found-class      nil)
                (setq min-i                i)
                (setq min-class-or-method  'method)
                (message "*** found method=%s" (aref function-name-array i))
                ;;(debug "Richard Wagner: The Ride of the Valkyries")
                )
              (when (< (aref p-class-array i) min-found)
                (setq min-found            (aref p-class-array i))
                (setq min-found-class      (aref p-class-array i))
                (setq min-found-namespace  nil)
                (setq min-found-begin-main nil)
                (setq min-found-method     nil)
                (setq min-i                i)
                (setq min-class-or-method 'class)
                (message "*** found class %s, %s" (aref class-decl-array i) (aref class-name-array i))
                )
              (when (< (aref p-namespace-array i) min-found)
                (setq min-found            (aref p-namespace-array i))
                (setq min-found-class      nil)
                (setq min-found-begin-main nil)
                (setq min-found-method     nil)
                (setq min-found-namespace  (aref p-namespace-array i))
                (setq min-i                i)
                (setq min-class-or-method 'namespace)
                (message "*** found namespace %s" (aref namespace-name-array i))
                )
              (when (< (aref p-begin-main-array i) min-found)
                (setq min-found            (aref p-begin-main-array i))
                (setq min-found-begin-main (aref p-begin-main-array i))
                (setq min-found-class      nil)
                (setq min-found-namespace  nil)
                (setq min-found-method     nil)
                (setq min-i                i)
                (setq min-class-or-method 'begin-main)
                (message "*** found beginMain")
                )
              (incf i))
            ;;(if (and debug-on-error (= offset 1)) (debug "*** End of search"))
            (assert (/= min-i -1))
            (cond
             ((eq min-class-or-method 'method)
              ;;(if debug-on-error (debug "Leonidas Kavakos: Brahms the Violin Sonatas"))
              (setq *d-classes-and-methods* (cons (concat (aref tab-array-narrow    min-i)
                                                          (aref function-name-array min-i)
                                                          (aref function-args-array min-i)
                                                          )
                                                  *d-classes-and-methods*))
              ;;(message "*** *d-classes-and-methods*=%s" *d-classes-and-methods*)
              (goto-char min-found-method)
              (setq offset (1+ offset))
              (setq found-deeper t)
              ;;(d-get-classes-and-methods-inner (1+ offset) c-basic-offset meth-regexp class-regexp)
              )
             ((eq min-class-or-method 'class)
              (setq *d-classes-and-methods* (cons (concat (aref tab-array-narrow min-i)
                                                          (aref class-decl-array min-i)
                                                          " "
                                                          (aref class-name-array min-i))
                                                  *d-classes-and-methods*))
              ;;(message "*** *d-classes-and-methods*=%s" *d-classes-and-methods*)
              (goto-char min-found-class)
              (setq offset (1+ offset))
              (setq found-deeper t)
              ;;(d-get-classes-and-methods-inner (1+ offset) c-basic-offset meth-regexp class-regexp)
              )
             ((eq min-class-or-method 'namespace)
              ;;(debug "Selfish grin")
              (setq *d-classes-and-methods* (cons (concat (aref tab-array-narrow min-i)
                                                          namespace-decl " "
                                                          (aref namespace-name-array min-i))
                                                  *d-classes-and-methods*))
              ;;(message "*** *d-classes-and-methods*=%s" *d-classes-and-methods*)
              (goto-char min-found-namespace)
              ;;(when debug-on-error
              ;;  (setq debug-on-error nil)
              ;;  (debug "Viagra"))
              ;;(d-get-classes-and-methods-inner (1+ offset) c-basic-offset meth-regexp class-regexp)
              ;;(message "found namespace namespace-name-array=%s" namespace-name-array)
              (setq offset (1+ offset))
              (setq found-deeper t)
              )
             ((eq min-class-or-method 'begin-main)
              (setq *d-classes-and-methods* (cons (concat (aref tab-array-narrow min-i)
                                                          "beginMain")
                                                  *d-classes-and-methods*))
              ;;(message "*** *d-classes-and-methods*=%s" *d-classes-and-methods*)
              (goto-char min-found-begin-main)
              (setq offset (1+ offset))
              (setq found-deeper t)
              ;;(d-get-classes-and-methods-inner (1+ offset) c-basic-offset meth-regexp class-regexp)
              ;;(message "found beginMain")
              )
             (t
              (error "Should never happen"))
             )  ;; END COND!
            ;;(when debug-on-error
            ;;  (setq debug-on-error nil)
            ;;  (debug "Dazed and Confused"))
            )   ;; END if!
          )     ;; while (AND (NOT DONE) (NOT FOUND-DEEPER))!
        )       ;; END while (NOT DONE)!
      )         ;; END LET!
    )           ;; END if!
  (d-quote
   when debug-on-error
   (setq debug-on-error nil)
   (debug "A blazing fire"))
  )             ;; END defun!

(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 'lisp++-mode)
    (setq-default d-window-size 20))
   ((eq major-mode 'dired-mode)
    (setq-default d-window-size 10))
   ((eq major-mode 'emacs-lisp-mode)
    (setq-default d-window-size 20))
   ((eq major-mode 'java-mode)
    (setq-default d-window-size 20))
   ((eq major-mode 'jtw-mode)
    (setq-default d-window-size 20))
   ((eq major-mode 'html-mode)
    (setq-default d-window-size 10))
   ((eq major-mode 'c++-mode)
    (setq-default d-window-size 20))
   ((eq major-mode 'c2j-mode)
    (setq-default d-window-size 20))
   ((eq major-mode 'compilation-mode)
    (setq-default d-window-size 20))
   ((eq major-mode 'php-mode)
    (setq-default d-window-size 30))
   ((eq major-mode 'makefile-mode)
    (setq-default d-window-size 20))
   ((d-speedbar--is-foreign-buffer)
    (setq-default d-window-size nil))
   (t
    (setq-default d-window-size nil)))
  d-window-size)

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

;; (setq list-classes *d-classes*)
;; (setq list-methods d-old-list-orig)
(d-quote 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!
         )

;; (cargs-2-args (setq cargs "foo(cargs)"))
;; (cargs-2-args (setq cargs "foo(carg int x)"))
;; (cargs-2-args (setq cargs "foo(cargs (carg int x) (carg int* y) (carg int** z))"))
;; (cargs-2-args (setq cargs "foo(cargs);"))
;; (cargs-2-args (setq cargs "foo(carg int x);"))
;; (cargs-2-args (setq cargs "foo(cargs (carg int x) (carg int* y) (carg const char** z));"))
;; (cargs-2-args "^func3(cargs (carg int x) (carg int y))")
;; (cargs-2-args "^func1
;; (cargs-2-args "^ func1(carg int i)")
;; (cargs-2-args "^ func2(cargs)")
;; (cargs-2-args "^ func3(cargs (carg int x))")
;; (cargs-2-args "^ func4(cargs (carg int x) (carg int y))")

(defun cargs-2-args (cargs)
  (let (result)
    (setq result cargs)
    (while (string-match "(carg \\([^()]*\\))\\(;\\)?" result)
      (setq result (concat (substring result 0 (match-beginning 0))
                           "(" (substring result (match-beginning 1) (match-end 1)) ")"
                           ","
                           (substring result (match-end 0))
                           (if (and (match-beginning 2) (match-end 2)) ";")
                           )))
    (when (string-match "),$" result)
      (setq result (substring result 0 (1+ (match-beginning 0)))))
    (when (string-match ",\\(;\\)?$" result)
      (setq result (substring result 0 -2))
      (when (and (match-beginning 1) (match-end 1))
        (setq result (concat result ";"))))
    (when (string-match "," result)
      (while (string-match "(\\([^()]*\\))" result)
        (setq result (concat (substring result 0 (match-beginning 0))
                             (substring result (match-beginning 1) (match-end 1))
                             (substring result (match-end 0))))))
    (if (string-match "cargs\\([^()]*\\)" result)
        (setq result (concat (substring result 0 (match-beginning 0))
                             "(" (substring result (match-beginning 1) (match-end 1)) ")"
                             (substring result (match-end 0))
                             )))
    (when (string-match "(())" result)
      (setq result (concat (substring result 0 (match-beginning 0))
                           "()"
                           (substring result (match-end 0)))))
    (when (string-match "^\\(\\^?[ \t]*[a-zA-Z_][a-zA-Z0-9_]*\\)( " result)
      (setq result (concat (substring result 0 (match-end 1))
                           "("
                           (substring result (match-end 0))
                           )))
    (when (string-match ",;)$" result)
      (setq result (concat (substring result 0 (match-beginning 0))
                           ");")))
    (when (string-match ",)$" result)
      (setq result (concat (substring result 0 (match-beginning 0))
                           ")")))
    result))

;; (cargs-2-args (args-2-cargs "(int x, int*** y, const char*** z, int*** k)"))
;; (cargs-2-args (setq result "(cargs (carg int x) (int* y) (const char** z))"))
;; (args-2-cargs "foo(int x, int* y, const int*** z)")
;; (cargs-2-args (args-2-cargs "foo(int x, int* y, const int*** z)"))
(defun args-2-cargs (args)
  (let (result)
    (setq result args)
    (setq count  0)
    (while (string-match "(\\([^()]*\\))" result)
      (incf count)
      (message "count=%s" count)
      (setq result (concat (substring result 0 (match-beginning 0))
                           "<carg "
                           (substring result (match-beginning 1) (match-end 1))
                           ">,"
                           (substring result (match-end 0))
                           )))
    (while (string-match "<" result)
      (setq result (concat (substring result 0 (match-beginning 0))
                           "("
                           (substring result (match-end 0)))))
    (while (string-match ">" result)
      (setq result (concat (substring result 0 (match-beginning 0))
                           ")"
                           (substring result (match-end 0)))))
    ;;(setq result (concat "(cargs " result ")"))
    (while (string-match "),)$" result)
      (setq result (concat (substring result 0 (match-beginning 0))
                           "))")))
    (while (string-match "," result)
      (setq result (concat (substring result 0 (match-beginning 0))
                           ") (carg "
                           (substring result (match-end 0)))))
    (while (string-match "  " result)
      (setq result (concat (substring result 0 (match-beginning 0))
                           " "
                           (substring result (match-end 0)))))
    (while (string-match " (carg $" result)
      (setq result (substring result 0 (match-beginning 0))))
    (when (string-match "^\\([a-zA-Z0-9_]+\\)(" result)
      (setq result (concat (substring result 0 (match-end 1))
                           "(cargs "
                           (substring result (match-end 1)))))
    ;;(setq result (concat result ")"))
    result))

;;; (d-namespace--insert-all-methods c-basic-offset major-mode d-speedbar--lisp++-meth-regexp d-speedbar--lisp++-class-regexp)
(defun d-namespace--insert-all-methods (c-basic-offset func meth-regexp class-regexp)
  (let (list2)
    ;;(if debug-on-error (debug "The nearest of you"))
    (d-speedbar--set-indicies)
    (d-get-classes-and-methods c-basic-offset meth-regexp class-regexp)
    (if (not (boundp 'list))
        (message "Variable list is not bound"))
    ;;(message "list#1=%s" list)
    (save-excursion
      (set-buffer new-buf)
      (read-only-mode -1)
      (when (not (d-speedbar--is-local-buffer))
        (message "Wrong major-mode"))
      (setq list2 (append (reverse list) *d-classes-and-methods*))
      (setq ptr list2)
      (d-quote when debug-on-error
               (setq debug-on-error nil)
               (debug "A blazing fire"))
      (while ptr
        (insert (funcall func (car ptr)) "\n")
        (setq ptr (cdr ptr))
        ) ;; END while PTR!
      ;;(if debug-on-error (debug "Anchovies"))
      ) ;; END SAVE-EXCURSION!
    ) ;; END LET!
  )

(defun d-namespace--highlight-line (c-basic-offset func meth-regexp class-regexp)
  "Current buffer is major-mode buffer"
  (let (i meth-i class-i meth-name meth-args class-decl
          class-name meth-tab-width class-tab-width spaces
          begin-main-i begin-main-tab-width space-regexp done
          smeg list ptr namespace-decl namespace-name
          namespace-i)
    (save-excursion
      (if (not (or (eq func 'cargs-2-args)
                   (eq func 'args-2-cargs)
                   (eq func 'identity)))
          (message "Wrong binding for func variable"))
      ;;(message "c-basic-offset=%d" c-basic-offset)
      (if (not (d-speedbar--is-local-buffer))
          (message "Wrong major mode #2 major-mode=%s" major-mode))
      (setq space-regexp "\\(^[ \t]*\\)")
      (setq begin-main-regexp (concat space-regexp "beginMain\\>"))
      (cond
       ((eq *major-mode* 'lisp++-mode)
        (setq namespace-decl "cnamespace")
        (setq namespace-regexp (concat space-regexp "(" namespace-decl " \\([a-z]+\\>\\)"))
        )
       ((eq *major-mode* 'c++-mode)
        (setq namespace-decl "namespace")
        (setq namespace-regexp (concat space-regexp "\\<" namespace-decl " \\([a-z]+\\>\\)"))
        )
       )
      (d-quote when debug-on-error
        (setq debug-on-error nil)
        (debug "carroty"))
      (setq list nil)
      (setq done nil)
      (while (not done)
        (setq begin-main-i nil)
        (setq meth-i       nil)
        (setq class-i      nil)
        (setq namespace-i  nil)
        (cond
         ((setq meth-i (save-excursion
                         (if (progn
                               (beginning-of-line)
                               (looking-at (concat space-regexp meth-regexp)))
                             (point))))
          (setq meth-tab-width (/ (- (match-end 1) (match-beginning 1)) c-basic-offset))
          (setq meth-name (buffer-substring-no-properties (match-beginning d-meth-name-index) (match-end d-meth-name-index)))
          (setq meth-args (buffer-substring-no-properties (match-beginning d-meth-args-index) (match-end d-meth-args-index)))
          ;;(if debug-on-error (debug "Louis Armstrong: Jazz Lips" meth-args))
          )
         ((setq meth-i (save-excursion
                         (re-search-backward (concat space-regexp meth-regexp) nil t)))
          (setq meth-tab-width (/ (- (match-end 1) (match-beginning 1)) c-basic-offset))
          (setq meth-name (buffer-substring-no-properties (match-beginning d-meth-name-index) (match-end d-meth-name-index)))
          (setq meth-args (buffer-substring-no-properties (match-beginning d-meth-args-index) (match-end d-meth-args-index)))
          ;;(if debug-on-error (debug "Louis Armstrong: The Last Time" meth-name))
          )
         ) ;; END COND!
        (cond
         ((setq class-i (save-excursion
                          (if (progn (beginning-of-line)
                                     (looking-at (concat space-regexp class-regexp)))
                              (point))))
          (setq class-tab-width (/ (- (match-end 1) (match-beginning 1)) c-basic-offset))
          (setq class-decl (buffer-substring-no-properties (match-beginning d-class-decl-index) (match-end d-class-decl-index)))
          (setq class-name (buffer-substring-no-properties (match-beginning d-class-name-index) (match-end d-class-name-index)))
          ;;(if debug-on-error (debug "Louis Armstrong: Ain't Misbehavin'"))
          ;;(debug "Rogina")
          )
         ((setq class-i (save-excursion
                          (re-search-backward (concat space-regexp class-regexp) nil t)))
          (setq class-tab-width (/ (- (match-end 1) (match-beginning 1)) c-basic-offset))
          (setq class-decl (buffer-substring-no-properties (match-beginning d-class-decl-index) (match-end d-class-decl-index)))
          (setq class-name (buffer-substring-no-properties (match-beginning d-class-name-index) (match-end d-class-name-index)))
          ;;(if debug-on-error (debug "Louis Armstrong: Once in a while" tab-width))
          ;;(debug "Rugina")
          )
         ) ;; END COND!
        (when (eq *major-mode* 'jtw-mode)
          (cond
           ((setq begin-main-i (if (save-excursion
                                     (beginning-of-line)
                                     (looking-at (concat begin-main-regexp)))
                                   (point)))
            (setq begin-main-tab-width (/ (- (match-end 1) (match-beginning 1)) c-basic-offset)))
           ;; ----------------------------------------------------------
           ((setq begin-main-i (save-excursion
                                 (re-search-backward begin-main-regexp nil t)))
            (setq begin-main-tab-width (/ (- (match-end 1) (match-beginning 1)) c-basic-offset))
            )
           ) ;; END COND!
          ) ;; END WHEN!
        (when (eq *major-mode* 'lisp++-mode)
          (assert namespace-decl)
          (cond
           ((setq namespace-i (if (save-excursion
                                    (beginning-of-line)
                                    (looking-at namespace-regexp))
                                  (point)))
            (setq namespace-tab-width (/ (- (match-end 1) (match-beginning 1)) c-basic-offset))
            (setq namespace-name      (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
            )
           ((setq namespace-i (save-excursion
                                (re-search-backward namespace-regexp nil t)))
            (setq namespace-tab-width (/ (- (match-end 1) (match-beginning 1)) c-basic-offset))
            (setq namespace-name      (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
            )
           )
          )
        ;;(if begin-main-i (message "begin-main-i is not nil"))
        (when (and (not meth-i) (not class-i) (not namespace-i) (not begin-main-i))
          (setq done t)
          ;;(debug "Bjork: Atom Dance")
          )
        (when (not done)
          (if (not meth-i)       (setq meth-i       (point-min)))
          (if (not class-i)      (setq class-i      (point-min)))
          (if (not namespace-i)  (setq namespace-i  (point-min)))
          (if (not begin-main-i) (setq begin-main-i (point-min)))
          ;;(when debug-on-error
          ;;  (setq debug-on-error nil)
          ;;  (debug "Dire Straits: Brothers in Arms"))
          ;;(if debug-on-error (debug "Louis Armstrong: Squeeze me"))
          (cond
           ((and (>= meth-i class-i) (>= meth-i begin-main-i) (>= meth-i namespace-i) (> meth-i 1))
            ;;(if (eq *major-mode* 'lisp++-mode)
            ;;    (setq cfm--method-1 (concat "(cname " meth-name ") " meth-args))
            (setq cfm--method-1    (concat meth-name meth-args))
            (setq cfm--method-1-rq (regexp-quote cfm--method-1))
            (setq spaces (make-string meth-tab-width ? ))
            (setq cfm--method-1    (concat spaces cfm--method-1))
            (setq cfm--method-1-rq (concat "^" spaces cfm--method-1-rq))
            ;;(if debug-on-error (debug "Highlight Line"))
            (setq list (cons (funcall func cfm--method-1-rq) list))
            (goto-char meth-i)
            (forward-line -1)
            ;;(if debug-on-error (debug "Led Zeppelin: Dazed and Confused"))
            )
           ((and (>= class-i meth-i) (>= class-i begin-main-i) (>= class-i namespace-i) (> class-i 1))
            (setq cfm--method-1    (concat class-decl " " class-name))
            (setq cfm--method-1-rq (regexp-quote cfm--method-1))
            (setq spaces (make-string class-tab-width ? ))
            (setq cfm--method-1    (concat spaces cfm--method-1))
            (setq cfm--method-1-rq (concat "^" spaces cfm--method-1-rq))
            (setq list (cons (concat "^" spaces class-decl " " (regexp-quote class-name)) list))
            (goto-char class-i)
            (forward-line -1)
            ;;(if debug-on-error (debug "Led Zeppelin: Whole Lotta Love"))
            )
           ;; --------------------------------------------------------
           ((and (>= namespace-i meth-i) (>= namespace-i class-i) (>= namespace-i begin-main-i) (> namespace-i 1))
            (setq spaces (make-string namespace-tab-width ? ))
            (setq cfm--method-1 (concat "^" spaces namespace-decl " " namespace-name "\\>"))
            (setq list (cons cfm--method-1 list))
            (goto-char namespace-i)
            (forward-line -1))
           ;; --------------------------------------------------------
           ((and (>= begin-main-i meth-i) (>= begin-main-i class-i) (>= begin-main-i namespace-i) (> begin-main-i 1))
            (setq cfm--method-1 "beginMain")
            (setq cfm--method-1-rq (concat cfm--method-1 "\\>"))
            (setq spaces (make-string begin-main-tab-width ? ))
            (setq cfm--method-1    (concat spaces cfm--method-1))
            (setq cfm--method-1-rq (concat "^" spaces cfm--method-1-rq))
            (setq list (cons (concat "^" spaces "beginMain\\>") list))
            (goto-char begin-main-i)
            (forward-line -1)
            ;;(if debug-on-error (debug "Led Zeppelin: Immigrant Song"))
            )
           (t
            (setq done t))
           )     ;; END COND!
          ;;(debug "Hole in one")
          ))) ;; END SAVE-EXCURSION!
    ;;(debug "R.E.M: Oddfelows Local 151")
    (set-buffer b)
    (goto-char (point-min))
    ;;(if debug-on-error (debug "Queen: Another one bites the dust"))
    (setq ptr list)
    ;;(if debug-on-error (debug "How can words desribe his fallen state"))
    (while ptr
      (beginning-of-line)
      (when (not (re-search-forward (car ptr) nil t))
        (message "Failed to find#2 (car ptr)=%s" (car ptr))
        ;;(when debug-on-error
        ;;  (setq debug-on-error nil)
        ;;  (debug "Nike: Just Do It list=%s" list))
        )
      (setq ptr (cdr ptr)))
    (if (= (point-at-bol) (point-min))
        (put-text-property (point-at-bol) (save-excursion
                                            (beginning-of-line)
                                            (skip-chars-forward " \t")
                                            (skip-chars-forward "-a-zA-Z0-9_:+.")
                                            (point))
                           'face 'd-face-speedbar-highlighted)
      (put-text-property (point-at-bol) (save-excursion
                                          (skip-chars-forward " \t")
                                          (skip-chars-forward "-a-zA-Z0-9_:]")
                                          (point))
                         'face 'd-face-speedbar-highlighted))

    ;;(if debug-on-error (debug "Led Zeppelin: Kashmir"))
    (setq p (point))
    ;;(recenter)
    ) ;; END LET!
  )

(defun d-namespace--goto-method ()
  (let (p class-spaces class-decl class-name cur-spaces cur-decl
          cur-name cur-args cur-spaces-narrow cur-spaces-wide
          list ptr done)
    (assert (string-match d-speedbar--regexp-name (buffer-name)))
    (assert (eq major-mode 'fundamental-mode))
    (save-excursion
      (setq cur-line-orig (d-current-line-as-string))
      (setq cur-line-orig-number (d-what-line))
      (setq list nil)
      (setq done nil)
      (goto-char (point-min))
      (while (not done)
        (setq cur-line (d-current-line-as-string))
        (setq cur-line-number (d-what-line))
        (assert (string-match "\\([ \t]*\\)" cur-line))
        (setq cur-spaces-narrow (make-string (- (match-end 1) (match-beginning 1)) ? ))
        (setq cur-spaces-wide   (make-string (* c-basic-offset (length cur-spaces-narrow)) ? ))
        (if (= cur-line-number cur-line-orig-number)
            (setq done t))
        (setq cur-decl nil)
        (setq cur-name nil)
        (setq cur-args nil)
        ;;(when debug-on-error
        ;;  (setq debug-on-error nil)
        ;;  (debug "Bob Seger: The years roll slowly past"))
        (when (or (eq *major-mode* 'c-mode)
                  (eq *major-mode* 'c++-mode)
                  (eq *major-mode* 'java-mode))
          (cond
           ((string-match (concat "^" cur-spaces-narrow "\\(class\\|interface\\|namespace\\)[ \t]+\\([a-zA-Z_][a-zA-Z0-9_]*\\)[ \t]*$") cur-line)
            (setq cur-decl   (substring cur-line (match-beginning 1) (match-end 1)))
            (setq cur-name   (substring cur-line (match-beginning 2) (match-end 2)))
            (setq cur-args   nil)
            )
           ((string-match (concat "^" cur-spaces-narrow "\\([a-zA-Z_][a-zA-Z0-9_:<>]*\\)\\(([^()]*)\\)") cur-line)
            (setq cur-decl   nil)
            (setq cur-name   (substring cur-line (match-beginning 1) (match-end 1)))
            ;;(if debug-on-error (debug "Queen: Your my best friend"))
            (if (and (match-beginning 2) (match-end 2))
                (setq cur-args (substring cur-line (match-beginning 2) (match-end 2)))
              (if (not cur-args)
                  (setq cur-args "()")))
            )
           ((string-match "\\(^[ \t]*\\)beginMain\\>" cur-line)
            ;;(setq cur-spaces-narrow (make-string (- (match-end 1) (match-beginning 1)) ? ))
            ;;(setq cur-spaces-wide (make-string (* c-basic-offset (length cur-spaces-narrow)) ? ))
            (setq cur-decl   nil)
            (setq cur-name   "beginMain")
            (setq cur-args   nil)
            )
           (t
            (setq cur-name nil)
            ;;(d-beeps "Unhandled case line=%s" cur-line)
            )
           )
          (when cur-name
            (setq list (cons (concat "^" cur-spaces-wide (if cur-decl (concat cur-decl " ") "[a-zA-Z_][a-zA-Z0-9_ <,.]*[ >]*[&*]*[][]*[ \t]+") (regexp-quote cur-name) (if cur-args (regexp-quote cur-args)))
                             list))
            ) ;; END INNER WHEN!
          )   ;; END WHEN!
        (when (eq *major-mode* 'lisp++-mode)
          (cond
           ((string-match "cclass \\([a-zA-Z_][a-zA-Z0-9_]*\\)" cur-line)
            (setq cur-decl "class")
            (setq cur-name (substring cur-line (match-beginning 1) (match-end 1)))
            )
           ((string-match "\\(^[ \t]*\\)[a-zA-Z0-9_ ][ \t]+(cname \\([^()]+\\))" cur-line)
            (setq cur-decl "\\(cfunction\\|cfriend\\|cmethod\\)")
            (setq cur-name (concat "(cname " (substring cur-line (match-beginning 2) (match-end 2)) ")"))
            )
           (t
            (setq cur-name nil)))
          (when cur-name
            (setq list (cons (concat "^" cur-spaces-wide (if cur-decl (concat cur-decl " ")) ".*(cname " (regexp-quote cur-name) ").*(cargs? " (if cur-args (regexp-quote cur-args)) ")")
                             list))
            ) ;; END INNER WHEN!
          )   ;; END WHEN!
        (forward-line 1)
        ) ;; while (NOT DONE)!
      )   ;; END SAVE-EXCURSION!
    (assert (string-match d-speedbar--regexp-name (buffer-name)))
    (other-window 1)
    (goto-char (point-min))
    ;;(message "*** cur-spaces=\"%s\" cur-name=%s cur-args=%s" cur-spaces cur-name cur-args)
    (setq list (nreverse list))
    ;;(message "list#3 = %s" (prin1-to-string list))
    (setq ptr list)
    (while ptr
      (when (not (re-search-forward (car ptr) nil t))
        (message "Failed to find#1 (car ptr)=%s" (car ptr))
        )
      (setq ptr (cdr ptr)))
    ;;(if debug-on-error (debug "Bob Dylan: The moral of the story is very plain to see"))
    ) ;; END LET!
  )

(defun d-speedbar--is-foreign-buffer ()
  (or (eq *major-mode* 'electric-buffer-menu-mode)
      (eq *major-mode* 'minibuffer-inactive-mode)
      (eq *major-mode* 'messages-buffer-mode)
      ;;(eq *major-mode* 'fundamental-mode)
      (eq *major-mode* 'debugger-mode)
      (eq *major-mode* 'occur-mode)
      (eq *major-mode* 'help-mode)
      (eq *major-mode* 'text-mode)))

(defun d-speedbar--is-local-buffer ()
  (or (eq *major-mode* 'c-mode)
      (eq *major-mode* 'tes-mode)
      (eq *major-mode* 'c++-mode)
      (eq *major-mode* 'jtw-mode)
      (eq *major-mode* 'java-mode)
      (eq *major-mode* 'html-mode)
      (eq *major-mode* 'dired-mode)
      (eq *major-mode* 'lisp++-mode)
      (eq *major-mode* 'makefile-mode)
      (eq *major-mode* 'emacs-lisp-mode)
      (eq *major-mode* 'compilation-mode)
      ))

;; (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)
      (setq *major-mode* major-mode)
      (d-quote when debug-on-error
        (setq debug-on-error nil)
        (debug "Limbs of steel"))
      (when (not (d-speedbar--is-foreign-buffer))
        ;;(d-beeps "hello there")
        (setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
        (d-quote when debug-on-error
          (setq debug-on-error nil)
          (debug "Beethoven's Choral Symphony No. 9"))
        ;; (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 '*old-major-mode*)
              (setq-default *old-major-mode* major-mode)
              (setq-default *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 (if (buffer-file-name)
                                     (file-name-nondirectory (buffer-file-name))
                                   (buffer-name))
                                 list))
                (if d-window-size
                    (setq list (cons (make-string d-window-size ?-)
                                     list)))
                (goto-char (point-min))
                (assert old-buf)
                (assert new-buf)
                (setq-default *major-mode* major-mode)
                (cond
                 ;; ------------------------------------------------------
                 ((eq *major-mode* 'lisp++-mode)
                  ;;(d-beeps "lisp++-mode")
                  (setq meth-regexp  d-speedbar--lisp++-meth-regexp)
                  (setq class-regexp d-speedbar--lisp++-class-regexp)
                  (d-namespace--insert-all-methods 1 'cargs-2-args meth-regexp class-regexp)
                  ;;(when debug-on-error
                  ;;  (setq debug-on-error nil)
                  ;;  (debug "Holy minimalist"))
                  )
                 ;; --------------------------------------------------
                 ((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 (concat (car ptr2) "/") list))
                    (setq ptr2 (cdr ptr2)))
                  (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 (car ptr2) list))
                    (setq ptr2 (cdr ptr2)))
                  (setq list (nreverse list))
                  (save-excursion
                    (set-buffer new-buf)
                    (read-only-mode -1)
                    (erase-buffer)
                    (setq ptr list)
                    (while ptr
                      (insert (car ptr) "\n")
                      (setq ptr (cdr ptr)))
                    ))
                 ;; ------------------------------------------------------
                 ((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_+<>/=:!
                  (let (i type name args)
                    ;;(setq i 0)
                    (while (re-search-forward "(\\(defun\\|defmacro\\|defadvice\\) +\\([-a-zA-Z0-9_<>/:!*+=]+\\)[ \t\r\n]*\\(([^()]*)\\)" nil t)
                      (setq type (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
                      (setq name (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
                      (setq args (if (and (match-beginning 3) (match-end 3))
                                     (buffer-substring-no-properties (match-beginning 3) (match-end 3))
                                   ""))
                      (setq list (cons (concat name args)
                                       list))
                      ;;(forward-line 1)
                      ;;(incf i)
                      ;;(if (and debug-on-error (= i 3)) (debug "foo"))
                      )) ;; END LET!
                  (save-excursion
                    (set-buffer new-buf)
                    (read-only-mode -1)
                    (erase-buffer)
                    (setq list (nreverse list))
                    (setq ptr list)
                    (while ptr
                      (insert (car ptr) "\n")
                      (setq ptr (cdr ptr)))
                    ))
                 ;; ------------------------------------------------------
                 ((eq *major-mode* 'java-mode)
                  ;;(if debug-on-error (debug "Tenderly"))
                  (save-excursion
                    (set-buffer old-buf)
                    (setq truncate-lines t))
                  (setq meth-regexp  d-speedbar--java-meth-regexp)
                  (setq class-regexp d-speedbar--java-class-regexp)
                  (d-speedbar--set-indicies)
                  (d-namespace--insert-all-methods c-basic-offset 'identity meth-regexp class-regexp)
                  ;;(if *fart* (debug "*fart*3"))
                  )
                 ;; ---------------------------------------------------
                 ((eq *major-mode* 'jtw-mode)
                  (save-excursion
                    (set-buffer old-buf)
                    (setq truncate-lines t))
                  (setq meth-regexp  d-speedbar--jtw-meth-regexp)
                  (setq class-regexp d-speedbar--jtw-class-regexp)
                  ;;(debug "not implemented yet")
                  (d-speedbar--set-indicies)
                  (d-namespace--insert-all-methods c-basic-offset 'identity meth-regexp class-regexp)
                  )
                 ;; ------------------------------------------------------
                 ((or (eq *major-mode* 'c-mode)
                      (eq *major-mode* 'c++-mode))
                  (d-quote
                   (progn
                     (set-buffer (find-file "~/dlisp/experimental/a.cc"))
                     (setq meth-regexp  d-speedbar--c++-meth-regexp)
                     (setq class-regexp d-speedbar--c++-class-regexp)
                     (d-speedbar--set-indicies)
                     (d-get-classes-and-methods c-basic-offset meth-regexp class-regexp)
                     )
                   )
                  (setq meth-regexp  d-speedbar--c++-meth-regexp)
                  (setq class-regexp d-speedbar--c++-class-regexp)
                  (d-namespace--insert-all-methods c-basic-offset 'identity meth-regexp class-regexp)
                  ) ;; 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 (d-trim-string (buffer-substring (match-beginning 0) (match-end 0)))
                                       list)))
                     ((save-excursion
                        (save-match-data
                          (beginning-of-line)
                          (looking-at s2)))
                      (setq list (cons (d-trim-string (buffer-substring (match-beginning 0) (match-end 0)))
                                       list)))))
                  (setq list (nreverse list))
                  (save-excursion
                    (set-buffer new-buf)
                    (read-only-mode -1)
                    (erase-buffer)
                    (setq ptr list)
                    (while ptr
                      (insert (car ptr) "\n")
                      (setq ptr (cdr ptr)))
                    ) ;; END SAVE-EXCURSION!
                  )
                 ;; ------------------------------------------------------
                 ((eq *major-mode* 'php-mode)
                  (while (re-search-forward "^[ \t]*function \\([a-zA-Z_][a-zA-Z0-9_]*\\)[ \t]*\\(([^()]*)\\)" nil t)
                    (setq list (cons (buffer-substring-no-properties (match-beginning 1) (match-end 2))
                                     list))))
                 ;; ----------------------------------------------------
                 ((eq *major-mode* 'makefile-mode)
                  (while (re-search-forward "^[-a-zA-Z0-9_+.]+:" nil t)
                    (setq list (cons (concat (buffer-substring-no-properties (match-beginning 0) (match-end 0)))
                                     list)))
                  (setq list (nreverse list))
                  (save-excursion
                    (set-buffer new-buf)
                    (read-only-mode -1)
                    (erase-buffer)
                    (setq ptr list)
                    (while ptr
                      (insert (car ptr) "\n")
                      (setq ptr (cdr ptr)))
                    ) ;; END SAVE-EXCURSION!
                  )
                 (t
                  (save-excursion
                    (set-buffer new-buf)
                    (read-only-mode -1)
                    (erase-buffer)
                    (setq list (nreverse list))
                    (setq ptr  list)
                    (while ptr
                      (insert (car ptr) "\n")
                      (setq ptr (cdr ptr)))
                    ;;(message "X Buffer not recognised")
                  ))
                 ;; ------------------------------------------------------
                 ) ;; END COND!
                ) ;; END PROGN!
              ) ;; END SAVE-EXCURSION!
          (assert new-buf)
          ;;(message "Black Sabbath: Rat Salad")
          ;;(assert (stringp new-buf))
          ;;(d-beeps "calamansi")
          (when (and (boundp 'd-window-size)
                     d-window-size
                     (not (d-speedbar--is-foreign-buffer))
                     (d-speedbar--is-local-buffer))
            ;;(d-beeps "calamansi2")
            ;;(setq new-buf (nth 1 (assq (selected-frame) d-frame--buffer-window-correspondence))
            (when (> (count-windows) 1)
              (delete-other-windows))
            (when (= (count-windows) 1)
              (cond
               ((fboundp 'split-window-right)
                (setq speedbar-window (split-window-right (- d-window-size)))
                ;;(d-beeps "after split-window-right")
                )
               ((fboundp 'split-window-horizontally)
                (setq speedbar-window (split-window-horizontally (- d-window-size)))
                ;;(d-beeps "after split-window-horizontally")
                )
               (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)))
          ;; -------------------------------------------------------------
          (when (> (count-windows) 1)
            (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!
      )     ;; END LET!
    )       ;; END SAVE-MATCH-DATA!
  )         ;; END defun!

(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))))

(defun f5 ()
  (interactive)
  (message "major-mode=%s" major-mode))

;;(global-set-key [f5] 'f5)

;; (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)
  ;;(if debug-on-error (debug "pre"))
  (condition-case err
      (let ((d-message-on t)
            (w            nil)
            p1 p2 done a b p)
        (if (and (not (eq major-mode 'text-mode))
                 (not (eq major-mode 'package-mode))
                 (not (eq major-mode 'minibuffer-inactive-mode))
                 (not (d-speedbar--is-speedbar-showing)))
            (d-speedbar))
        (unwind-protect
            (progn
              (setq-default *major-mode* major-mode)
              (when (not (d-speedbar--is-foreign-buffer))
                (save-match-data
                  (if (string-match d-speedbar--regexp-name (buffer-name))
                      (progn
                        ;;(message "looking at d-speedbar.el (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
                            (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))
                            ;;(assert (window-live-p w))
                            (when b
                              (d-speedbar--cull-unused-buffers b))
                            (when (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)
                                ))
                            (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: Newport Up")
                            (setq-default *major-mode* major-mode)
                            (cond
                             ;; --------------------------------------------
                             ((eq *major-mode* 'emacs-lisp-mode)
                              (set-buffer b)
                              (if (and (eobp) (bobp)) (d-speedbar))
                              (setq p (point))
                              (read-only-mode -1)
                              ;;(message "Switched window")
                              ;;(sit-for 1)
                              (goto-char (point-min))
                              (while (not (eobp))
                                ;; "Suzie Salmon")
                                (beginning-of-line)
                                (setq p1 (point))
                                (skip-chars-forward "-a-zA-Z0-9_+<>/=:!*")
                                (setq p2 (point))
                                ;;(if debug-on-error (debug "Black Sabbath: Laguna Sunrise"))
                                (when (not (eq p1 p2))
                                  ;;(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))
                              )
                             ;; --------------------------------------------
                             ((eq *major-mode* 'lisp++-mode)
                              (set-buffer b)
                              (if (and (eobp) (bobp)) (d-speedbar))
                              (read-only-mode -1)
                              (save-excursion
                                (goto-char (point-min))
                                (while (not (eobp))
                                  (put-text-property (point-at-bol) (point-at-eol) 'face default)
                                  (forward-line 1)))
                              (save-excursion
                                (goto-char (point-min))
                                (while (re-search-forward "^ *\\(cclass +\\)\\([a-zA-Z_][a-zA-Z0-9_]*\\)$" nil t)
                                  (put-text-property (point-at-bol) (match-end 1) 'face 'bold)
                                  (put-text-property (match-beginning 2) (match-end 2) 'face 'font-lock-type-face)
                                  )
                                )
                              (save-excursion
                                (goto-char (point-min))
                                (while (re-search-forward "^[ \t]*\\([a-zA-Z_][a-zA-Z0-9_]*\\)\\(::[a-zA-Z0-9_]+\\)?\\((\\|$\\)" nil t)
                                  (put-text-property (point-at-bol) (point-at-eol) 'face 'default)
                                  (when (and (match-beginning 2) (match-end 2))
                                    (put-text-property (match-beginning 1) (match-end 1) 'face 'fg:lightred))
                                  (forward-line 1)
                                  )
                                )
                              )
                             ;; --------------------------------------------
                             ((or (eq *major-mode* 'c-mode)
                                  (eq *major-mode* 'c++-mode)
                                  (eq *major-mode* 'php-mode)
                                  (eq *major-mode* 'jtw-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)
                                  (put-text-property (point-at-bol) (match-end 1) 'face 'bold)
                                  (put-text-property (match-beginning 2) (match-end 2) 'face 'font-lock-type-face)
                                  ;;(debug "Trouble in transmission")
                                  )
                                )
                              (save-excursion
                                ;;(debug "Semolina")
                                (goto-char (point-min))
                                (while (re-search-forward "^[ \t]*\\([a-zA-Z_][a-zA-Z0-9_]*\\)\\(::[a-zA-Z0-9_]+\\)?\\((\\|$\\)" nil t)
                                  ;;foo::bar()
                                  (put-text-property (point-at-bol) (point-at-eol) 'face 'default)
                                  (when (and (match-beginning 2) (match-end 2))
                                    (put-text-property (match-beginning 1) (match-end 1) 'face 'fg:lightred))
                                  (forward-line 1)
                                  )
                                (progn
                                  (goto-char (point-min))
                                  (while (re-search-forward "^[ \t]*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* 'dired-mode)
                              (let ((case-fold-search t))
                                (set-buffer b)
                                (setq p (point))
                                (if (and (eobp) (bobp)) (d-speedbar))
                                (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))
                                (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)
                                  (eq *major-mode* 'tes-mode)
                                  )
                              (set-buffer b)
                              (if (and (eobp) (bobp)) (d-speedbar))
                              (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)))
                             ((eq *major-mode* 'html-mode)
                              )
                             (t
                              (message "Buffer not recognised")
                              )
                             ;; --------------------------------------
                             )      ;; END COND!
                            )       ;; END SAVE-EXCURSION!!
                          )         ;; END SAVE-WINDOW-EXCURSION!
                      )             ;; END UNWIND-PROTECT!
                    )               ;; END if!
                  )                 ;; END SAVE-MATCH-DATA!
                )                   ;; END WHEN (NOT D-SPEEDBAR--IS-FOREIGN-BUFFER)!
              )                     ;; END PROGN!
          )                         ;; END UNWIND-PROTECT!
        )                           ;; END LET!
    (error (message "err=%s" err))) ;; END CONDITION-case!
    )

;; (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 ((d-message-on t) p 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))
                (let (p1 p2 pair pair2 line class)
                  (setq-default cfm--method nil)
                  (set-buffer   (d-speedbar--get-old-buffer))
                  (d-speedbar--set-window-size)
                  (if (not (eq major-mode 'minibuffer-inactive-mode))
                      (setq-default *major-mode* major-mode))
                  (cond
                   ;; ------------------------------------------------
                   ((eq *major-mode* 'lisp++-mode)
                    (save-excursion
                      (set-buffer b)
                      (goto-char (point-min))
                      (put-text-property (point-min) (point-at-eol) 'face 'default))
                    (d-speedbar--set-indicies)
                    (setq meth-regexp  d-speedbar--lisp++-meth-regexp)
                    (setq class-regexp d-speedbar--lisp++-class-regexp)
                    (d-namespace--highlight-line 1 'cargs-2-args meth-regexp class-regexp)
                    )
                   ;; ------------------------------------------------
                   ((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 (and (not (eq p1 p2))
                                   (not (save-excursion
                                          (beginning-of-line)
                                          (bobp))))
                          (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)
                    (progn
                      (setq meth-regexp  d-speedbar--java-meth-regexp)
                      (setq class-regexp d-speedbar--java-class-regexp)
                      (d-speedbar--set-indicies)
                      (d-namespace--highlight-line c-basic-offset 'identity meth-regexp class-regexp))
                    (assert p)
                    ) ;; END (EQ MAJOR-MODE 'JAVA-MODE)! cool here
                   ;; ------------------------------------------------
                   ((eq *major-mode* 'jtw-mode)
                    (progn
                      (setq meth-regexp  d-speedbar--jtw-meth-regexp)
                      (setq class-regexp d-speedbar--jtw-class-regexp)
                      (d-speedbar--set-indicies)
                      (d-namespace--highlight-line c-basic-offset 'identity meth-regexp class-regexp))
                    (assert p)
                    )
                   ;; -----------------------------------------------
                   ((or (eq *major-mode* 'c-mode)
                        (eq *major-mode* 'c++-mode))
                    ;;(debug "When black friday comes")
                    (save-excursion
                      (set-buffer b)
                      (goto-char (point-min))
                      (put-text-property (point-min) (point-at-eol) 'face 'default))
                    (d-speedbar--set-indicies)
                    (setq meth-regexp  d-speedbar--c++-meth-regexp)
                    (setq class-regexp d-speedbar--c++-class-regexp)
                    (d-namespace--highlight-line c-basic-offset 'identity meth-regexp class-regexp)
                    (d-quote if (not p) (message "(p is nil)")
                             (message "(p is not nil)"))
                    ;;(debug "Cold potatoes")
                    ;;(setq-default d-old-method nil)
                    ;;(setq-default d-all-smegs t)
                    )
                   ;; ------------------------------------------------
                   ((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))
                      (assert p)
                      ))
                   ;; ------------------------------------------------
                   ((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)
                        (insert " ")
                        (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
                      ;;(message "*** d-window-size=%s" 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)))
                          ;;(message "foo0")
                          (cond
                           ((fboundp 'split-window-right)
                            ;;(message "foo1")
                            (setq w (split-window-right (- d-window-size))))
                           ((fboundp 'split-window-horizontally)
                            ;;(message "foo2")
                            (setq w (split-window-horizontally (- d-window-size)))
                            ))
                          ;;(message "foo3")
                          (setf (nth 2 a) w))
                        ;;(message "foo4")
                        ))
                    (if (not p) (message "(p is nil)"))
                    (if (not w) (message "(w is nil)"))
                    (if (not (windowp w)) (message "(not windowp w)"))
                    (when (window-live-p w)
                      (select-window w)
                      ;;(set-window-point (selected-window) p)
                      ;;(message "Zip Zap! p=%s" 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 LET!
    '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))
  )

(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-2)
    (cancel-timer d-speedbar--timer-3)
    )
  )

(defun d-speedbar--triple ()
  (interactive)
  (d-speedbar)
  (d-speedbar--set--delete-all)
  (d-speedbar--set--set-current)
  )

(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
            new-win count str namespace class start end b name decl
            goto looking-at goto-name goto-decl case-fold-search
            class-or-interface)
      ;;(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 old-buf)
                (setq-default *major-mode* major-mode)
                (set-buffer b)
                (read-only-mode -1)
                (cond
                 ;; ------------------------------------------------------
                 ((eq *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 *major-mode* 'jtw-mode)
                  (d-namespace--goto-method)
                  (push-mark)
                  )
                 ;; --------------------------------------------------
                 ((eq *major-mode* 'java-mode)
                  (d-namespace--goto-method)
                  (push-mark)
                  )
                 ;; ---------------------------------------------------- ---------
                 ((or (eq *major-mode* 'c-mode) (eq *major-mode* 'c++-mode))
                  ;;(d-beeps "calamansi")
                  (d-namespace--goto-method)
                  (push-mark)
                  )
                 ;; --------------------------------------------------
                 ((eq *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)
                    (goto-char (point-min))
                    (re-search-forward (concat "(\\(defun\\|defmacro\\|defadvice\\)[ \t]*" (regexp-quote name) "[ \t]*" (regexp-quote args)))
                    (beginning-of-line)
                    (push-mark)
                    ))
                 ;; --------------------------------------------------
                 ((eq *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 *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 *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 *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)
                  )
                 ((eq *major-mode* 'lisp++-mode)
                  (beginning-of-line)
                  (skip-chars-forward "-a-zA-Z0-9_<>!=+* ")
                  (setq str (d-trim-string (buffer-substring-no-properties (point-at-bol) (point))))
                  ;;(assert (looking-at "("))
                  (message "str=%s" str)
                  (other-window 1)
                  (goto-char (point-min))
                  (re-search-forward str nil t)
                  (push-mark)
                  )
                 ;; --------------------------------------------------
                 )) ;; END PROGN!
            (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))

(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)
(global-set-key [f4] 'd-speedbar--triple)

(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))))
    (if (> (count-windows) 1)
        (delete-other-windows))
    (d-quote 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)
  (let ((mode major-mode))
    (text-mode)
    (call-interactively 'ispell-word)
    (funcall mode))
  )

(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)

(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 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-speedbar--query-replace ()
  (interactive)
  (d-delete-speedbar-window)
  (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))
  ;;(call-interactively 'query-replace)
  (d-speedbar)
  ;;(widen)
  ;;(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-speedbar--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)
  (if (> (count-windows) 1)
      (delete-other-windows))
  ad-do-it
  ;;(delete-window)
  )

(defadvice describe-syntax (around d-speedbar activate)
  (if (> (count-windows) 1)
      (delete-other-windows))
  ad-do-it)

(provide 'd-speedbar)
Back
| Main Menu | Research Projects | Photo Album | Curriculum Vitae | The Greatest Artists |
| Email Address | Computer Games | Web Design | Java Training Wheels | The Fly (A Story) |
| Political Activism | Bob Dylan Quotes+ | My Life Story | Smoking Cessation | Other Links |
| Debugging Macros | String Class I | Linked List System I | Java for C Programmers | Naming Convention |
| String Class II | How I use m4 | Strings III | Symmetrical I/O | Linked Lists II |
| Run-Time Type Info | Virtual Methods | An Array System | Science & Religion | Submodes |
| Nested Packages | Memory Leaks | Garbage Collection | Internet & Poverty | What is Knowledge? |
| Limits of Evolution | Emacs Additions | Function Plotter | Romantic Love | The Next Big Thing |
| Science Fiction | Faster Compilation | Theory of Morality | Elisp Scoping | Elisp Advice |
| S.O.G.M. Pattern | Safe Properties | School Bullying | Charisma Control | Life and Death |
| Splitting Java | Multiple Ctors | Religious Beliefs | Conversation 1 | Conversation 2 |
| J.T.W. Language | Emacs Additions II | Build Counter | Relation Plotter | Lisp++ Language |
| Memory Leaks II | Super Constructors | CRUD Implementation | Order a Website Form | There Is An Afterlife |
| More Occam's Razor | C to Java Translator | Theory of Morality II
Last modified: Sat Apr 29 18:35:53 NZST 2017
Best viewed at 800x600 or above resolution.
© Copyright 1999-2017 Davin Pearson.
Please report any broken links to