;;; objc-nav.el --- Objective C navigation mode

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

;; Author: Geoffrey S. Knauth <gknauth@bbn.com>
;; Maintainer: gknauth@bbn.com
;; Version 5, 28-Feb-1997

;; This file is 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, 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307.

;;; Commentary:

;; This is a major mode for browsing and editing Objective C files.
;; It was written to help people navigate the class hierarchy.

;; Adapted by GSK from dired.el originally written by
;; Sebastian Kremer <sk@thp.uni-koeln.de>.

;;; Code:

;;; Customizable variables

;; These are the directories where you expect to find .h interface files.
(setq objc-nav-interface-dirs
      '("~/gnu-objc/libobjects-0.1.19/src/objects"
	"/usr/local/include/Foundation"
	"/usr/local/include/objc"))

;; These are the directories where you expect to find .m implementation files.
(setq objc-nav-implementation-dirs
      '("~/gnu-objc/libobjects-0.1.19/src"
	"/usr/local/include/Foundation"
	"/usr/local/include/objc"))

;;; Hook variables

;;; Internal variables

;;; Macros must be defined before they are used, for the byte compiler.

;; The objc-navigate command

;;;###autoload (define-key ctl-x-map "p" 'objc-navigate)
;;;###autoload

(defun objc-navigate (classname)
  "Enter CLASSNAME and navigate its Objective C class hierarchy.
\\<objc-nav-mode-map>\
Type \\[describe-mode] after entering objc-navigate for more info."
  (interactive "sClassname: ")
  (let ((buffer nil)
	(hierarchy nil))
    (setq buffer
	  (get-buffer-create (concat "*objc-nav-" classname "*")))
    (setq hierarchy (objc-nav-list-parents
		     classname
		     objc-nav-interface-dirs
		     objc-nav-implementation-dirs))
    (switch-to-buffer buffer)
    (objc-nav-mode)
    (set (make-local-variable 'objc-nav-lcl-hierarchy) nil)
    (setq objc-nav-lcl-hierarchy hierarchy)
    (setq buffer-read-only nil)
    (insert (concat "Inheritance hierarchy for " classname ":\n\n"))
    (objc-nav-insert-map-lines objc-nav-lcl-hierarchy)
    (setq buffer-read-only t)
    (forward-line -1)))

;; Returns a list that looks like this:
;; ("NSObject none /usr/local/include/Foundation P"
;;  "Collection NSObject /objc/libobjects-0.1.19/src/objects Q"
;;  "KeyedCollection Collection /objc/libobjects-0.1.19/src/objects Q"
;;  "IndexedCollection KeyedCollection /objc/libobjects-0.1.19/src/objects Q"
;;  "EltNodeCollector IndexedCollection /objc/libobjects-0.1.19/src/objects Q")
;; where P and Q represent directories where .m implentation files are found
;; (I just wrote P and Q for neatness.)
;;
(defun objc-nav-list-parents (classname hdirs mdirs)
  (let ((list-value nil)
	(string-value nil)
	(next-parent nil))
    (cond ((null classname) nil)
	  (t (progn
	       (setq list-value (objc-nav-find-class-in-dirs
				 classname hdirs mdirs))
	       (setq string-value (car list-value))
	       (if (stringp string-value)
		   (progn
		     (string-match
		      "\\([^ \t]+\\)[ \t]+\\([^ \t]+\\)[ \t]+\\([^ \t]+\\)"
		      string-value)
		     (setq next-parent (match-string 2 string-value))
		     (if (not (string= next-parent "none"))
			 (setq list-value
			       (append (objc-nav-list-parents
					next-parent hdirs mdirs)
				       list-value))))))
	     list-value))))

(defun objc-nav-find-class-in-dirs (classname hdirs mdirs)
  (let ((value nil))
    (cond ((null hdirs) nil)
	  ((atom (car hdirs))
	   (if (stringp (setq value (objc-nav-look-for-class-in-hdir
				     classname (car hdirs) mdirs)))
	       (list value)
	     (objc-nav-find-class-in-dirs classname (cdr hdirs) mdirs))))))

(defun objc-nav-look-for-class-in-hdir (classname one-hdir mdirs)
  (let ((bufname "*objc-nav-egrep-h-output*")
	(command nil)
	(string-value nil))
    (get-buffer-create bufname)
    (set-buffer bufname)
    (erase-buffer)
    (setq command
	  (concat "egrep " "'^@interface[ \t]+" classname "[ \t]*' "
		  one-hdir "/" classname ".h /dev/null"))
    (if (= 0 (call-process "/bin/sh" nil bufname nil "-c" command))
	(progn
	  (switch-to-buffer bufname)
	  (goto-char (point-min))
	  (if (or (string= classname "NSObject")
		  (string= classname "Object"))
	      (if (looking-at
		   (concat "\\(.*\\)/.*[ \t]*:@interface[ \t]+"
			   "\\([a-zA-Z_0-9]*\\)"))
		  (progn
		    (replace-match "none \\1" t nil nil)
		    (setq string-value
			  (concat classname " "
				  (buffer-substring (point-min) (point)) " "
				  (objc-nav-find-class-in-mdirs
				   classname mdirs)))))
	    (if (looking-at
		 (concat "\\(.*\\)/.*[ \t]*:@interface[ \t]+.*:"
			 "[ \t]*\\([a-zA-Z_0-9]*\\)"))
		 (progn
		   (replace-match "\\2 \\1" t nil nil)
		   (setq string-value
			 (concat classname " "
				 (buffer-substring (point-min) (point)) " "
				 (objc-nav-find-class-in-mdirs
				  classname mdirs))))))
    (kill-buffer bufname)
    string-value))))

(defun objc-nav-find-class-in-mdirs (classname mdirs)
  (let ((value "none"))
    (cond
     ((null mdirs) value)
     ((atom (car mdirs))
      (if (stringp (setq value (objc-nav-look-for-class-in-mdir
				classname (car mdirs))))
	  value
	(objc-nav-find-class-in-mdirs classname (cdr mdirs)))))))

(defun objc-nav-look-for-class-in-mdir (classname one-mdir)
  (save-excursion
    (let ((bufname "*objc-nav-egrep-m-output*")
	  (command nil)
	  (string-value nil))
      (get-buffer-create bufname)
      (set-buffer bufname)
      (erase-buffer)
      (setq command
	    (concat "egrep " "'^@implementation[ \t]+" classname "[ \t]*' "
		    one-mdir "/" classname ".m /dev/null"))
      (if (= 0 (call-process "/bin/sh" nil bufname nil "-c" command))
	  (progn
	    (switch-to-buffer bufname)
	    (goto-char (point-min))
	    (if (looking-at "\\(.*\\)\\(/.*:@implementation.*\\)")
		(progn
		  (replace-match "\\1" t nil)
		  (setq string-value (buffer-substring
				      (point-min) (point)))))))
      (kill-buffer bufname)
      string-value)))

;; Inserts lines like these in the current buffer:
;; NSObject
;; Collection
;; KeyedCollection
;; IndexedCollection
;; EltNodeCollector
;;
(defun objc-nav-insert-map-lines (hierarchy)
  (cond ((null hierarchy) nil)
	((not (stringp (car hierarchy))) nil)
	(t (insert (objc-nav-line-object-name (car hierarchy)) "\n")
	   (objc-nav-insert-map-lines (cdr hierarchy)))))

;; Input, a string like: "NSObject none /usr/local/include/Foundation MDIR"
;; Output, a string like: "NSObject"
;;
(defun objc-nav-line-object-name (hierarchy-item)
  (cond ((not (stringp hierarchy-item)) nil)
	(t (car (objc-nav-tokenize-map-line hierarchy-item)))))

;; Input, a string like: "NSObject none /usr/local/include/Foundation MDIR"
;; Output, a string like: "/usr/local/include/Foundation"
;;
(defun objc-nav-line-interface-path (hierarchy-item)
  (cond ((not (stringp hierarchy-item)) nil)
	(t (nth 2 (objc-nav-tokenize-map-line hierarchy-item)))))

;; Input, a string like: "NSObject none /usr/local/include/Foundation MDIR"
;; Output, a string like: "MDIR"
;;
(defun objc-nav-line-implementation-path (hierarchy-item)
  (cond ((not (stringp hierarchy-item)) nil)
	(t (nth 3 (objc-nav-tokenize-map-line hierarchy-item)))))

;; Input, a classname like: "Foo"
;; and a list of lists, like: (("Foo" "Parent" "hdir" "mdir") ... )
;; Output, a filename, like "hdir/Foo.h"
;;
(defun objc-nav-interface-file-for-object (classname lol)
  (cond
   ((null lol) nil)
   ((not (stringp classname)) nil)
   ((not (and (listp lol) (listp (car lol)))) nil)
   (t
    (if (string= (car (car lol)) classname)
	(concat (nth 2 (car lol)) "/" classname ".h")
      (objc-nav-interface-file-for-object classname (cdr lol))))))

;; Input, a classname like: "Foo"
;; and a list of lists, like: (("Foo" "Parent" "hdir" "mdir") ... )
;; Output, a filename, like "mdir/Foo.m"
;;
(defun objc-nav-implementation-file-for-object (classname lol)
  (cond
   ((null lol) nil)
   ((not (stringp classname)) nil)
   ((not (and (listp lol) (listp (car lol)))) nil)
   (t
    (if (string= (car (car lol)) classname)
	(concat (nth 3 (car lol)) "/" classname ".m")
      (objc-nav-implementation-file-for-object classname (cdr lol))))))

(defun objc-nav-find-interface-file ()
  (interactive)
  (let ((filename nil))
    (beginning-of-line)
    (setq later-locals (buffer-local-variables))
    (if (looking-at "\\([^ \t\n]+\\)")
	(progn
	  (setq filename
		(objc-nav-interface-file-for-object
		 (match-string 1)
		 (objc-nav-tokenize-list objc-nav-lcl-hierarchy)))
	  (find-file-other-window filename)))))

(defun objc-nav-find-implementation-file ()
  (interactive)
  (let ((filename nil))
    (beginning-of-line)
    (setq later-locals (buffer-local-variables))
    (if (looking-at "\\([^ \t\n]+\\)")
	(progn
	  (setq filename
		(objc-nav-implementation-file-for-object
		 (match-string 1)
		 (objc-nav-tokenize-list objc-nav-lcl-hierarchy)))
	  (find-file-other-window filename)))))

;; Input, a list of strings, each like: "Object Parent hpath mpath"
;; Output, a list of lists, each like: ("Object" "Parent" "hpath" "mpath")
;;
(defun objc-nav-tokenize-list (hierarchy)
  (cond
   ((null hierarchy) nil)
   ((not (stringp (car hierarchy))) nil)
   (t
    (cons
     (objc-nav-tokenize-map-line (car hierarchy))
     (objc-nav-tokenize-list (cdr hierarchy))))))

(defun objc-nav-tokenize-map-line (hierarchy-item)
  (cond ((not (stringp hierarchy-item)) nil)
	(t (if (string-match
		(concat "\\([a-zA-Z0-9_]+\\)[ \t]+"
			"\\([a-zA-Z0-9_]+\\)[ \t]+"
			"\\([^ \t]+\\)[ \t]+"
			"\\([^ \t]+\\)")
		hierarchy-item)
	       (list (match-string 1 hierarchy-item) ; object
		     (match-string 2 hierarchy-item) ; parent
		     (match-string 3 hierarchy-item) ; dir of .h file
		     (match-string 4 hierarchy-item)) ; dir of .m file
	     nil))))

;; objc-nav mode key bindings and initialization

(defvar objc-nav-mode-map nil "Local keymap for objc-nav-mode buffers.")
(if objc-nav-mode-map
    nil
  (let ((map (make-keymap)))
    (suppress-keymap map)
    (define-key map "h" 'objc-nav-find-interface-file)
    (define-key map "m" 'objc-nav-find-implementation-file)
    (define-key map "q" 'objc-nav-quit)
    (setq objc-nav-mode-map map)))

;; Objc mode is suitable only for specially formatted data.
(put 'objc-nav-mode 'mode-class 'special)

(defun objc-nav-mode ()
  "This is a major mode for browsing and editing Objective C files.
It was written to help people navigate the class hierarchy.

Type \\[objc-navigate] CLASSNAME RET to view the class hierarchy
for CLASSNAME.  You will then be in objc-nav mode.  In objc-nav mode,
with point on a class name:

- type \\[objc-nav-find-interface-file] to visit the interface file
- type \\[objc-nav-find-implementation-file] to visit the implementation file
- type \\[objc-nav-quit] to quit

This mode gets its starting information by examining the variables:
   objc-nav-interface-dirs  objc-nav-implementation-dirs

As an example, here is one way you could set these variables:

    (setq objc-nav-interface-dirs
	  '(\"~/gnu-objc/libobjects-0.1.19/src/objects\"
	    \"/usr/local/include/Foundation\"
	    \"/usr/local/include/objc\"))

    (setq objc-nav-implementation-dirs
	  '(\"~/gnu-objc/libobjects-0.1.19/src\"
	    \"/usr/local/include/Foundation\"
	    \"/usr/local/include/objc\"))
"
  ;; Not to be called interactively (e.g. objc-nav-directory will be set
  ;; to default-directory, which is wrong with wildcards).
  (kill-all-local-variables)
  (use-local-map objc-nav-mode-map)
  (setq major-mode 'objc-nav-mode
	mode-name "objc-nav"
	buffer-read-only t
	mode-line-buffer-identification '("objc-nav: %17b"))
  ;; list-buffers uses this to display the dir being edited in this buffer.
  (run-hooks 'objc-nav-mode-hook))

;; Idiosyncratic objc-nav commands that don't deal with marks.

(defun objc-nav-quit ()
  "Bury the current objc-nav buffer."
  (interactive)
  (bury-buffer))

;; Keeping objc-nav buffers in sync with the filesystem and with each other

;;; utility functions

(provide 'objc-nav)

(run-hooks 'objc-nav-load-hook)		; for your customizations

;;; objc-nav.el ends here