;;; jde-which-method.el --- Print current method in mode line

;; Copyright (C) 1994, 1997, 1998 Free Software Foundation, Inc.

;; Author: Paul Kinnucan (paulk@mathworks.com)
;; Inspired by Alex Rezinsky's which-func package.
;; Keywords: mode-line, tools

;; This file is not part of GNU Emacs.

;; GNU Emacs 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, or (at your option)
;; any later version.

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

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

;;; Commentary:

;; This package displays the name of the method at point
;; in the Emacs mode line. 

;;; History:

;;  $Log: jde-which-method.el,v $
;;  Revision 1.1  2001/02/12 05:57:51  paulk
;;  Initial XEmacs revision.
;;
;;  Revision 1.8  2000/11/27 06:18:41  paulk
;;  Miscellaneous bug fixes and minor enhancements.
;;
;;  Revision 1.7  2000/10/20 04:12:12  paulk
;;  *** empty log message ***
;;
;;  Revision 1.6  2000/10/10 06:39:24  paulk
;;  Moved some which method customization variables into the which method customization group.
;;
;;  Revision 1.5  2000/10/08 12:55:39  paulk
;;  *** empty log message ***
;;
;;  Revision 1.4  2000/10/06 05:41:28  paulk
;;  Now optionally truncates method name. 
;;  Thanks to klaus.berndl@sdm.de. Also, moves method 
;;  name after point location display in mode line.
;;
;;  Revision 1.3  2000/09/05 04:42:22  paulk
;;  Fixed a number of bugs.
;;
;;  Revision 1.2  2000/09/04 05:03:16  paulk
;;  Added test for existence of method map.
;;
;;  Revision 1.1  2000/08/31 05:27:49  paulk
;;  Initial revision.
;;

;;; Code:

;; Variables for customization
;; ---------------------------
;;  

(require 'jde-parse)


(defgroup jde-which-method nil
  "Mode to display the current function name in the modeline."
  :group 'jde)

;;;###autoload
(defcustom jde-which-method-mode t
  "Enables the JDE's which method mode.
When which method mode is enabled, the current method name is
displayed in the mode line."
  :group 'jde-which-method
  :type  'boolean)

(defcustom jde-which-method-format '("[" jde-which-method-current "]")
  "Format for displaying the function in the mode line."
  :group 'jde-which-method
  :type 'sexp)

(defcustom jde-mode-line-format 
  '("-" 
    mode-line-mule-info
    mode-line-modified
    mode-line-frame-identification
    mode-line-buffer-identification
    "   "
    global-mode-string
    "   %[(" mode-name mode-line-process minor-mode-alist "%n" ")%]--"
    (line-number-mode "L%l--")
    (column-number-mode "C%c--")
    (-3 . "%p")
    (jde-which-method-mode
     ("--" jde-which-method-format "--"))
    "-%-")
  "Format for the JDE source buffer mode line."
  :group 'jde
  :type 'sexp)

(defcustom jde-which-method-max-length 20
  "Specify the maximum length of the which-method-string \(see
`jde-which-method-format'). If nil, the string is not \
truncated."
  :type '(choice (const :tag "No truncation" :value nil)
                 (integer :tag "Max. length"))
  :group 'jde-which-method)

(defcustom jde-which-method-class-min-length 4
  "Specifies the minimum length of the class part of the full method
name after truncation of the class name, but only if the class 
is displayed and if `jde-which-method-max-length'
is not nil. If the full method name is still greater than
`jde-which-method-max-length', the method part of the name is truncated."
  :type '(integer :tag "Min. length")
  :group 'jde-which-method)


(defcustom jde-which-method-abbrev-symbol "~"
"Symbol used to indicate abbreviated part of a method name."
    :group 'jde-which-method
    :type  'string)

;;; Code, nothing to customize below here
;;; -------------------------------------
;;;

(defvar jde-which-method-unknown "???"
  "String to display in the mode line when the current method is unknown.")

(defvar jde-which-method-current  jde-which-method-unknown)
(make-variable-buffer-local 'jde-which-method-current)

(defvar jde-which-method-current-point-loc -1)
(make-variable-buffer-local 'jde-which-method-current-point-loc)

(defvar jde-which-method-current-method-bounds (cons -1 -1))
(make-variable-buffer-local 'jde-which-method-current-method-bounds)


(defun jde-which-method-truncate-begin (str truncation)
  (if (> truncation (length jde-which-method-abbrev-symbol))
	 (concat jde-which-method-abbrev-symbol (substring str truncation))
       str))

(defun jde-which-method-truncate-end (str truncation)
  (let ((str-length (length str)))
    (if (> truncation (length jde-which-method-abbrev-symbol))
        (concat (substring str 0 (- str-length truncation)) 
		jde-which-method-abbrev-symbol)
      str)))

(defun jde-which-method-update ()
  (interactive)
  (condition-case info
      (let ((p (point)))
	(if (or
	     (= jde-which-method-current-point-loc p)
	     (and
	      (>= p (car jde-which-method-current-method-bounds))
	      (<= p (cdr jde-which-method-current-method-bounds))))
	    (setq jde-which-method-current-point p)
	  (let ((name ;; (jde-parse-get-method-at-point)
 		      (if jde-parse-the-method-map
			  (jde-parse-method-map-get-method-at jde-parse-the-method-map))
		      ))
	   (if name
	       (let* ((name-pair (car name))
		      (class (car name-pair))
		      (method (cdr name-pair))
		      (bounds (cdr name))
                      (class-length (length class))
                      (method-length (length method))
                      ;; initialize the truncation with 0!
                      (trunc-class 0)
                      (trunc-method 0)
                      (trunc-complete 0))
                 (when jde-which-method-max-length
                   ;; compute necessary truncation of method and/or class
                   (if jde-parse-buffer-contains-multiple-classes-p
                       (when (> (+ class-length method-length 1)
                                jde-which-method-max-length)
                         (setq trunc-complete (- (+ class-length
                                                    method-length 1)
                                                 jde-which-method-max-length))
                         (if (< (- class-length trunc-complete)
                                jde-which-method-class-min-length)
                             (setq trunc-class
                                   (- class-length
                                      jde-which-method-class-min-length)
                                   trunc-method (- trunc-complete
                                                   trunc-class))
                           (setq trunc-method 0
                                 trunc-class trunc-complete)))
                     (when (> method-length jde-which-method-max-length)
                       (setq trunc-method (- method-length
                                             jde-which-method-max-length)))))
                 ;; truncate method and class with the computed truncation
                 ;; (possible 0, then no truncation is done in fact)
                 (setq class (jde-which-method-truncate-end class trunc-class)
                       method (jde-which-method-truncate-end method trunc-method))
                 ;; set the displayed string from the (possible truncated)
                 ;; class and method parts according to
                 ;; jde-parse-buffer-contains-multiple-classes-p.
                 (setq jde-which-method-current
                       (if jde-parse-buffer-contains-multiple-classes-p
                           (format "M:%s.%s" class method)
                         (format "M:%s" method)))
		 (setq jde-which-method-current-point-loc p)
		 (setq jde-which-method-current-method-bounds bounds))
	     (progn
	       (setq name (jde-parse-get-innermost-class-at-point))
	       (setq jde-which-method-current-point-loc p)
	       (setq jde-which-method-current-method-bounds (cons -1 -1))
	       (if name
                   (let* ((class (car name))
                          (class-length (length class)))
                     ;; possible truncate the string to display
                     (when (and jde-which-method-max-length
                                (> class-length jde-which-method-max-length))
                       (setq class (jde-which-method-truncate-begin class
                                                       (- class-length
                                                          jde-which-method-max-length))))
                     (setq jde-which-method-current (format "C:%s" class)))
		 (setq jde-which-method-current jde-which-method-unknown)))))))
    (error
     ;; (debug)
     (remove-hook 'post-command-hook 'jde-which-method-update)
     (message "Error in jde-which-method-update: %s" info))))

(defun jde-which-method-update-on-entering-buffer ()
  (setq jde-which-method-current-point-loc 0)
  (setq jde-which-method-current-method-bounds (cons -1 -1))
  (jde-which-method-update))

(provide 'jde-which-method)

;; jde-which-method.el ends here
