;;; [ rename this file to icon-describe.el   --ed ]


;;; Icon syntax describer: by Sean Boisen, BBN Systems and
;;; Technologies Corporation, sboisen@bbn.com. Standard lack of
;;; warranty applies: may be freely distributed subject to the
;;; restrictions of the GNU Emacs copyright. Please send me any bug
;;; fixes and/or improvements!
;;;
;;; This still has at least the following known deficiences:
;;;
;;; The descriptive text file lacks descriptions for the newer
;;; keywords. Please add them and send me a version if you can!
;;;
;;; It might be nice if icon-symbol-at-point did escape sequences as
;;; well: it doesn't.
;;;
;;; Someday it might be more useful to provide more than one line of
;;; information, especially for procedures: the main hurdle here is
;;; that i'm too lazy to type all the text in.

;;; additions:
;;;
;;; sboisen 2/23/89: i noticed that &pos gets
;;; picked up as pos. Hacked describe-icon-symbol for this as a
;;; special case. Still imperfect if point in just past the colon in
;;; 0:&pos however...
;;;
;;; sboisen 2/23/89: symbols which contain characters with special
;;; meanings in regexps don't get handled properly! not yet fixed...

(require 'icon-mode)

(provide 'icon-describe)

(defvar icon-doc-file "/d4m/sboisen/emacs/icondoc.txt"
  "Where the documentation file can be found.")

;; a helper function: get a string containing all the characters matching
;; some spec in a syntax table. Class is an atom. Useful in conjunction with
;; skip-chars-forward. Doesn't do the eighth bit.

(defun get-chars-in-class (class syntax-table)
  (let ((classcode
	  (cond
	    ((eq class 'whitespace) 0)
	    ((eq class 'punctuation) 1)
	    ((eq class 'word) 2)
	    ((eq class 'symbol) 3)
	    ((eq class 'open) 4)	;this doesn't work!
	    ((eq class 'close) 5)
	    ((eq class 'prefix) 6)
	    ((eq class 'stringquote) 7)
	    ((eq class 'charquote) 9)
	    ((eq class 'startcomment) 11)
	    ((eq class 'endcomment) 12)
	    ))
	(index 0)
	(str ""))
    (while (< index 128)
      (if (eql (aref syntax-table index) classcode)
	  (setq str (concat str (char-to-string index))))
      (setq index (1+ index)))
    str))

(defvar wordchars "a-zA-Z0-9_")
(defvar junkchars (concat " \n\t\r" "({[)}]"))
(defvar punct (get-chars-in-class 'punctuation icon-mode-syntax-table))

(defun icon-symbol-at-point ()
  "Get the closest Icon symbol to point, but don't change your
       position. Has a preference for looking backward when not
       directly on a symbol."
  (let (start end symbol)
    (save-excursion
      ;; first see if you're just past a symbol
      (if (looking-at "\\s-\\|\\s(\\|\\s)\\|\\s>")
	  (skip-chars-backward junkchars)
	;; else move forward one character, presumably either a \w or
	;; a symbol: but not if at the end of the buffer
	(or (= (point) (point-max))
	    (forward-char 1)))
      
      (cond
	;; special case for (potential) keywords: just past a &
	((eql (preceding-char) 38)
	 (setq start (1- (point)))
	 (cond
	   ((looking-at "\\w")
	    (skip-chars-forward wordchars))
	   ((looking-at "\\s.")
	    (skip-chars-forward punct))
	   ;; else whitespace?
	   ))
	;; just past a \\w
	((eql (aref icon-mode-syntax-table (preceding-char)) 2)
	 (skip-chars-backward wordchars)
	 ;; worry about being in the middle of a keyword
	 (if (eql (preceding-char) 38)
	     (setq start (1- (point)))
	   (setq start (point)))
	 (skip-chars-forward wordchars))
	;; else a symbol?
	(t
	  (skip-chars-backward punct)
	  (setq start (point))
	  (skip-chars-forward punct)))
      ;; THE OLD WAY THAT LOOKED FORWARD INSTEAD OF BACKWARD
;;      ;; skip past whitespace and parens
;;      (while (looking-at "\\s-\\|\\s(\\|\\s)\\|\\s>")
;;	(skip-chars-forward junkchars))
;;      (if (looking-at "\\w")
;;	  (progn
;;	    (skip-chars-forward wordchars)
;;	    (setq start (point))
;;	    (skip-chars-backward wordchars))
;;	;; else a symbol?
;;	(progn
;;	    (skip-chars-forward punct)
;;	    (setq start (point))
;;	    (skip-chars-backward punct)))
      (buffer-substring start (point)))))

(defun describe-icon-symbol (symbol)
  "Display the documentation of SYMBOL, an Icon operator."
  (interactive
    (let ((fn (icon-symbol-at-point))
	  (enable-recursive-minibuffers t)
	  (case-fold-search nil)	;require that case match for search
	  val args-file regexp)
      (setq val (read-from-minibuffer
		  (if fn
		      (format "Symbol (default %s): " fn)
		    "Symbol: ")))
      (if (string= val "")
	  (setq val fn))
      ;; this may not work for characters which are special to regexp
      ;; (like ".")
      (setq regexp (concat "^" val "[ \t(]"))
      (if (not (get-file-buffer icon-doc-file))
	  (progn
	    (setq args-file
	      (find-file-noselect icon-doc-file))
	    (set-buffer args-file)
	    (rename-buffer "*ICON-DOC*")))
      (set-buffer (get-file-buffer icon-doc-file))
      (goto-char (point-min))
      (list (if (re-search-forward regexp (point-max) t)
	  (save-excursion
	    (beginning-of-line 1)
	    (let ((lnstart (point)))
	      (end-of-line)
	      (message (buffer-substring lnstart (point)))))
	(error (format "No definition for %s" val)))))))