--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/oobr/br-ftr.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,422 @@
+;;!emacs
+;;
+;; FILE:         br-ftr.el
+;; SUMMARY:      OO-Browser feature browsing support.
+;; USAGE:        GNU Emacs Lisp Library
+;; KEYWORDS:     oop, tools
+;;
+;; AUTHOR:       Bob Weiner
+;; ORG:          Motorola Inc.
+;;
+;; ORIG-DATE:    20-Aug-91 at 18:16:36
+;; LAST-MOD:     25-Aug-95 at 16:54:53 by Bob Weiner
+;;
+;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
+;; See the file BR-COPY for license information.
+;;
+;; This file is part of the OO-Browser.
+;;
+;; DESCRIPTION:  
+;; DESCRIP-END.
+
+;;; ************************************************************************
+;;; Public variables
+;;; ************************************************************************
+
+(defconst br-feature-type-regexp "[-+=@%>1/]"
+  "Regular expression which matches the first non-whitespace characters in an OO-Browser feature listing.")
+
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
+
+(defun br-find-feature (&optional feature-entry view-only other-win)
+  "Display feature definition for FEATURE-ENTRY in VIEW-ONLY mode if non-nil.
+Return feature path if FEATURE-ENTRY is successfully displayed, nil
+otherwise.  Can also signal an error when called interactively."
+  (interactive)
+  (and (interactive-p) (setq view-only current-prefix-arg))
+  (let ((feature-path))
+    (setq feature-entry
+	  (br-feature-signature-and-file
+	   (or feature-entry
+	       (br-feature-complete 'must-match "Show feature definition:")))
+	  feature-path (cdr feature-entry)
+	  feature-entry (car feature-entry))
+    (br-edit-feature feature-entry feature-path other-win view-only)))
+
+(defun br-edit-feature (tag-entry feature-path &optional other-win view-only)
+  "Edit feature for OO-Browser TAG-ENTRY of file FEATURE-PATH, optionally in OTHER-WIN.
+With optional VIEW-ONLY, view feature definition instead of editing it.
+Return FEATURE-PATH if feature definition is found, else nil."
+  (let ((err))
+    (cond ((and feature-path (file-readable-p feature-path))
+	   (cond ((br-feature-found-p feature-path tag-entry nil other-win)
+		  (br-major-mode)
+		  (if view-only 
+		      (setq buffer-read-only t)
+		    ;; Handle case of already existing buffer in
+		    ;; read only mode.
+		    (and buffer-read-only
+			 (file-writable-p feature-path)
+			 (setq buffer-read-only nil)))
+		  ;; Force mode-line redisplay
+		  (set-buffer-modified-p (buffer-modified-p)))
+		 ((interactive-p)
+		  (setq err
+			(format
+			 "(OO-Browser):  No '%s' feature defined in Environment."
+			 tag-entry)
+			feature-path nil))))
+	  ((interactive-p)
+	   (setq err
+		 (format
+		  "(OO-Browser):  '%s' - src file not found or not readable, %s"
+		  tag-entry feature-path)
+		 feature-path nil)))
+    (if err (error err))
+    feature-path))
+
+(defun br-find-feature-entry ()
+  "Return feature entry that point is within or nil."
+  (if (= (point) (point-max)) (skip-chars-backward " \t\n"))
+  (save-excursion
+    (beginning-of-line)
+    (if (or 
+	 (progn (skip-chars-forward " \t")
+		(looking-at br-feature-entry))
+	 ;; Get current feature signature, if any.
+	 (br-feature-get-signature))
+	(let ((feature (buffer-substring
+			(point)
+			(progn (skip-chars-forward "^\t\n\r") (point)))))
+	  (if (and (equal br-lang-prefix "objc-")
+		   ;; Remove any trailing class from a category entry.
+		   (string-match "@ ([^\)]+)" feature))
+	      (substring feature 0 (match-end 0))
+	    feature)))))
+
+(defun br-feature-complete (&optional must-match prompt)
+  "Interactively completes feature entry if possible, and returns it.
+Optional MUST-MATCH means must match a completion table entry.
+Optional PROMPT is intial prompt string for user."
+  (interactive)
+  (let ((default (br-find-feature-entry))
+	(completion-ignore-case t)
+	completions
+	ftr-entry)
+    ;; Prompt with possible completions of ftr-entry.
+    (setq prompt (or prompt "Feature entry:")
+	  completions (br-feature-completions)
+	  ftr-entry
+	  (if completions
+	      (completing-read
+		(format "%s (default %s) " prompt default)
+		completions nil must-match)
+	    (read-string
+	      (format "%s (default %s) " prompt default))))
+    (if (equal ftr-entry "") default ftr-entry)))
+
+(defun br-feature-completions ()
+  "Return completion alist of all current Environment elements."
+  (cond ((not (and br-feature-tags-file (file-exists-p br-feature-tags-file)
+		   (file-readable-p br-feature-tags-file)))
+	 nil)
+	((and br-feature-tags-completions
+	      (eq
+	       (car (cdr br-feature-tags-completions)) ;; tags last mod time
+	       (apply '+ (nth 5 (file-attributes br-feature-tags-file))))
+	      (equal br-env-file (car br-feature-tags-completions)))
+	 (car (cdr (cdr br-feature-tags-completions))))
+	(t
+	 (let ((ftr-buf (get-buffer-create "*ftr-buf*"))
+	       (ftr-alist))
+	   (save-excursion
+	     (br-feature-tags-init)
+	     (copy-to-buffer ftr-buf 1 (point-max))
+	     (set-buffer ftr-buf)
+	     (goto-char 1)
+	     (while (search-forward "\^L" nil t)
+	       (forward-line 1)
+	       ;; Skip past pathname where features are defined.
+	       (while (and (= (forward-line 1) 0)
+			   (not (looking-at "\^L\\|\\'")))
+		 (setq ftr-alist (cons (cons (br-feature-signature-to-name
+					      (br-feature-current)
+					      t)
+					     nil)
+				       ftr-alist)))))
+	   (kill-buffer ftr-buf)
+	   (setq br-feature-tags-completions 
+		 (list br-env-file
+		       ;; tags last mod time
+		       (apply '+ (nth 5 (file-attributes
+					 br-feature-tags-file)))
+		       ftr-alist))
+	   ftr-alist))))
+
+(defun br-feature-def-file (feature-regexp)
+  "Return file name in which feature matching FEATURE-REGEXP is, if any.
+Assume feature tags file is current buffer and leave point at the start of
+matching feature tag, if any."
+  (goto-char 1)
+  (and (re-search-forward feature-regexp nil t)
+       ;; This ensures that point is left on the same line as the feature tag
+       ;; which is found.
+       (goto-char (match-beginning 0))
+       (br-feature-file-of-tag)))
+
+(defun br-feature-file (feature-sig)
+  "Return file name in which feature matching FEATURE-SIG is, if any."
+  (let ((obuf (current-buffer))
+	(file))
+    (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
+    (goto-char 1)
+    (if (search-forward feature-sig nil t)
+	(setq file (br-feature-file-of-tag)))
+    (set-buffer obuf)
+    file))
+
+(defun br-feature-found-p (buf-file feature-tag
+			   &optional deferred-class other-win regexp-flag)
+  "Search BUF-FILE for FEATURE-TAG.
+Return nil if not found, otherwise display it and return non-nil."
+  (if buf-file
+      (let ((found-def)
+	    (opoint (point))
+	    (prev-buf)
+	    (prev-point)
+	    (config (current-window-configuration)))
+	(setq prev-buf (get-file-buffer buf-file))
+	(funcall br-edit-file-function buf-file other-win)
+	(setq prev-point (point))
+	(widen)
+	(goto-char (point-min))
+	(setq found-def 
+	      (cond (deferred-class
+		      (br-feature-locate-p feature-tag deferred-class))
+		    (regexp-flag
+		     (br-feature-locate-p feature-tag regexp-flag))
+		    (t (br-feature-locate-p feature-tag))))
+	(if found-def
+	    ;; Set appropriate mode for file.
+	    (br-major-mode)
+	  (setq buf-file (get-file-buffer buf-file))
+	  (if prev-buf
+	      (goto-char prev-point)
+	    (if buf-file
+		(kill-buffer buf-file)
+	      (goto-char prev-point)))
+	  (set-window-configuration config)
+	  (goto-char opoint))
+	found-def)))
+
+(defun br-feature-name (ftr-entry)
+  "Return name part of FTR-ENTRY."
+  (if (equal (string-match br-feature-entry ftr-entry) 0)
+      (substring ftr-entry (match-beginning 1))
+    ""))
+
+(defun br-feature-signature-and-file (class-and-feature-name)
+  "Return (feature signature . feature-def-file-name) of CLASS-AND-FEATURE-NAME."
+  (let ((obuf (current-buffer))
+	;; Find only exact matches
+	(name-regexp (br-feature-name-to-regexp class-and-feature-name))
+	(result))
+    (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
+    (goto-char 1)
+    (if (re-search-forward name-regexp nil t)
+	(progn (goto-char (match-beginning 0))
+	       (setq result (cons (br-feature-current)
+				  (br-feature-file-of-tag)))))
+    (set-buffer obuf)
+    result))
+
+(defun br-feature-signature (&optional arg)
+  "Show full feature signature in the view window.
+With optional prefix ARG, display signatures of all features from the current
+buffer."
+  (interactive "P")
+  (let* ((buf (buffer-name))
+	 (owind (selected-window))
+	 (features (delq nil (if arg (br-feature-get-tags)
+			       (list (br-feature-get-signature))))))
+    (if (null features)
+	(progn (beep) (message "No elements."))
+      (br-to-view-window)
+      (switch-to-buffer (get-buffer-create (concat buf "-Elements")))
+      (setq buffer-read-only nil)
+      (erase-buffer)
+      (mapcar (function (lambda (feature) (insert feature "\n")))
+	      features)
+      (br-major-mode)
+      (goto-char 1)
+      (select-window owind)
+      (message ""))))
+
+;;; ************************************************************************
+;;; Listing buffer entry tag property handling.
+;;; ************************************************************************
+
+(if (string-match "^19\." emacs-version)
+    (progn
+      ;;
+      ;; Emacs 19 buffer entry tags functions
+      ;;
+
+      (defun br-feature-clear-signatures (&optional buf-nm)
+	"Erase any feature signatures saved with current buffer or optional BUF-NM."
+	(save-excursion
+	  (if buf-nm (set-buffer (get-buffer buf-nm)))
+	  (save-restriction
+	    (widen)
+	    (remove-text-properties (point-min) (point-max) '(tag)))))
+
+      (defun br-feature-get-signature (&optional line-num-minus-one)
+	(save-excursion
+	  (if (numberp line-num-minus-one)
+	      (goto-line (1+ line-num-minus-one)))
+	  (end-of-line)
+	  (car (cdr (memq 'tag (text-properties-at (1- (point))))))))
+
+      (defun br-feature-get-tags ()
+	(save-excursion
+	  (goto-char (point-max))
+	  (let ((found t)
+		(tags)
+		tag)
+	    (while found
+	      (setq tag (get-text-property (1- (point)) 'tag))
+	      (if tag (setq tags (cons tag tags)))
+	      (setq found (= (forward-line -1) 0))
+	      (end-of-line))
+	    tags)))
+
+      ;; Tag property is placed at end of line in case leading indent is
+      ;; removed by an OO-Browser operation.  In that case, we don't want to
+      ;; lose the tag property.
+      (defun br-feature-put-signatures (ftr-sigs)
+	(while ftr-sigs
+	  (end-of-line)
+	  (put-text-property (- (point) 2) (point) 'tag (car ftr-sigs))
+	  (setq ftr-sigs (cdr ftr-sigs))
+	  (if (and ftr-sigs (/= (forward-line 1) 0))
+	      (error "(br-feature-put-signatures): Too few lines in this buffer"))))
+
+      )
+
+  ;;
+  ;; Emacs 18 buffer entry tags functions
+  ;;
+
+  (defun br-feature-clear-signatures (&optional buf-nm)
+    "Erase any feature signatures saved with current buffer or optional BUF-NM."
+    (put (intern (or buf-nm (buffer-name))) 'features nil))
+
+  (defun br-feature-get-signature (&optional line-num)
+    (or (numberp line-num)
+	(save-excursion
+	  (beginning-of-line)
+	  (setq line-num (count-lines 1 (point)))))
+    (cdr (assq line-num (get (intern-soft (buffer-name)) 'features))))
+
+  (defun br-feature-get-tags ()
+    (get (intern-soft (buffer-name)) 'features))
+
+  (defun br-feature-put-signatures (ftr-sigs)
+    (beginning-of-line)
+    (let* ((line (count-lines 1 (point)))
+	   (meth-alist (mapcar (function
+				(lambda (meth)
+				  (prog1 (cons line meth)
+				    (setq line (1+ line)))))
+			       ftr-sigs))
+	   (buf-sym (intern (buffer-name))))
+      (put buf-sym 'features
+	   (nconc (get buf-sym 'features) meth-alist))))
+  )
+
+;;; ************************************************************************
+;;; END - Listing buffer entry tag property handling.
+;;; ************************************************************************
+
+(defun br-feature-tags-init ()
+  "Set up 'br-feature-tags-file' for writing."
+  (setq br-feature-tags-completions nil
+	br-feature-tags-file (br-feature-tags-file-name br-env-file)
+	br-tags-file (concat br-env-file "-TAGS"))
+  (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
+  (setq buffer-read-only nil))
+
+(defun br-feature-tags-file-name (env-file)
+  (concat env-file "-FTR"))
+
+(defun br-feature-tags-save ()
+  "Filter out extraneous lines and save 'br-feature-tags-file'."
+  (let ((obuf (current-buffer)))
+    (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
+    (goto-char (point-min))
+    (delete-matching-lines "^[ \t]*$")
+    (goto-char (point-min))
+    (replace-regexp "^[ \t]+\\|[ \t]+$" "")
+    (and br-c-tags-flag
+	 (br-member br-lang-prefix '("c++-" "objc-"))
+	 (progn (c-build-element-tags)
+		(goto-char (point-min))
+		(replace-regexp "[ \t]*//.*" "")))
+    (goto-char (point-min))
+    (delete-matching-lines "^$")
+    (save-buffer)
+    (set-buffer obuf)))
+
+(defun br-insert-features (feature-tag-list &optional indent)
+  "Insert feature names from FEATURE-TAG-LIST in current buffer indented INDENT columns."
+  (let ((start (point)))
+    (mapcar (function
+	     (lambda (feature-tag)
+	       (if indent (indent-to indent))
+	       (if feature-tag
+		   (insert (br-feature-signature-to-name feature-tag nil t)
+			   "\n"))))
+	    feature-tag-list)
+    (save-excursion
+      (goto-char start)
+      (br-feature-put-signatures feature-tag-list))))
+
+;;; ************************************************************************
+;;; Private functions
+;;; ************************************************************************
+
+(defun br-feature-current ()
+  "Extract current feature from tags file and leave point at the end of line."
+  (beginning-of-line)
+  (buffer-substring (point) (progn (end-of-line) (point))))
+
+(defun br-feature-file-of-tag ()
+  "Return the file name of the file whose tag point is within.
+Assumes the tag table is the current buffer."
+  (save-excursion
+    (search-backward "" nil t)
+    (forward-line 1)
+    (let ((start (point)))
+      (end-of-line)
+      (buffer-substring start (point)))))
+
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+(defconst br-feature-entry
+  (concat br-feature-type-regexp " \\([^\t\n\r]*[^ \t\n\r]\\)")
+  "Regexp matching a feature entry in a browser listing buffer.")
+
+(defvar br-feature-tags-completions nil
+  "List of (envir-name tags-file-last-mod-time tags-completion-alist).")
+
+(defvar br-feature-tags-file nil
+  "Pathname where current object-oriented feature tags are stored.")
+
+(defvar br-tags-file nil
+  "Pathname where current non-object-oriented feature tags are stored.")
+
+(provide 'br-ftr)