EmacsAssist

[Anton V. Belyaev]

Remember VisualAssist for VisualStudio? If you lack its convinient M-o,
M-m features in Emacs, EmacsAssist is for you. EmacsAssist is a C/C++
code navigator, allowing rapid navigation between class methods and
switch between header and body files (.h and .cpp).

Comments, critics, feature requests are welcome.
I am beginner in eLisp, so I would highly appreciate comments related
to Elisp usage and Emacs API usage (for example if something is written
ugly from point of view of experienced Elisp programmer).

;;; eassist.el --- EmacsAssist, C/C++ code navigator.

;; Copyright (C) 2006 Anton V. Belyaev
;; Author: Anton V. Belyaev <anton.belyaev at the gmail.com>

;; This file is *NOT* part of GNU Emacs.

;; 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 2 of
;; the License, or (at your option) any later version.

;; This program is distributed in the hope that it will be
;; useful, but WITHOUT ANY WARRANTY; without even the implied
;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.  See the GNU General Public License for more details.

;; You should have received a copy of the GNU General Public
;; License along with this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA

;; Version: 0.1

;; Compatibility: Emacs 22, CEDET 1.0pre3.

;;; Commentary:

;; Contains some useful functions features for C/C++ developers similar
to
;; those from VisualAssist. Remember that convinient M-o, M-g and M-m?

;; 1) Method navigaton.
;;    When eassist-list-methods called when c/c++ body file buffer is
active
;;    a new buffer is shown, containing list of methods and functions
in the
;;    format: return type, class, method name. You can select the
method
;;    moving to its line and press ENTER to jump to the method. You
also can
;;    type a string in the buffer and method list will be reduced to
those
;;    which contain the string as a substring. Nice highlight is
implemented.
;;    This function is recommended to be bound to M-m in c-mode.

;; 2) Header <-> Body file switch.
;;    You can easily switch between body (c, cpp, cc...) and its
corresponding
;;    header file (h, hpp...) using eassist-switch-h-cpp. The file is
searched
;;    in the same directory. You can adjust body to header
correspondance
;;    customizing eassist-header-switches variable.
;;    This function is recommended to be bound to M-o in c-mode.

;; EmacsAssist uses Semantic
(http://cedet.sourceforge.net/semantic.shtml)
;; EmacsAssist is defeloped for Semantics from CEDET 1.0pre3 package.
;; EmacsAssist works with current development (22) version of Emacs and
;; does not work with version 21.

;; Usage:

;; 1) Install CEDET 1.0pre3 package for Emacs (if you dont have CEDET
already).
;; 2) Copy eassist.el to your emacs/lisp folder.
;; 3) Add to your .emacs following line to load EmacsAssist:
;;    (require 'eassist)
;; 4) Add convinient keymaps for fast EmacsAssist calls in c-mode:
;;    (defun my-c-mode-common-hook ()
;;      (define-key c-mode-base-map (kbd "M-o") 'eassist-switch-h-cpp)
;;      (define-key c-mode-base-map (kbd "M-m") 'eassist-list-methods))
;;    (add-hook 'c-mode-common-hook 'my-c-mode-common-hook)
;; 5) Open any C++ file with class definithion, press M-m. Try to type
;;    any method name.
;; 6) Open any .cpp file. Press M-o. If there is .h or .hpp file in the
;;    same folder, it will be opened.

;;; Changelog:

;; 27 mar 2006 -- Initial version 0.1 created.

;;; Code:

;; ================================== My STRING utils
========================
(defun eassist-string-last (string n)
  (substring string (- (length string) n)))

(defun eassist-string-without-last (string n)
  (substring string 0 (max 0(- (length string) n))))

(defun eassist-string-ends-with (string end)
  (string= end (eassist-string-last string (length end))))
;; ================================== My STRING utils end
====================

;; ================================== CPP-H switch
===========================
;; Funcalls action until it is not nil.
;; Returns result of the last action.
(defun eassist-do-for-first-suitable (lst action)
  (if (null lst)
      nil
    (let ((res (funcall action (car lst))))
      (if (null res)
          (eassist-do-for-first-suitable (cdr lst) action)
        res))))

(setq eassist-header-switches '(
                             ("h" . ("cpp" "cc" "c"))
                             ("hpp" . ("cpp"))
                             ("cpp" . ("h" "hpp"))
                             ("c" . ("h"))
                             ("cc" . ("h" "hpp"))
                             ))

(defun eassist-switch-h-cpp ()
  (interactive)
  (let ((ext (file-name-extension (buffer-file-name))))
    (if (null (eassist-do-for-first-suitable eassist-header-switches
                                             (lambda (i)
                                               (if (string= (car i) ext)
                                                   (progn
                                                     (if (null 
(eassist-do-for-first-suitable (cdr i)
'eassist-try-h-cpp))
                                                         (message "There is no 
corresponding pair (header or body)
file."))
                                                     ext)
                                                 nil))))
        (message "It is not a header or body file! See eassist-header-switches
variable."))))

(defun eassist-try-h-cpp (ext)
  (eassist-find-if-exist
   (concat (eassist-string-without-last (buffer-file-name) (length
(file-name-extension (buffer-file-name)))) ext)))

(defun eassist-find-if-exist (file)
  (if (file-exists-p file)
      (progn (find-file file) file)
    nil))
;; ================================== CPP-H switch end
=========================

;; ================================== Method navigator
=========================
(defun eassist-functions ()
  (semantic-find-tags-by-class 'function
(semantic-something-to-tag-table eassist-buffer)))

(defun eassist-car-if-list (thing)
  (cond ((listp thing) (car thing))
        (t thing)))

(defun eassist-function-string-triplet (f)
  (list
   (eassist-car-if-list (semantic-tag-type f))
   (semantic-tag-function-parent f)
   (semantic-tag-name f)))

(defun eassist-format-triplets (f)
  (let ((return-width (reduce 'max (mapcar 'length (mapcar 'car f))
:initial-value 0))
        (class-width (reduce 'max (mapcar 'length (mapcar 'cadr f))
:initial-value 0))
        (name-width (reduce 'max (mapcar 'length (mapcar 'caddr f))
:initial-value 0)))
    (mapcar
     (lambda (tri)
       (cond
        ((cadr tri) (format (format "%%%ds  %%%ds :: %%s\n" return-width
class-width) (car tri) (cadr tri) (caddr tri)))
        (         t (format (format "%%%ds  %%%ds    %%s\n" return-width
class-width) (car tri) ""         (caddr tri)))))
     f)))

(defun eassist-list-methods ()
  (interactive)
  (setq eassist-buffer (current-buffer))
  (switch-to-buffer (get-buffer-create (concat (buffer-name
(current-buffer)) " method list")) t)
  (eassist-mode))

(defun eassist-jump-to-method ()
  (interactive)
  (let ((tag (cdr (nth (1- (line-number-at-pos))
eassist-actual-methods))))
    (cond
     (tag
      (kill-buffer (current-buffer))
      (switch-to-buffer (semantic-tag-buffer tag) t)
      (goto-char (semantic-tag-start tag))
      (recenter))
     (t (message "The line does not contain method description!")))))

(defun eassist-case-insensitive-regexp (reg)
  (apply 'string
         (mapcan
          (lambda (ch)
            (let ((up (upcase ch)) (down (downcase ch)))
              (cond
               ((= up down) (list ch))
               (t (list ?\[ up down ?\])))))
          (string-to-list reg))))

(defun eassist-search-string-updated ()
  (message eassist-search-string)
  (setq eassist-actual-methods
        (remove-if-not
         '(lambda (elt) (string-match eassist-search-string (car elt)))
         eassist-methods))
  (erase-buffer)
  (mapcar '(lambda (elt) (insert (car elt))) eassist-actual-methods)
  (goto-line (/ (count-lines (point-min) (point-max)) 2))
  (cond
   ((= 0 (length eassist-search-string)) nil)
   (t (highlight-regexp (eassist-case-insensitive-regexp
eassist-search-string) 'hi-yellow)))
  )

(defun eassist-key-pressed (key)
  (unhighlight-regexp (eassist-case-insensitive-regexp
eassist-search-string))
  (setq eassist-search-string (concat eassist-search-string
(char-to-string key)))
  (eassist-search-string-updated))

(defun eassist-backspace-pressed ()
  (interactive)
  (unhighlight-regexp (eassist-case-insensitive-regexp
eassist-search-string))
  (setq eassist-search-string (eassist-string-without-last
eassist-search-string 1))
  (eassist-search-string-updated))

(defun eassist-make-key-function (key)
   `(lambda () (interactive) (eassist-key-pressed ,key)))

(defun eassist-escape ()
  (interactive)
  (kill-buffer (current-buffer))
  (switch-to-buffer eassist-buffer))

(defvar eassist-mode-map
  (let ((map (make-sparse-keymap)))
    (suppress-keymap map)
    (do ((k (string-to-char "a") (+ 1 k))) ((> k (string-to-char "z")))
      (define-key
        map
        (read-kbd-macro (char-to-string k))
        (eassist-make-key-function k)))
    (do ((k (string-to-char "A") (+ 1 k))) ((> k (string-to-char "Z")))
      (define-key
        map
        (read-kbd-macro (char-to-string k))
        (eassist-make-key-function k)))
    (do ((k (string-to-char "0") (+ 1 k))) ((> k (string-to-char "9")))
      (define-key
        map
        (read-kbd-macro (char-to-string k))
        (eassist-make-key-function k)))
    (define-key map (kbd "<RET>") 'eassist-jump-to-method)
    (define-key map (kbd "<backspace>") 'eassist-backspace-pressed)
    (define-key map (kbd "<ESC>") 'eassist-escape)
    map)
  "Keymap for `eassist-mode'.")

(defun eassist-mode-init ()
  (make-local-variable 'eassist-search-string)   ;; current method
search string
  (make-local-variable 'eassist-methods)         ;; (<formatted method
string> . <semantic method tag>)
  (make-local-variable 'eassist-actual-methods)  ;; subset of
eassist-methods that contain eassist-search string in the method string
  (setq eassist-search-string "")

  (let ((method-tags (eassist-functions)))
    (let ((method-strings (eassist-format-triplets (mapcar
'eassist-function-string-triplet method-tags))))
      (setq eassist-methods
            (mapcar* 'cons
                     method-strings
                     method-tags))))
  (eassist-search-string-updated)
  (hl-line-mode)
  )

(define-derived-mode eassist-mode nil "Eassist methods"
  "EmacsAssist method selection mode.
   \\{eassist-mode-map}
   Turning on Text mode runs the normal hook `eassist-mode-hook'."
  (eassist-mode-init))

;; ================================== Method navigator end
======================

(provide 'eassist)

;;; eassist.el ends here