---
(require 'early-bindings)
(require 'jtw-build-java)
(make-variable-buffer-local 'cfm--class::method)
(defun cfm--announce ()
(interactive)
(cfm--set)
(cond
((not cfm--class::method)
(message "Class::method = nil"))
((eq (aref cfm--class::method 0) ? )
(message "Class::method =%s" cfm--class::method))
(t
(message "Class::method = %s" cfm--class::method)))
)
(progn
(kill-local-variable 'cfm--new)
(setq-default cfm--new "")
)
(defun cfm--outer-get-namespace::class::method ()
(let* ((namespace (cfm--get-namespace))
(class (cfm--get-class (if namespace 1 0)))
(result nil)
(method nil))
(if class
(progn
(setq method (or (nth 0 (cfm--get-method (if namespace 2 1))) "<No Method>"))
(setq result (concat (if namespace (concat namespace "::") "") class "::" method)))
(setq result (concat "::" (if namespace (concat namespace "::") "")
(cfm--get-class::method (if namespace 1 0)))))
result
))
(defun cfm--set ()
(interactive)
(let (d-message-on)
(setq d-message-on t)
(save-match-data
(save-excursion
(cond
((or (eq major-mode 'c-mode)
(eq major-mode 'c++-mode)
(eq major-mode 'java-mode))
(if (and (boundp 'lisp++) lisp++)
(let ((class (cfm--get-lisp++-class)))
(if class
(let ((method (or (cfm--get-lisp++-method) "<No Method>")))
(setq cfm--class::method (concat " " class "::" method)))
(setq cfm--class::method (concat " ::" (cfm--get-lisp++-function))))
(force-mode-line-update) )
(setq cfm--class::method (concat " " (cfm--outer-get-namespace::class::method)))
(force-mode-line-update) ))
((eq major-mode 'emacs-lisp-mode)
(setq cfm--class::method (concat " " (cfm--get-defun)))
(force-mode-line-update)
)
((eq major-mode 'php-mode)
(setq cfm--class::method (concat " " (car (cfm--get-php-function))))
(force-mode-line-update))
((eq major-mode 'compilation-mode)
(setq cfm--class::method (concat " " (cfm--get-compilation-strobe)))
(force-mode-line-update))
(t
(setq cfm--class::method nil)))
))
(setq d-message-on t)
))
(defun cfm--get-defun ()
(save-excursion
(let ((p (point)) (r nil) (function nil) str)
(setq str "^[ \t\r\n]*(\\(d-defmacro\\|defun\\|defmacro\\|defadvice\\)[ \t\r\n]+\\([-a-zA-Z0-9_+<>/=:!*]+\\)[ \t]*\\(([^()]*)\\)?")
(cond
((save-excursion
(beginning-of-line)
(looking-at str))
(setq function (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
function)
((re-search-backward str nil t)
(setq function (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
(if (not (looking-at "("))
(re-search-backward "(" nil t))
(condition-case err
(forward-sexp 1)
(error nil))
(d-trim-string function))))))
(defvar cfm--is-on nil
"Set this variable to nil to disable the display of the current
function/method in the mode line. This can be useful if
d-speedbar has been activated.")
(when cfm--is-on
(setq cfm--timer-1 (run-with-idle-timer 2.0 t 'cfm--set))
(setq minor-mode-alist (cons '(t cfm--class::method) minor-mode-alist))
)
(defun cfm--cancel-timers ()
(cancel-timer cfm--timer-1)
)
(defun cfm--inside (orig i)
(block nil
(let (str p)
(setq p (point))
(save-excursion
(save-match-data
(setq str (concat "^" (make-string (* c-basic-offset i) ? ) "{"))
(when (save-excursion
(forward-line 1)
(beginning-of-line)
(looking-at str))
(skip-chars-forward " \t\r\n")
(assert 'living-in-the-city (looking-at "{"))
(condition-case nil
(forward-sexp 1)
(error nil))
(if (> (point) orig)
(return t)
(when (save-excursion
(beginning-of-line)
(looking-at str))
(skip-chars-forward " \t\r\n")
(assert (and 'too-high (looking-at "{")))
(condition-case nil
(forward-sexp 1)
(error nil))
(if (> (point) orig)
(return t)
------------------------------------------------- (while (warn--re-search-backward--no-comments-no-strings str nil t)
(save-excursion
(skip-chars-forward " \t\r\n")
(assert (and 'superstition (looking-at "{")))
(condition-case nil
(forward-sexp 1)
(error nil))
(if (> (point) orig) (return t))))
)
)
)
)
)
)
(goto-char p)
)))
(defun cfm--get-namespace ()
(let (namespace p)
(save-excursion
(setq p (point))
(beginning-of-line)
(if (looking-at "^namespace \\([a-zA-Z0-9_]+\\)")
(setq namespace (buffer-substring-no-properties
(match-beginning 1)
(match-end 1)))
(when (re-search-backward "^namespace \\([a-zA-Z0-9_]+\\)" nil t)
(setq namespace (buffer-substring-no-properties
(match-beginning 1)
(match-end 1)))
(forward-line 1)
(beginning-of-line)
(skip-chars-forward " \t\r\n")
(when (looking-at "{")
(condition-case nil
(forward-sexp)
(error nil))
(if (> (point) p)
namespace)))))))
(defun cfm--get-class (i)
(block nil
(let ((case-fold-search nil)
(str nil)
(orig nil)
(class nil))
(save-excursion
(setq orig (point))
(setq str (concat "^"
(make-string (* i c-basic-offset) ? )
"\\([A-Za-z]+[ \t]+\\)*\\(class\\|interface\\)[ \t]"))
(if (save-excursion
(beginning-of-line)
(looking-at str))
(progn
(beginning-of-line)
(assert (and 1 (re-search-forward "\\<\\(class\\|interface\\)\\>" (point-at-eol) t)))
(skip-chars-forward " \t")
(setq class (buffer-substring-no-properties (point) (save-excursion
(skip-chars-forward "A-Za-z0-9_")
(point))))
(beginning-of-line)
(forward-line 1)
(skip-chars-forward " \t")
(if (and (looking-at "{")
(cfm--inside orig i))
(return class)))
(goto-char orig)
(when (re-search-backward str nil t)
(beginning-of-line)
(assert (and 1 (re-search-forward "\\<\\(class\\|interface\\)\\>" (point-at-eol) t)))
(skip-chars-forward " \t")
(setq class (buffer-substring-no-properties (point) (save-excursion
(skip-chars-forward "A-Za-z0-9_")
(point))))
(beginning-of-line)
(forward-line 1)
(skip-chars-forward " \t")
(if (and (looking-at "{")
(cfm--inside orig i))
(d-trim-string class)
""))) ))))
(defun cfm--get-lisp++-class ()
(save-excursion
(let (class p)
(setq p (point))
(when (re-search-backward "^(cclass \\([a-zA-Z0-9_]*\\)" nil t)
(setq class (buffer-substring-no-properties
(match-beginning 1)
(match-end 1)))
(beginning-of-line)
(forward-sexp 1)
(if (> (point) p) (d-trim-string class))))))
(defun cfm--get-lisp++-method ()
(save-excursion
(let (method p)
(setq p (point))
(when (re-search-backward (concat "^ (\\(cmethod\\|"
"c-static-method\\|"
"c-constructor-method\\|"
"c-destructor-method\\|"
"cfriend\\)") nil t)
(when (re-search-forward "(cname \\(~?[a-zA-Z_][a-zA-Z0-9_]*\\))"
(point-at-eol) t)
(setq method (buffer-substring-no-properties
(match-beginning 1)
(match-end 1)))
(beginning-of-line)
(forward-sexp 1)
(if (> (point) p) (d-trim-string method)))))))
(defun cfm--get-lisp++-function ()
(save-excursion
(let (name p)
(setq p (point))
(when (re-search-backward "^(cfunction" nil t)
(when (re-search-forward "(cname \\([a-z_][a-zA-Z0-9_]+\\))"
(point-at-eol) t)
(setq name (buffer-substring-no-properties
(match-beginning 1)
(match-end 1)))
(beginning-of-line)
(forward-sexp 1)
(if (> (point) p) (d-trim-string name)))))))
(defun cfm--get-jtw-decl ()
(let (p p1 p2 p3
decl1 name1
decl2 name2
decl3 name3
decl name
str1 str2 str3)
(save-match-data
(save-excursion
(setq decl "")
(setq name "")
(setq str1 (concat "^[ \t]*\\(public +\\|private +\\|protected +\\|abstract +\\|final +\\)*"
"\\(function\\|property\\|method\\|classVar\\)"
"[ \t]+[A-Za-z][a-zA-Z0-9_<>]+[][]*"
"[ \t]+\\([a-z][a-zA-Z0-9_]*\\)[ \t]*[()=;]"))
(setq str2 (concat "^[ \t]*\\(public +\\|private +\\|protected +\\|\\)\\(constructor\\)"
"[ \t]+\\([A-Z][a-zA-Z0-9_]*\\)("))
(setq str3 "^[ \t]*\\(beginMain\\>\\)")
(beginning-of-line)
(setq p (point))
------------------------------------------------------------ (goto-char p)
(save-excursion
(setq p1 (or (if (looking-at str1) (point))
(re-search-backward str1 nil t)))
(when p1
(setq decl1 (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
(setq name1 (buffer-substring-no-properties (match-beginning 3) (match-end 3))))
)
(save-excursion
(setq p1-a (re-search-backward "^end[ \t\r\n]" nil t))
)
(if (and p1-a p1 (> p1-a p1))
(setq p1 nil))
------------------------------------------------------------ (goto-char p)
(setq p2 (or (if (looking-at str2) (point))
(re-search-backward str2 nil t)))
(when p2
(setq decl2 (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
(setq name2 (buffer-substring-no-properties (match-beginning 3) (match-end 3))))
------------------------------------------------------------ (goto-char p)
(setq p3 (or (if (looking-at str3) (point))
(re-search-backward str3 nil t)))
(when p3
(setq decl3 "")
(setq name3 (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
------------------------------------------------------------ (when (or p1 p2 p3)
(when (not p1) (setq p1 (point-min)))
(when (not p2) (setq p2 (point-min)))
(when (not p3) (setq p3 (point-min)))
(cond
((and (>= p1 p2) (>= p1 p3))
(setq decl decl1)
(setq name name1))
((and (>= p2 p1) (>= p2 p3))
(setq decl decl2)
(setq name name2))
((and (>= p3 p1) (>= p3 p2))
(setq decl decl3)
(setq name name3))
(t
(debug "Should never happen"))
))
(cons (d-trim-string decl) (d-trim-string name))
))))
(defun cfm--get-jtw-class-or-interface ()
(save-excursion
(let (class-or-interface name str)
(setq str "\\<\\(class +\\|interface +\\)\\([A-Z][a-zA-Z0-9_]*\\)")
(when (or (looking-at str)
(re-search-backward str nil t))
(setq class-or-interface (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
(setq name (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
(list nil (d-trim-string name) (d-trim-string class-or-interface))))))
(defun cfm--get-method (i)
"Gets current method in current buffer"
(block nil
(let ((case-fold-search nil)
(p0 nil)
(p1 nil)
(p2 nil)
(p3 nil)
(p4 nil)
(bra nil)
(end nil)
(str nil)
(args nil)
(done nil)
(name nil)
(orig nil)
(found nil)
(result nil)
(class-name nil)
(class-decl nil)
(was-abstract-method nil)
(was-all-on-one-line nil)
(spaces (make-string (* i c-basic-offset) ? ))
)
(save-match-data
(save-excursion
(setq p0 (point)) (setq search-str "^[ \t]*\\(public +\\|abstract +\\)*\\(class +\\|interface +\\)\\([A-Z][a-zA-Z0-9_]*\\)[ \t\r\n]")
(cond
((save-excursion
(beginning-of-line)
(looking-at search-str))
(setq class-decl (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
(setq class-name (buffer-substring-no-properties (match-beginning 3) (match-end 3)))
(return (list (d-trim-string class-decl) (d-trim-string class-name) 'Sinner-man))
)
((re-search-backward search-str nil t)
(setq class-decl (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
(setq class-name (buffer-substring-no-properties (match-beginning 3) (match-end 3)))
(setq found t)
)
)
(progn
(setq found nil)
(forward-line 1)
(beginning-of-line)
(skip-chars-forward " \t\r\n")
(setq p1 (point))
(when (and 456 (looking-at "{"))
(condition-case err
(forward-sexp 1)
(error nil))
(setq p2 (point))
(goto-char p0)))
(setq str (concat "^" spaces "[a-z][-a-zA-Z0-9_ .:!@#$%^&*/+<>]*[ \t]+\\([a-zA-Z0-9_:]+\\)\\(([^()]*)\\)"))
(when (save-excursion
(beginning-of-line)
(looking-at str))
(setq found t))
(when (re-search-backward str nil t)
(setq found t))
--------------------------------------------------------- (when found
(setq p (point))
(goto-char p0)
(beginning-of-line)
(setq orig (point))
(setq found nil)
(setq name nil)
(setq args nil)
(cond
------------------------------------------------------ ((save-excursion
(beginning-of-line)
(looking-at str))
(setq name (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
(setq args (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
(end-of-line)
(forward-line 1)
(beginning-of-line)
(if (not (looking-at "[ \t]*{"))
(return (list name (concat args ";") 'whistle)))
(setq p (point))
(setq found t))
------------------------------------------------------ ((re-search-backward str nil 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)))
(search-forward "{" (save-excursion
(forward-line 1)
(point-at-eol)) t)
(forward-char -1)
(setq p (point))
(setq found t))
------------------------------------------------------ )
------------------------------------------------------- (when found
(goto-char p)
(skip-chars-forward " \t\r\n")
(when (and 7 (looking-at "{"))
(setq bra (point))
(when (save-excursion
(forward-char 1)
(cfm--inside (point) 1))
(beginning-of-line)
(forward-line -1)
(search-forward "(" bra)
(forward-char -1)
(setq end (point))
(if (search-backward "operator" (point-at-bol) t)
(skip-chars-backward "a-z") (search-forward "(" (point-at-eol))
(save-excursion
(forward-char -1)
(forward-sexp 1)
(setq p2 (point))
(if (not args)
(setq args (buffer-substring-no-properties end p2))))
(beginning-of-line)
(setq p2 (point))
(skip-chars-forward "a-zA-Z0-9_:"))
(if (not name)
(setq name (buffer-substring-no-properties p2 (point))))
)))
(setq result (list (d-trim-string name)
(d-trim-string args)
(if class-decl (d-trim-string class-decl) "")
(if class-name (d-trim-string class-name) "")))
)
)
)
result
) ) )
(defun cfm--get-cfunction ()
(let ((str "^(cfunction (cret [a-zA-Z0-9_]+[&*]*) (cname \\([a-zA-Z0-9_]+\\)")
(result nil))
(save-excursion
(beginning-of-line)
(if (or (looking-at str)
(re-search-backward str nil t))
(setq result (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
(d-trim-string result))))
(defun cfm--get-class::method (i)
(let ((case-fold-search nil)
(bra nil)
(orig (point))
(end nil)
)
(save-match-data
(save-excursion
(when (and (re-search-backward (concat "^"
(make-string
(* i c-basic-offset) ? )
"{")
nil
t) (cfm--inside orig i))
(setq bra (point))
(skip-chars-forward " \t")
(assert (and 789 (looking-at "{")))
(forward-line -1)
(when (re-search-forward "(" bra t)
(forward-char -1)
(setq end (point))
(skip-chars-backward "_a-zA-Z0-9")
(if (d-delta-looking-at "~" -1)
(forward-char -1))
(if (d-delta-looking-at "::" -2)
(progn
(forward-char -2)
(skip-chars-backward "_a-zA-Z0-9")
(buffer-substring-no-properties (point) end))
(d-trim-string (buffer-substring-no-properties (point) end)))))))))
(defun cfm--get-php-function ()
(save-excursion
(save-match-data
(let (name)
(when (or (save-excursion
(beginning-of-line)
(looking-at "^[ \t]*function \\([a-zA-Z_][a-zA-Z0-9_]*\\)[ \t]*\\(([^()]*)\\)"))
(re-search-backward "^[ \t]*function \\([a-zA-Z_][a-zA-Z0-9_]*\\)[ \t]*\\(([^()]*)\\)" nil 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)))
(cons (d-trim-string name) (d-trim-string args)))))))
(defun cfm--get-compilation-strobe ()
(save-excursion
(save-match-data
(when (save-excursion
(forward-line 1)
(re-search-backward "\\*\\*\\*\\* STROBE=\"[a-zA-Z0-9]*\"" nil t))
(d-trim-string (buffer-substring-no-properties (match-beginning 0) (match-end 0)))))))
(provide 'cfm)