---
(require 'cl)
(d-assert (fboundp 'incf))
(d-assert (fboundp 'cdddr))
(d-assert (fboundp 'd-assert))
(if (not (boundp 'prefs-advanced-user-p))
(setq prefs-advanced-user-p t))
(require 'early-bindings)
(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*)
(kill-local-variable '*major-mode*)
(setq-default d-window-size 15
*old-major-mode* nil
cursor-in-non-selected-windows t
)
)
(defun d-get-classes-and-methods (c-basic-offset meth-regexp class-regexp)
(interactive)
(save-excursion
(when (not (or (eq *major-mode* 'c-mode)
(eq *major-mode* 'c++-mode)
(eq *major-mode* 'jtw-mode)
(eq *major-mode* 'php-mode)
(eq *major-mode* 'java-mode)
(eq *major-mode* 'lisp++-mode)
))
(let ((debug-on-error nil))
(error "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 10 c-basic-offset meth-regexp class-regexp)
(setq *d-classes-and-methods* (reverse *d-classes-and-methods*))
(setq *fart* *d-classes-and-methods*)
*d-classes-and-methods*
)
)
(progn
(setq d-speedbar--java-meth-regexp-pre (concat "\\(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]+\\)"))
(setq d-speedbar--java-meth-regexp (concat d-speedbar--java-meth-regexp-pre "\\([a-z][a-zA-Z0-9_]*\\)\\(([^0-9()][^()]*)\\|()\\)"))
(setq d-speedbar--java-class-regexp-pre (concat "\\(public[ \t]+\\|abstract[ \t]+\\|final[ \t]+\\)*"))
(setq d-speedbar--java-class-regexp (concat d-speedbar--java-class-regexp-pre "\\(class\\|interface\\)[ \t]+\\([A-Z][a-zA-Z0-9_]*\\)"))
(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]+\\)")
(setq d-speedbar--jtw-meth-regexp (concat d-speedbar--jtw-meth-regexp-pre "\\([a-z][a-zA-Z0-9_]*\\)\\(([^0-9()][^()]*)\\|()\\)"))
(setq d-speedbar--jtw-class-regexp-pre (concat "\\(public[ \t]+\\|abstract[ \t]+\\|final[ \t]+\\)*"))
(setq d-speedbar--jtw-class-regexp (concat d-speedbar--jtw-class-regexp-pre "\\(class\\|interface\\)[ \t]+\\([A-Z][a-zA-Z0-9_]*\\)"))
(setq d-speedbar--c++-meth-regexp "\\([A-Z0-9]+[ \t]+\\|extern[ \t]+\\|inline[ \t]+\\|static[ \t]+\\|const[ \t]+\\)*[a-zA-Z_][a-zA-Z0-9_<,]*[> ]*[&*]*[ \t]+\\([a-zA-Z_][a-zA-Z0-9_:~]*\\|operator[ \t]*[-!%^&*=<>]+\\)\\(([^()0-9][^()]*)\\|()\\)")
(setq d-speedbar--c++-class-regexp "\\([A-Z0-9]+[ \t]+\\)*\\(class\\|namespace\\)[ \t]+\\([a-zA-Z_][a-zA-Z0-9_]*\\>\\)")
(setq d-speedbar--lisp++-meth-regexp "(\\(cfunction\\|cmethod\\) (ctype [^()]*) (cname \\([a-zA-Z_][a-zA-Z0-9_]*\\)) \\((carg [^()]*)\\|(cargs *\\((carg [^()]*) *\\)*)\\)")
(setq d-speedbar--lisp++-class-regexp "(\\(cclass\\|cnamespace\\) \\([a-zA-Z_][a-zA-Z0-9_]*\\)")
(kill-local-variable '*fart*)
(defvar *fart* nil)
)
(defun d-speedbar--set-indicies ()
(cond
((eq *major-mode* 'lisp++-mode)
(setq d-meth-name-index 3)
(setq d-meth-args-index 4)
(setq d-class-decl-index 2)
(setq d-class-name-index 3)
)
((eq *major-mode* 'java-mode)
(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-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-name-index 3)
(setq d-meth-args-index 4)
(setq d-class-decl-index 3)
(setq d-class-name-index 4)
)
) )
(defun d-get-classes-and-methods-inner (offset c-basic-offset meth-regexp class-regexp)
(if (eq major-mode 'debugger-mode)
nil
(when (not (or (eq *major-mode* 'c-mode)
(eq *major-mode* 'c++-mode)
(eq *major-mode* 'jtw-mode)
(eq *major-mode* 'php-mode)
(eq *major-mode* 'java-mode)
(eq *major-mode* 'lisp++-mode)
(eq *major-mode* 'emacs-lisp-mode)
))
(error "Wrong major-mode#1 *major-mode*=%s" *major-mode*))
(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)
(setq length (1+ offset))
(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 p-meth-array (make-vector length nil))
(setq p-class-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))
--------------------------------------------------------------- (while (not done)
(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 (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)))
(setf (aref function-args-array i) (buffer-substring-no-properties (match-beginning d-meth-args-index) (match-end d-meth-args-index)))
(if (and (match-beginning (1+ d-meth-args-index)) (match-end (1+ d-meth-args-index)))
(setf (aref function-args-array i) (concat (aref function-args-array i) ";")))
))
(progn
(goto-char p-orig)
(setf (aref p-class-array i) (re-search-forward (concat "^\\(" (aref tab-array i) "\\)" class-regexp) nil t))
(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)
(setf (aref p-begin-main-array i) (re-search-forward (concat "\\(^" (aref tab-array i) "\\)beginMain\\>") nil t))
)
(incf i)
) ------------------------------------------------------------- (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))
(setq found t)
(return nil))
(incf i))
) (if (not found)
(setq done t)
(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-begin-main-array i))
(setf (aref p-begin-main-array i) (point-max)))
(incf i))
----------------------------------------------------------- (setq min-found (point-max))
(setq min-i -1)
(setq i 0)
(while (< i length)
(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-begin-main nil)
(setq min-found-class nil)
(setq min-i i)
(setq min-class-or-method 'method)
)
(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-begin-main nil)
(setq min-found-method nil)
(setq min-i i)
(setq min-class-or-method 'class)
)
(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-method nil)
(setq min-i i)
(setq min-class-or-method 'begin-main)
)
(incf i))
(when (= min-i -1)
(let ((debug-on-error nil))
(error "(= min-i -1)")))
(cond
((eq min-class-or-method 'method)
(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*))
(goto-char min-found-method)
(d-get-classes-and-methods-inner (+ 10 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*))
(goto-char min-found-class)
(d-get-classes-and-methods-inner (+ 10 offset) c-basic-offset meth-regexp class-regexp)
)
((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*))
(goto-char min-found-begin-main)
(d-get-classes-and-methods-inner (+ 10 offset) c-basic-offset meth-regexp class-regexp)
)
(t
(error "Should never happen"))
) ) ) ) ) )
(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))
)
(defun d-speedbar--get-old-buffer ()
(window-buffer (d-speedbar--get-old-window)))
(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 (d-read-str n)))
(setq n -1)
n))))
(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))
) (set-buffer old-buf)
) count
)))
(defun d-speedbar--get-latest-speedbar-buffer ()
(save-match-data
(save-excursion
(let* ((list (buffer-list)) (count 0)
(result nil))
(setq count (d-speedbar--get-count list))
(setq result (format d-speedbar--format-name count))
(d-assert result)
(d-assert (stringp result))
result
))))
(defun d-speedbar--set-window-size ()
(cond
((eq major-mode 'c-mode) (setq-default d-window-size 20))
((eq major-mode 'jtw-mode) (setq-default d-window-size 20))
((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 'php-mode) (setq-default d-window-size 30))
((eq major-mode 'java-mode) (setq-default d-window-size 20))
((eq major-mode 'text-mode) (setq-default d-window-size nil))
((eq major-mode 'html-mode) (setq-default d-window-size 20))
((eq major-mode 'dired-mode) (setq-default d-window-size 10))
((eq major-mode 'lisp++-mode) (setq-default d-window-size 20))
((eq major-mode 'makefile-mode) (setq-default d-window-size 20))
((eq major-mode 'emacs-lisp-mode) (setq-default d-window-size 20))
((eq major-mode 'compilation-mode) (setq-default d-window-size 20))
((or (eq major-mode 'grep-mode)
(eq major-mode 'help-mode)
(eq major-mode 'occur-mode)
(eq major-mode 'debugger-mode)
(eq major-mode 'fundamental-mode)
(eq major-mode 'messages-buffer-mode)
(eq major-mode 'minibuffer-inactive-mode)
(eq major-mode 'electric-buffer-menu-mode)
)
(setq-default d-window-size nil))
(t
(setq-default d-window-size nil)))
d-window-size)
(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
))
(d-quote
defun d-merge-lists (list-methods)
(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)
) )
(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))
(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)))))
(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)))))
result))
(defun d-namespace--insert-all-methods (c-basic-offset func meth-regexp class-regexp)
(let (list2)
(when (not (boundp 'new-buf))
(d-error "Variable new-buf is not bound"))
(when (not (boundp 'old-buf))
(d-error "Variable old-buf is not bound"))
(d-speedbar--set-indicies)
(d-get-classes-and-methods c-basic-offset meth-regexp class-regexp)
(when (not (boundp 'list))
(d-error "Variable list is not bound"))
(when (not (boundp '*d-classes-and-methods*))
(d-error "Variable *d-classes-and-methods* is not bound")))
(save-excursion
(d-assert (and 'foomatic (boundp 'new-buf)))
(d-assert (and 'now-that-youd-make-yourself-love-me (set-buffer new-buf)))
(d-assert (and 'girls-on-film (string= (buffer-name) new-buf)))
(d-assert (and 'schubert (get-buffer new-buf)))
(d-assert (and 'chemical-brothers (buffer-live-p (get-buffer new-buf))))
(d-assert (and 'time-may-change-me (set-buffer new-buf)))
(set-buffer new-buf)
(d-assert (get-buffer new-buf))
(read-only-mode -1)
(when (not (or (eq *major-mode* 'c-mode)
(eq *major-mode* 'c++-mode)
(eq *major-mode* 'jtw-mode)
(eq *major-mode* 'php-mode)
(eq *major-mode* 'java-mode)
(eq *major-mode* 'lisp++-mode)
(eq *major-mode* 'emacs-lisp-mode)
))
(d-error "Wrong major-mode#2 *major-mode*=%s" *major-mode*)))
------------------------------------------------------------- (progn
(set-buffer new-buf)
(read-only-mode -1)
(erase-buffer)
(setq list2 (append (reverse list) *d-classes-and-methods*))
(setq ptr list2)
(while ptr
(d-assert (eq 'identity func))
(insert (propertize (funcall func (car ptr))
'mouse-face 'highlight
'help-echo "mouse-2: visit this file"
'follow-link t
'keymap
(let ((map (make-sparse-keymap))
(cmd (lambda ()
(interactive)
(d-speedbar--goto-method))))
(define-key map [mouse-2] cmd)
(define-key map [?\C-m] cmd)
map))
"\n")
(setq ptr (cdr ptr))
) ) )
(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 count list ptr)
(save-excursion
(when (not (or (eq func 'cargs-2-args)
(eq func 'args-2-cargs)
(eq func 'identity)))
(let ((debug-on-error nil))
(error "Wrong binding for func variable")))
(when (not (or (eq *major-mode* 'c-mode)
(eq *major-mode* 'c++-mode)
(eq *major-mode* 'jtw-mode)
(eq *major-mode* 'php-mode)
(eq *major-mode* 'java-mode)
(eq *major-mode* 'lisp++-mode)
))
(let ((debug-on-error nil))
(error "Wrong major mode #2 major-mode=%s" major-mode)))
(setq space-regexp "\\(^[ \t]*\\)")
(setq begin-main-regexp (concat space-regexp "beginMain\\>"))
(setq list nil)
(setq done nil)
(setq count 0)
(while (not done)
(setq begin-main-i nil)
(setq meth-i nil)
(setq class-i nil)
(cond
((setq meth-i (save-excursion
(if (progn
(beginning-of-line)
(looking-at (concat space-regexp meth-regexp)))
(point))))
(d-quote
(if (looking-at (concat space-regexp meth-regexp)) (point))
(if (looking-at (concat space-regexp class-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)))
)
((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)))
)
) (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)))
)
((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)))
)
) (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))
)
) ) (when (and (not meth-i) (not class-i) (not begin-main-i))
(setq done t)
)
(incf count)
(if (> count 1000) (debug "Hole in one"))
(when (not done)
(if (not meth-i) (setq meth-i (point-min)))
(if (not class-i) (setq class-i (point-min)))
(if (not begin-main-i) (setq begin-main-i (point-min)))
(cond
((and (>= meth-i class-i) (>= meth-i begin-main-i) (> meth-i 1))
(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))
(setq list (cons (funcall func cfm--method-1-rq) list))
(goto-char meth-i)
(forward-line -1)
)
((and (>= class-i meth-i) (>= class-i begin-main-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)
)
((and (>= begin-main-i meth-i) (>= begin-main-i class-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)
)
(t
(setq done t))
) ))) (set-buffer b)
(goto-char (point-min))
(setq ptr list)
(while ptr
(when (not (re-search-forward (car ptr) nil t))
)
(setq ptr (cdr ptr)))
(if (not (= (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 (regexp-quote "-a-zA-Z0-9_:]"))
(point))
'face 'd-face-speedbar-highlighted))
(setq p (point))
) )
(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)
(save-excursion
(beginning-of-line)
(setq cur-line (d-current-line-as-string))
(sit-and-message 3 "MANGINA")
(if (not (string-match "\\(^[ \t]*\\)" (regexp-quote cur-line)))
(error "Failed search for \\(^[ \t]*\\)%s" (regexp-quote cur-line))
(beginning-of-line)
(setq cur-spaces-narrow (make-string (- (match-end 1) (match-beginning 1)) ? ))
(setq cur-spaces-wide (if (eq *major-mode* 'lisp++-mode)
cur-spaces-narrow
(make-string (* c-basic-offset (length cur-spaces-narrow)) ? )))
(setq list nil)
(setq done nil)
(while (not done)
(setq cur-line (d-current-line-as-string))
(setq cur-decl nil)
(setq cur-name nil)
(setq cur-args nil)
(cond
((string-match (concat "^" cur-spaces-narrow "\\([A-Z0-9]+[ \t]+\\)*\\(class\\|interface\\|namespace\\)[ \t]+\\([a-zA-Z_][a-zA-Z0-9_]*\\)$") cur-line)
(setq cur-decl (substring cur-line (match-beginning 2) (match-end 2)))
(setq cur-name (substring cur-line (match-beginning 3) (match-end 3)))
(setq cur-args nil)
(d-assert cur-name)
)
((string-match (concat "^" cur-spaces-narrow "\\(cclass\\|cnamespace\\)[ \t]+\\([a-zA-Z_][a-zA-Z0-9_]*\\)$") 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)
(d-assert cur-name)
)
((string-match (concat "^" cur-spaces-narrow "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)\\((cargs[ \t]*\\((carg [^()]*)[ \t]*\\)*)\\)") cur-line)
(setq cur-decl nil)
(setq cur-name (regexp-quote (substring cur-line (match-beginning 1) (match-end 1))))
(if (and (match-beginning 2) (match-end 2))
(setq cur-args (regexp-quote (substring cur-line (match-beginning 2) (match-end 2))))
(if (not cur-args)
(setq cur-args "(cargs)")))
(d-assert cur-name)
)
((string-match (concat "^" cur-spaces-narrow "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)\\(([^()]*)\\)") cur-line)
(setq cur-decl nil)
(setq cur-name (regexp-quote (substring cur-line (match-beginning 1) (match-end 1))))
(if (and (match-beginning 2) (match-end 2))
(setq cur-args (regexp-quote (substring cur-line (match-beginning 2) (match-end 2))))
(if (not cur-args)
(setq cur-args "()")))
(d-assert cur-name)
)
((string-match (concat "^" cur-spaces-narrow "\\([a-zA-Z_][a-zA-Z0-9_:]*\\)\\((carg [^()]*)\\)") cur-line)
(setq cur-decl nil)
(setq cur-name (regexp-quote (substring cur-line (match-beginning 1) (match-end 1))))
(if (and (match-beginning 2) (match-end 2))
(setq cur-args (regexp-quote (substring cur-line (match-beginning 2) (match-end 2))))
(if (not cur-args)
(setq cur-args "(cargs)")))
(d-assert cur-name)
)
((string-match (concat "^" cur-spaces-narrow "beginMain\\>") cur-line)
(setq cur-decl nil)
(setq cur-name "beginMain")
(setq cur-args nil)
(d-assert cur-name)
)
(t
(setq cur-decl nil)
(setq cur-name nil)
(setq cur-args nil)
) ) (when cur-name
(if (eq *major-mode* 'lisp++-mode)
(setq list (cons (if cur-args
(concat cur-spaces-wide "(\\(cfunction\\|cmethod\\) (ctype [^()]*) (cname " cur-name ") " cur-args)
(if cur-decl
(concat cur-spaces-wide "(" cur-decl " " cur-name))) list))
(setq list (cons (concat "^"
cur-spaces-wide
"\\([A-Z0-9]+[ \t]+\\)*"
(if cur-decl
(concat cur-decl " " cur-name (if cur-args (concat " " cur-args)))
(if (string= cur-name "beginMain")
"beginMain"
(concat "[a-zA-Z_][a-zA-Z0-9_ ]*[a-zA-Z0-9_<,.]*[ >]*[&*]*[][]*[ \t]+" cur-name cur-args)
))) list))
)
(if (eq *major-mode* 'lisp++-mode)
(if (>= (length cur-spaces-wide) 1)
(setq cur-spaces-wide (substring cur-spaces-wide 0 -1))
(setq done t))
(if (>= (length cur-spaces-wide) c-basic-offset)
(setq cur-spaces-wide (substring cur-spaces-wide 0 (- c-basic-offset)))
(setq done t)))
(if (>= (length cur-spaces-narrow) 1)
(setq cur-spaces-narrow (substring cur-spaces-narrow 0 -1))
(setq done t))
) (when (not done)
(forward-line -1)) (when (bobp)
(setq done t)
) ) ) ) (other-window 1)
(goto-char (point-min))
(setq ptr list)
(sit-and-message 5 (format "Calamansi ptr=%s" (prin1-to-string ptr)))
(while ptr
(when (not (re-search-forward (car ptr) nil t))
(d-beeps "Failed to find#1 (car ptr)=%s" (car ptr))
)
(setq ptr (cdr ptr)))
) )
(defun d-speedbar ()
(interactive)
(block nil
(save-excursion
(copy-face 'font-lock-function-name-face 'd-face-speedbar-highlighted)
(when (get-buffer "*compilation*")
(set-buffer "*compilation*")
(compilation-mode)))
(when (eq major-mode 'fundamental-mode)
)
(when (or (eq major-mode 'grep-mode)
(eq major-mode 'help-mode)
(eq major-mode 'occur-mode)
(eq major-mode 'debugger-mode)
(eq major-mode 'Buffer-menu-mode)
(eq major-mode 'fundamental-mode)
(eq major-mode 'messages-buffer-mode)
(eq major-mode 'minibuffer-inactive-mode)
(eq major-mode 'electric-buffer-menu-mode))
(return nil))
(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 count)
(setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
(if a
(progn
(setq speedbar-buf-name (nth 1 a))
(d-assert (boundp 'speedbar-buf-name))
(d-assert speedbar-buf-name)
(d-assert (stringp speedbar-buf-name))
(if (or (not (get-buffer speedbar-buf-name))
(not (buffer-live-p (get-buffer speedbar-buf-name))))
(setq speedbar-buf-name (d-speedbar--get-latest-speedbar-buffer)))
(setq speedbar-window (nth 2 a))
(d-assert (boundp 'speedbar-window))
(d-speedbar--set-window-size)
(d-assert (boundp 'd-window-size))
(when d-window-size
(d-assert d-window-size)
(d-assert (integerp d-window-size))
(when (or (not (boundp 'speedbar-buf-name))
(not (get-buffer speedbar-buf-name))
(not (buffer-live-p (get-buffer speedbar-buf-name))))
(set-buffer (generate-new-buffer speedbar-buf-name)))
(when (and (or (not (boundp 'speedbar-window))
(not speedbar-window)
(not (window-live-p speedbar-window)))
(or (not (boundp 'speedbar-buf-name))
(not (stringp speedbar-buf-name))
(not (get-buffer speedbar-buf-name))
(not (buffer-live-p (get-buffer speedbar-buf-name))))
(= (count-windows nil) 1))
(setq speedbar-window (split-window-right (- d-window-size)))
(progn
(other-window 1)
(d-assert (get-buffer speedbar-buf-name))
(set-window-buffer (selected-window)
(get-buffer speedbar-buf-name)
'KEEP-MARGINS)
(other-window 1))))
)
(progn
(progn
(d-assert (boundp 'speedbar-window))
(d-assert (boundp 'speedbar-buf-name))
(d-assert (stringp speedbar-buf-name))
(d-assert (buffer-live-p (get-buffer speedbar-buf-name))))
(when (or (not (boundp 'speedbar-buf-name))
(not (get-buffer speedbar-buf-name))
(not (buffer-live-p (get-buffer speedbar-buf-name))))
(set-buffer (generate-new-buffer speedbar-buf-name)))
(when (and (= (count-windows nil) 1)
(or (not speedbar-window)
(not (windowp speedbar-window))
(not (window-live-p speedbar-window)))
(or (not speedbar-buf-name)
(not (buffer-live-p (get-buffer speedbar-buf-name)))))
(setq speedbar-window (split-window-right (- d-window-size)))
(progn
(other-window 1)
(set-window-buffer (selected-window) speedbar-buf-name 'KEEP-MARGINS)
(other-window 1))
)
(d-debug "Frank Sinatra / You're Getting to be a habit with me")
(d-assert (windowp speedbar-window))
(d-assert (window-live-p speedbar-window))
(d-assert (boundp 'speedbar-buf-name))
(d-assert speedbar-buf-name)
(d-assert (stringp speedbar-buf-name))
(d-assert (buffer-live-p (get-buffer speedbar-buf-name)))
))
(d-quote
when (not (buffer-live-p (get-buffer speedbar-buf-name)))
(sit-and-message 1 (format "(not (buffer-live-p (get-buffer %s)))" speedbar-buf-name))
(setq speedbar-buf-name (d-speedbar--get-latest-speedbar-buffer))
(d-assert (boundp 'speedbar-buf-name))
(d-assert speedbar-buf-name)
(d-assert (stringp speedbar-buf-name))
(d-assert (buffer-live-p (get-buffer speedbar-buf-name)))
(setq speedbar-window (get-buffer-window speedbar-buf-name (selected-frame)))
(d-speedbar--set-window-size)
(when (and (or (not (boundp 'speedbar-window))
(not speedbar-window)
(not (window-live-p speedbar-window)))
(= (count-windows nil) 1))
(setq speedbar-window (split-window-right (- d-window-size)))
(other-window 1)
(set-window-buffer (selected-window) speedbar-buf-name 'KEEP-MARGINS)
(other-window 1)
)
(d-assert (boundp 'speedbar-window))
(d-assert speedbar-window)
(d-assert (windowp speedbar-window))
(d-assert (window-live-p speedbar-window))
(when (or (not speedbar-window)
(not (window-live-p speedbar-window)))
(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))
))
----------------------------------------------------- (setq new-buf speedbar-buf-name)
(setq b new-buf)
(d-assert new-buf)
(d-assert (and 'blind-man (stringp new-buf)))
(unwind-protect
(save-excursion
(d-delete-speedbar-window)
(setq old-buf (d-speedbar--get-old-buffer))
(set-buffer old-buf)
------------------------------------------------------- (d-assert new-buf)
(set-buffer new-buf)
(kill-local-variable 'd-speedbar-mode)
(setq-default d-speedbar-mode t)
(if (string-match d-speedbar--regexp-name new-buf)
(read-only-mode 1)
)
(d-assert d-speedbar-mode)
(when prefs-davins-keybindings-online-p
(use-local-map d-speedbar-map)
(local-set-key [(return)] 'd-speedbar--goto-method))
(progn
(set-buffer old-buf)
(when (not (or (eq major-mode 'grep-mode)
(eq major-mode 'help-mode)
(eq major-mode 'occur-mode)
(eq major-mode 'debugger-mode)
(eq major-mode 'fundamental-mode)
(eq major-mode 'messages-buffer-mode)
(eq major-mode 'minibuffer-inactive-mode)
(eq major-mode 'electric-buffer-menu-mode)))
(setq-default *major-mode* major-mode))
)
(kill-local-variable '*old-major-mode*)
(setq-default *old-major-mode* major-mode)
(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))
(d-assert old-buf)
(d-assert new-buf)
(when d-window-size
(cond
------------------------------------------------------ ((eq *major-mode* 'lisp++-mode)
(setq meth-regexp d-speedbar--lisp++-meth-regexp)
(setq class-regexp d-speedbar--lisp++-class-regexp)
(d-namespace--insert-all-methods 1 'identity meth-regexp class-regexp)
)
-------------------------------------------------- ((eq *major-mode* 'dired-mode)
(setq list2 (d-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 (d-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
(propertize user-init-file
'mouse-face 'highlight
'help-echo "mouse-2: visit this file"
'follow-link t
'keymap
(let ((map (make-sparse-keymap))
(cmd (lambda ()
(interactive)
(d-speedbar--goto-method))))
(define-key map [mouse-2] cmd)
(define-key map [?\C-m] cmd)
map))
"\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))
------------------------------------------------------------------ (let (i type name args)
(while (re-search-forward "(\\(d-defmacro\\|defun\\|defmacro\\|defadvice\\)[ \t\r\n]+\\([-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))
)) (save-excursion
(set-buffer new-buf)
(read-only-mode -1)
(erase-buffer)
(setq list (nreverse list))
(setq ptr list)
(while ptr
(insert
(propertize (car ptr)
'mouse-face 'highlight
'help-echo "mouse-2: visit this file"
'follow-link t
'keymap
(let ((map (make-sparse-keymap))
(cmd (lambda ()
(interactive)
(d-speedbar--goto-method))))
(define-key map [mouse-2] cmd)
(define-key map [?\C-m] cmd)
map))
"\n")
(setq ptr (cdr ptr)))
) ) ------------------------------------------------------ ((eq *major-mode* 'java-mode)
(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)
)
--------------------------------------------------- ((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)
(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)
) ------------------------------------------------------ ((eq *major-mode* 'c2j-mode)
(setq truncate-lines t)
(while (re-search-forward "^[ \t]*\\([0-9]+\\) \\(strobe \".*\";\\|label function_\\([a-zA-Z0-9_]+\\);\\|nop beg_[a-z]*;\\|nop end_[a-z]*\\)\\(//.*$\\)?" nil t)
(setq list (cons (list ""
(concat (if (and (match-beginning 1) (match-end 1))
(buffer-substring-no-properties (match-beginning 1) (match-end 1)))
" "
(if (and (match-beginning 2) (match-end 2))
(buffer-substring-no-properties (match-beginning 2) (match-end 2)))
(if (and (match-beginning 4) (match-end 4))
(buffer-substring-no-properties (match-beginning 4) (match-end 4))))
"") list))
(if (eq (caddar list) nil)
(setcar (cdar list) (concat (cadar list) "\n"))))
(setq list (nreverse list))
(save-excursion
(set-buffer new-buf)
(read-only-mode -1)
(erase-buffer)
(setq ptr list)
(while ptr
(if (consp (car ptr))
(insert (cadar ptr) "\n")
(insert (car ptr) "\n"))
(setq ptr (cdr ptr)))
)
) ------------------------------------------------------ ((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\\|Compilation\\)\\( .*$\\)")
(while (re-search-forward (concat "\\(" s1 "\\|" s2 "\\)") nil t)
(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)))
) ) ------------------------------------------------------ ((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)))
(setq list (nreverse list))
(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* 'makefile-mode)
(while (re-search-forward "^\\(%\\.[a-z+]+: %\\.[a-z+]+.*\\|[-a-z0-9+]+:.*\\)[ \t]*$" nil t)
(setq list (cons (buffer-substring-no-properties
(match-beginning 1)
(match-end 1))
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")
(d-quote
save-excursion
(forward-line -1)
(put-text-property (point-at-bol) (point-at-eol) 'face 'default))
(setq ptr (cdr ptr)))
) ) ((eq *major-mode* 'text-mode)
(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)))
) ) ------------------------------------------------------ ) ) ) ) ) (d-assert new-buf)
(when (and (boundp 'd-window-size) d-window-size)
(cond
((fboundp 'split-window-right)
(setq speedbar-window (split-window-right (- d-window-size)))
)
((fboundp 'split-window-horizontally)
(setq speedbar-window (split-window-horizontally (- d-window-size)))
(d-debug "The Jackson Five / Looking Through the Window")
)
(t
(d-debug "Natalie Cole / Almost Like Being in Love")
))
(d-assert new-buf)
(d-assert (window-live-p speedbar-window))
(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)
(d-debug "Natalie Cole / Nature Boy")
(display-buffer-same-window new-buf nil))
(t
(d-debug "Natalie Cole / Too Young")
))
(select-window speedbar-window)
) ----------------------------------------------------------- (when a
(setf (nth 1 a) speedbar-buf-name)
(setf (nth 2 a) speedbar-window)
) (when (not a)
(d-debug "Prince / When the doves cry")
(setq d-frame--buffer-window-correspondence (cons (list (selected-frame)
speedbar-buf-name
speedbar-window)
d-frame--buffer-window-correspondence))) ----------------------------------------------------- (progn
(set-buffer new-buf)
(if (string-match d-speedbar--regexp-name new-buf)
(read-only-mode 1)
)
(goto-char (point-min))
(other-window 1)
)))))
(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
(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))
)
(defun d-speedbar--cull-unused-buffers (b)
(d-assert b)
(d-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 "(eq major-mode 'minibuffer-inactive-mode)=%s"
(eq major-mode 'minibuffer-inactive-mode))
(message "major-mode=%s" major-mode)
)
(when prefs-davins-keybindings-online-p
(global-set-key [f5] 'f5)
)
(defun d-speedbar--set--delete-all ()
(interactive)
(let ((d-message-on t)
(w nil) p1 p2 done a b p)
(when (and (not (eq major-mode 'text-mode))
(not (eq major-mode 'package-mode))
(not (eq major-mode 'minibuffer-inactive-mode))
(not (eq major-mode 'electric-buffer-menu-mode))
(not (d-speedbar--is-speedbar-showing)))
(d-speedbar)
)
(unwind-protect
(save-match-data
(if (string-match d-speedbar--regexp-name (buffer-name))
(progn
(read-only-mode -1)
(set-buffer-modified-p nil)
(setq b (buffer-name))
)
(unwind-protect
(save-window-excursion
(save-excursion
(setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
(d-assert a)
(setq b (nth 1 a))
(setq w (nth 2 a))
(d-assert (boundp 'w))
(d-assert w)
(d-assert (windowp w))
(d-speedbar--set-window-size)
(when (and d-window-size
(or (not w)
(not (window-live-p w))))
(setq w (split-window-right (- d-window-size)))
)
(d-assert (boundp 'b))
(d-assert b)
(d-assert (stringp b))
(d-assert (get-buffer b))
(d-assert (buffer-live-p (get-buffer b)))
(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
(setq b (d-speedbar--get-latest-speedbar-buffer))
(setf (nth 1 a) b)
(setf (nth 2 a) w)
(generate-new-buffer b)
))
(d-assert b)
(d-assert (stringp b))
(d-assert (buffer-live-p (get-buffer b)))
(setq a (assq (selected-frame) d-frame--buffer-window-correspondence))
(if a
(setf (nth 1 a) b))
(setq-default *major-mode* major-mode)
(set-buffer b)
(read-only-mode -1)
(if (and (eobp) (bobp)) (d-speedbar))
(cond
-------------------------------------------- ((eq *major-mode* 'emacs-lisp-mode)
(save-excursion
(setq p (point))
(goto-char (point-min))
(while (not (eobp))
(beginning-of-line)
(setq p1 (point))
(skip-chars-forward "-a-zA-Z0-9_<>!@#$%^&*+")
(setq p2 (point))
(when (not (eq p1 p2))
(put-text-property p1 p2 'face 'default)
)
(forward-line 1))
(d-assert (and 'story-of-bo-diddley p))
)
)
-------------------------------------------- ((eq *major-mode* 'lisp++-mode)
(save-excursion
(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 'red-face))
(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)
)
(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)
)
(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) (match-beginning 1) 'face 'bold)
(put-text-property (match-beginning 1) (point-at-eol) 'face 'fg:lightred)
)
)
)
(save-excursion
(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)
)
)
)
----------------------------------------------- ((eq *major-mode* 'compilation-mode)
(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* 'dired-mode)
(let ((case-fold-search t))
(setq p (point))
(d-speedbar--dired-fontify)
))
-------------------------------------------------- ((eq *major-mode* 'makefile-mode)
(let ((case-fold-search t))
(setq p (point))
(read-only-mode -1)
(while (not (eobp))
(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)
)
(progn
(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))))
-------------------------------------------------- )))))))))
(defun sit-and-message (secs str)
(while (> secs 0)
(message "Pausing for %s seconds... str=(%s)" secs str)
(sit-for 1)
(decf secs))
)
(defun d-speedbar--set--set-current ()
(interactive)
(let ((d-message-on t) p b w a p1 p2 spaces
old-win (debug-on-error t))
(save-match-data
(if (string-match d-speedbar--regexp-name (buffer-name))
(progn
(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))
(if (not (get-buffer b))
(generate-new-buffer b))
(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 (or (eq major-mode 'grep-mode)
(eq major-mode 'help-mode)
(eq major-mode 'occur-mode)
(eq major-mode 'debugger-mode)
(eq major-mode 'fundamental-mode)
(eq major-mode 'messages-buffer-mode)
(eq major-mode 'minibuffer-inactive-mode)
(eq major-mode 'electric-buffer-menu-mode)))
(setq-default *major-mode* major-mode))
(cond
------------------------------------------------ ((eq *major-mode* 'lisp++-mode)
(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 'identity meth-regexp class-regexp)
)
------------------------------------------------ ((eq *major-mode* 'emacs-lisp-mode)
(save-excursion
(setq-default cfm--name-lisp (d-trim-string (cfm--get-defun))))
(when (null cfm--name-lisp)
(setq cfm--name-lisp ""))
(if (not cfm--name-lisp)
(save-excursion
(forward-line -1)
(setq-default cfm--name-lisp (d-trim-string (cfm--get-defun)))))
(when (not (string= cfm--name-lisp ""))
(set-buffer b)
(goto-char (point-min))
(setq cfm--method-lisp (concat "^" (regexp-quote cfm--name-lisp) "("))
(setq cfm--method-2-lisp cfm--method-lisp)
(when (re-search-forward cfm--method-lisp nil t)
(beginning-of-line)
(setq p1 (point))
(skip-chars-forward "-a-zA-Z0-9_ +<>/=:!&*")
(setq p2 (point))
(setq d-str (buffer-substring-no-properties p1 p2))
(when (and (not (eq p1 p2))
(not (save-excursion
(beginning-of-line)
(bobp))))
(put-text-property p1 p2 'face 'd-face-speedbar-highlighted)
)
(beginning-of-line)
(setq p (point))
))
)
------------------------------------------------ ((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))
(d-assert p)
) ------------------------------------------------ ((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))
(d-assert p)
)
----------------------------------------------- ((or (eq *major-mode* 'c-mode)
(eq *major-mode* 'c++-mode))
(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)"))
)
------------------------------------------------ ((eq *major-mode* 'php-mode)
(let ((debug-on-error t))
(setq pair (cfm--get-php-function))
(when pair
(setq cfm--name (car pair))
(setq cfm--args (cdr pair))
(when (not (string= cfm--name ""))
(set-buffer b)
(goto-char (point-min))
(setq cfm--method (concat "^" cfm--name "[ \t]*" (regexp-quote cfm--args)))
(if (not (re-search-forward cfm--method nil t))
(sit-and-message 5 (format "Search failed: %s" cfm--method))
(re-search-backward "(")
(setq p1 (point))
(skip-chars-backward "a-zA-Z0-9_")
(setq p2 (point))
(put-text-property p2 p1 'face 'd-face-speedbar-highlighted)
)
(setq p (point))
))))
------------------------------------------------ ((eq *major-mode* 'compilation-mode)
(let (ptr list)
(setq list (d-speedbar--get-compilation-strobes))
(setq ptr list)
(setq cfm--name-2 (cfm--get-compilation-strobe))
(when (and (not (string= cfm--name-2 "")) cfm--name-2)
(set-buffer b)
(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)
(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))
))
)
------------------------------------------------ ((eq *major-mode* 'c2j-mode)
(save-excursion
(beginning-of-line)
(when (or
(looking-at (concat "^[ \t]*\\([0-9]+\\) \\(strobe \"[a-za-Z0-9_]+\";\\|label function_\\([a-zA-Z0-9_]+\\)\\|nop \\(beg_\\|end_\\)[a-zA-Z0-9_]*;\\)"))
(re-search-backward (concat "^[ \t]*\\([0-9]+\\) \\(strobe \"[a-zA-Z0-9_]+\";\\|label function_\\([a-zA-Z0-9_]+\\)\\|nop \\(beg_\\|end_\\)[a-zA-Z0-9_]*;\\)") nil t))
(setq cfm--method (concat (buffer-substring-no-properties (match-beginning 1) (match-end 1))
" "
(if (and (match-beginning 2) (match-end 2))
(buffer-substring-no-properties (match-beginning 2) (match-end 2))
)))
(if (eq major-mode 'c2j-mode)
(setq cfm--method--debugging cfm--method))
(let ((d-message-on t))
(set-buffer b)
(goto-char (point-min))
(if (not (re-search-forward cfm--method nil t))
(sit-and-message 1 (format "smeg 3 not found cfm--method=%s" cfm--method))
(put-text-property (point-at-bol)
(point-at-eol)
'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))) "/?$"))
(set-buffer b)
(goto-char (point-min))
(if (not (re-search-forward cfm--method nil t))
t (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))
(if (not (string-match "^\\(%\\.[a-z+]+: %\\.[a-z+]+.*\\|[-a-z0-9+]+:.*\\)[ \t]*$" line))
t (setq cfm--method (concat "^" (substring line
(match-beginning 1)
(match-end 1)) "[ \t]*$"))
(setq d-doggy cfm--method)
(set-buffer b)
(goto-char (point-min))
(if (not (re-search-forward cfm--method nil t))
t (d-speedbar--set--delete-all)
(put-text-property (point-at-bol)
(point-at-eol)
'face
'd-face-speedbar-highlighted))
(setq p (point))
))
------------------------------------------------ ))) (when (or (not (string= d-old-method cfm--method)) d-all-smegs)
(unwind-protect
(progn
(setq old-win (selected-window))
(when d-window-size
(d-assert d-window-size)
(d-assert (integerp d-window-size))
(when (or (not w) (not (windowp w)) (not (window-live-p w)))
(when (and d-window-size
(not (eq major-mode 'minibuffer-inactive-mode))
(not (eq major-mode 'electric-buffer-menu-mode)))
(cond
((fboundp 'split-window-right)
(setq w (split-window-right (- d-window-size))))
((fboundp 'split-window-horizontally)
(setq w (split-window-horizontally (- d-window-size)))
))
(setf (nth 2 a) w))
))
(if (not p) (d-debug "(p is nil)"))
(if (not w) (d-debug "(w is nil)"))
(if (not (windowp w)) (d-debug "(not windowp w)"))
(when (window-live-p w)
(select-window w)
(set-buffer (window-buffer))
(goto-char p)
(beginning-of-line)
(recenter)
(set-buffer-modified-p nil)
))
(select-window old-win)) )
(setq d-old-method cfm--method)
) ))) )
(setq d-kkk nil)
(defun d-speedbar--widen ()
)
(defun d-speedbar--turn-on-timers ()
(setq d-speedbar--timer-2 (run-with-idle-timer 2 t 'd-speedbar--set--delete-all))
(setq d-speedbar--timer-3 (run-with-idle-timer 2.2 t 'd-speedbar--set--set-current))
)
(when (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--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)
(setq b (nth 1 (assq (selected-frame) d-frame--buffer-window-correspondence)))
(when (or (not b) (not (stringp b)))
(setq b (d-speedbar--get-latest-speedbar-buffer))
(generate-new-buffer b))
(if (string= (buffer-name (current-buffer)) (buffer-name (get-buffer b)))
(unwind-protect
(progn
(setq old-buf (d-speedbar--get-old-buffer))
(set-buffer b)
(read-only-mode -1)
(cond
------------------------------------------------------ ((eq *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)
)
------------------------------------------------------ ((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)
(eq *major-mode* 'lisp++-mode))
(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 (if (and (match-beginning 2) (match-end 2))
(buffer-substring-no-properties (match-beginning 2) (match-end 2))
""))
(other-window 1)
(goto-char (point-min))
(re-search-forward (concat "(\\(d-defmacro\\|defun\\|defmacro\\|defadvice\\)[ \t\r\n]*" (regexp-quote name) "[ \t]+" (regexp-quote args)))
(beginning-of-line)
(push-mark)
))
-------------------------------------------------- ((eq *major-mode* 'makefile-mode)
(beginning-of-line)
(when (looking-at "^\\(%\\.[a-z+]+: %\\.[a-z+]+.*\\|[-a-z0-9+]+:.*\\)[ \t]*$")
(setq name (concat "^" (regexp-quote (buffer-substring-no-properties
(match-beginning 1)
(match-end 1)))
"[ \t]*$"))
(other-window 1)
(goto-char (point-min))
(while (re-search-forward name nil t)
t)
(beginning-of-line)
(push-mark)
(d-speedbar--set--delete-all)
))
------------------------------------------------------ ((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))
(d-beeps "smeg 10 line=%s" line))
(beginning-of-line)
(push-mark)
)
-------------------------------------------------- ))
(progn
(set-buffer b)
(recenter)
(set-buffer old-buf)
(beginning-of-line)
(recenter)
))
))))
(defadvice d-compilation-finish-function (after d-speedbar activate)
(d-speedbar))
(defadvice d-dired-advertised-find-file (after d-speedbar activate)
(d-speedbar))
(defadvice d-find-file (around d-speedbar activate)
(unwind-protect
ad-do-it
(if (string-match d-speedbar--regexp-name (buffer-name (current-buffer)))
(kill-buffer))
))
(defadvice find-file (after d-speedbar activate)
(d-speedbar))
(when prefs-davins-keybindings-online-p
(global-set-key [f1] 'info)
)
(defadvice info (before d-speedbar activate)
(delete-other-windows))
(when prefs-davins-keybindings-online-p
(global-set-key [f2] 'd-f2)
)
(defadvice d-f2 (after d-speedbar activate)
(d-speedbar))
(when prefs-davins-keybindings-online-p
(global-set-key [f3] 'd-f3)
)
(defadvice d-f3 (after d-speedbar activate)
(d-speedbar))
(when prefs-davins-keybindings-online-p
(global-set-key [f4] 'd-f4)
)
(defadvice d-f4 (after d-speedbar activate)
(if (fboundp 'd-speedbar-new)
(d-speedbar-new)
(if (fboundp 'd-speedbar)
(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))
(when prefs-davins-keybindings-online-p
(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))
(switch-to-buffer "*grep*")
(d-speedbar)))
(defadvice compile (before d-speedbar activate)
(let ((d nil))
(when (get-buffer "*compilation*")
(switch-to-buffer "*compilation*"))
(d-speedbar)))
(when prefs-davins-keybindings-online-p
(global-set-key "\C-hf" 'describe-function)
)
(defadvice Info-exit (after d-speedbar activate)
(d-speedbar))
(when prefs-davins-keybindings-online-p
(global-set-key "\M-$" 'ispell-word-outer)
)
(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
)
(when prefs-davins-keybindings-online-p
)
(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)
)
(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))
(setq d-foo nil)
(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)))))
(setq d-foo t)
(switch-to-buffer (car ptr))
(setq d-foo nil)
(setq ptr nil))
(setq ptr (cdr ptr))))))
(defadvice switch-to-buffer (around d-speedbar activate)
ad-do-it
(when (not d-foo)
(delete-other-windows)
(d-speedbar))
)
(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
(if (string-match d-speedbar--regexp-name
(buffer-name (current-buffer)))
(kill-buffer 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))
)
)
(defun kp-enter ()
(interactive)
(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")
)
(when prefs-davins-keybindings-online-p
(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))
(d-speedbar)
)
(when prefs-davins-keybindings-online-p
(global-set-key "\M-%" 'query-replace)
)
(d-quote 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
)
(defadvice describe-syntax (around d-speedbar activate)
(if (> (count-windows) 1)
(delete-other-windows))
ad-do-it)
(progn
(defvar d-speedbar-map (make-keymap))
(defvar d-speedbar--format-name " *d-%d*")
(defvar d-speedbar--regexp-name "^ \\*d-\\([0-9]+\\)\\*$")
(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)
)
(provide 'd-speedbar)
