;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; From rmf@cs.columbia.edu Tue Dec  4 12:32:42 1990
;;; From: rmf@cs.columbia.edu (Robert Fuhrer)
;;; Date: Tue, 4 Dec 1990 20:32:42 GMT
;;; Subject: function documentation package
;;; Organization: Columbia University Department of Computer Science
;;; Newsgroups: gnu.emacs.sources
;;; Distribution: gnu
;;; 
;;; This is a small ELisp package which implements a simple documentation
;;; facility for functions.  Each function is considered to reside in a
;;; file, and be part of a single module (which may comprise several files).
;;; Completion is used liberally within the package, for example, for
;;; function names, module names, argument names, etc.  Pop-up buffers are
;;; also used liberally with recursive editing, so that all the usual Emacs
;;; power is available while making your documentation.
;;; 
;;; I don't make many guarantees about it being bug-free, though I did in
;;; fact use it quite a bit during my last project.  I've found it
;;; particularly useful when writing lots of functions in a short period of
;;; time (can you say "rabid [sic] prototyping"? :=)), and don't want to
;;; have to remember whether something got named "writeObjects", or
;;; "write-objects", or whatever.
;;; 
;;; The package allows you to:
;;; 
;;; 1)  Enter a description of a function, with its name, a module, a file
;;;     (normally taken to be the file the current buffer is visiting), a
;;;     documentation string (as large as you'd like), the arguments (each
;;;     with a name and a type and a documentation string), and a result
;;;     type.
;;; 2)  Edit the description (i.e., any name, doc string, containing module,
;;;     etc.).
;;; 3)  Get a buffer listing all functions/variables currently defined, all
;;;     functions residing in a given module, etc.
;;; 4)  Get a buffer showing all the information on a given function.
;;; 5)  Read/write the documentation info from/to a file.
;;; 6)  Visit a function's definition (basically a regexp on the function's
;;;     name within the defining file).  Kind of like a tags visit, but
;;;     driven from its own info.
;;; 7)  Insert an (ANSI-compatible?) external decl of the function.  (Mostly
;;;     works :-)).
;;; 8)  Prompt for the arguments for a call to a given function, showing
;;;     argument types/names for each one.
;;; 9)  Complete the symbol in front of point from the function information.
;;;     (Like M-Tab, but again using its own table.)
;;; 10) Read a function definition from C source, prompt for documentation,
;;;     and add it to the list.
;;; 
;;; The key bindings I've supplied all start with \C-H\C-F, so they don't
;;; interfere with any standard key bindings to my knowledge.  There are doc
;;; strings for all(?) of the functions and variables.
;;; 
;;; I hope someone out there finds it useful.  Maybe some day, I'll get
;;; around to extending it for variables.  Send e-mail concerning bugs,
;;; suggestions, etc. to:
;;; 
;;; Internet: rmf@cs.columbia.edu
;;; UUCP:     ...!rutgers!cs.columbia.edu!rmf
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar module-list (list '("cmd"))
  "The list of currently defined module names.  See function-list.")

(defvar variable-list nil
  "The list of variable descriptors for currently defined variables.
For each variable, a descriptor of the following format is present:
  ( variable-name program-or-module-name file type doc-string )"
)

(defvar type-list nil
  "The list of type descriptors for currently defined types.
For each type, a descriptor of the following format is present:
  ( type-name program-or-module-name file type-decl doc-string )"
)

(defvar function-list nil
"The list of function descriptors for currently defined functions.
For each function, a descriptor of the following format is present:
  ( function-name program-or-module-name file result-type doc-string arg-list )
arg-list is a list of zero or more lists having the following format:
  ( type-spec arg-name doc-string )"
)

;;; Here's a sample function descriptor
;;; ("interaction_loop"
;;;		  "cmd"
;;;		  "cmd/cmds.c"
;;;		  "void"
;;;		  "Processes commands from file accessed by the file descriptor fd."
;;;		  ( ("int" "fd" "The command source file descriptor")
;;;			("int" "echo" "If non-zero, echo commands") )
;;;	)

(defun reset-func-list (&optional force)
  "Clear the function list.  Asks for confirmation unless prefix arg is given."
  (interactive)
  (if (or force (yes-or-no-p "Clear the function list? "))
	  (setq function-list nil))
)

(defun read-func-name (prompt &optional pred require-match init)
  "Reads a function name using the minibuffer, and providing completion.
PROMPT is the prompt to use, PREDICATE is an optional predicate which
limits the possible matches to a subset of function-list.  REQUIRE-MATCH
and INITIAL-INPUT are as for completing-read."
  (completing-read (or prompt "Function: ")
				   function-list
				   pred
				   require-match
				   init)
)

(defun add-module (module)
  (if (not (my-member (list module) module-list
					  (function (lambda (e1 e2) (string= (car e1) (car e2))))))
	  (setq module-list (cons (list module) module-list)))
)

(defun read-module-name (prompt &optional pred require-match init)
  "Reads a module name using the minibuffer, and providing completion.
PROMPT is the prompt to use, PREDICATE is an optional predicate which
limits the possible matches to a subset of the modules.  REQUIRE-MATCH
and INITIAL-INPUT are as for completing-read."
  (completing-read (or prompt "Module: ")
				   module-list
				   pred
				   require-match
				   init)
)

(defun func-entry (func)
  "Returns the entry in function-list for FUNCTION, a string."
  (if (stringp func)
	  (car (my-member func function-list
					  (function
					   (lambda (looking-for elt)
						 (string= looking-for (car elt)))))
	  )
	func
  )
)

(defun func-name (func)
  "Returns the name of function from FUNCTION_DESC, a function descriptor."
  (car func)
)

(defun func-module (func)
  "Returns the name of program/module containing FUNCTION.
FUNCTION may be either a string naming the function, or a function descriptor."
  (interactive (list (read-func-name "Module of what function: " nil t)))
  (nth 1 (if (stringp func)
			 (func-entry func)
		   func))
)

(defun func-file (func)
  "Returns the name of the file containing FUNCTION.
FUNCTION may be either a string naming the function, or a function descriptor."
  (interactive (list (read-func-name "File of what function: " nil t)))
  (nth 2 (if (stringp func)
			 (func-entry func)
		   func))
)

(defun func-result-type (func)
  "Returns the result type for FUNCTION.
FUNCTION may be either a string naming the function, or a function descriptor."
  (interactive (list (read-func-name "Result type of what function: " nil t)))
  (nth 3 (if (stringp func)
			 (func-entry func)
		   func))
)

(defun func-doc-string (func)
  "Returns the doc string for FUNCTION.
FUNCTION may be either a string naming the function, or a function descriptor."
  (interactive (list (read-func-name "Doc string of what function: " nil t)))
  (nth 4 (if (stringp func)
			 (func-entry func)
		   func))
)

(defun func-args (func)
  "Returns the args list for FUNCTION.
FUNCTION may be either a string naming the function, or a function descriptor."
  (interactive (list (read-func-name "Args of what function: " nil t)))
  (nth 5 (if (stringp func)
			 (func-entry func)
		   func))
)

(defun func-arg (func arg)
  "Returns the argument descriptor for the argument of FUNCTION named ARG.
ARG should be a string; FUNCTION may be either a descriptor or a name."
  (let ((f (if (stringp func) (func-entry func) func)))
	(car (my-member arg (func-args f)
					(function (lambda (a e) (string= (func-arg-name e) a)))))
  )
)

(defun func-arg-name (arg)
  (car arg)
)

(defun func-arg-type (arg)
  (cadr arg)
)

(defun func-arg-doc (arg)
  (caddr arg)
)

(defun call-func (func)
  "Prompts for parameters for call to FUNCTION, and inserts results in buffer.
FUNCTION may be either a string naming the function, or a function descriptor."
  (interactive (list (read-func-name "Call what function: " nil t)))
  (let* ((f (if (stringp func) (func-entry func) func))
		 (args (func-args f))
		 arg)
	(insert (car f) ?\()
	(while args
	  (setq arg (car args))
	  (setq args (cdr args))
	  (insert (read-string (format "Arg [%s:%s]: "
								   (func-arg-type arg)
								   (func-arg-name arg))))
	  (if args (insert ", "))
    )
	(insert ?\))
  )
)

(defun set-func-doc (func doc-string)
  "Sets the documentation string for FUNCTION to STRING.
FUNCTION may be a string naming the function or a function descriptor."
  (interactive
   (let (fn)
	 (list
	  (func-entry
	   (setq fn (read-func-name "Edit Doc String of what function: " nil t)))
	  (edit-string default-doc-string (format "*Doc of %s*" fn)))
   )
  )
  (setcar (cddddr func) doc-string)
)

;;; The following is obsolete, since set-func-doc has an interactive spec
;;; which allows editing.
(defun edit-func-doc (func)
  "Pops up a buffer editing the doc string for FUNCTION."
  (interactive
   (list
	(func-entry (read-func-name "Edit Doc String of what function: " nil t))
   )
  )
  (set-func-doc func
				(edit-string (func-doc-string func)
							 (format "*Doc of %s*" (func-name func))
							 t))
)

(defun read-arg-name (func prompt &optional pred require-match init-value)
  "Reads an argument name for FUNCTION using the minibuffer, and providing completion."
  (completing-read prompt (func-args func) pred require-match init-value)
)


(defun edit-arg-doc (func arg)
  "Pops up a buffer editing the info on the argument of FUNCTION named ARG."
  (interactive
	(let* ((f (func-entry (read-func-name "Arg of what function: " nil t)))
		   (fa (func-args f)))
	  (if (null fa) (error "Function '%s' has no arguments" (func-name f)))
	  (list f (func-arg f (read-arg-name f "Which argument: " nil t)))
	)
  )
  (message "Editing arg '%s' of '%s'" (func-arg-name arg) (func-name func))
  (setcar (cddr arg) (edit-string (func-arg-doc arg)
								  (format "*Doc of %s*" (func-arg-name arg))
								  t))
)

(defun print-func-info (func)
  "Pretty-prints the info in the descriptor for FUNCTION on standard-output.
Useful when used with with-output-to-temp-buffer."
  (let* ((f (if (stringp func) (func-entry func) func))
		 (args (func-args f)))
	(princ "Module:\t") (princ (func-module f)) (terpri)
	(princ "File:\t") (princ (func-file f)) (terpri)
	(terpri)
	(princ "Type:\t") (princ (func-result-type f)) (terpri)
	(princ "Name:\t") (princ (func-name f)) (princ "(")
	(princ (func-arg-name (car args)))
	(mapcar (function (lambda (a) (princ (concat "," (func-arg-name a)))))
			(cdr args))
	(princ ")")
	(terpri)
	(terpri)
	(mapcar-n '(lambda (arg i)
				 (princ (format "Arg %d:\t" i))
				 (princ (func-arg-type arg))
				 (princ "\t")
				 (princ (func-arg-name arg))
				 (terpri)
				 (princ (func-arg-doc arg))
				 (terpri) (terpri))
			  args
			  (iota (length args)))
	(terpri)
	(princ "Documentation:\n")
	(princ (func-doc-string f))
  )
)

(defun func-info (func)
  "Pops up a buffer showing full info for FUNCTION."
  (interactive (list (read-func-name "Info on what function: " nil t)))
  (with-output-to-temp-buffer "*Function info*"
	(print-func-info func)
  )
)

(defun princ-arg (arg &optional with-type)
  (+
   (if with-type
	   (let* ((type (func-arg-type arg))
			  (tl (length type)))
		 (princ (concat type
						(if (= (char-syntax (aref type (1- tl))) ?w) " ")))
		 tl
       )
	 0)
  (length (princ (func-arg-name arg))))
)

(defun princ-func-args (args &optional with-types)
  "Princ's ARG-LIST and returns the length of the printed representation."
  (princ "(")
  (prog1
	  (if args
		  (apply '+ 2
				 (princ-arg (car args) with-types)
				 (mapcar
				  (function
				   (lambda (a)
					 (princ ",")
					 (princ-arg a with-types)))
				  (cdr args))
          )
		2)
	(princ ")")
  )
)

(defun insert-extern (func)
  "Inserts an extern declaration for FUNCTION in front of point."
  (interactive (list
				(func-entry (read-func-name "Extern what function: " nil t))))
  (let ((standard-output (current-buffer)))
	(princ "extern ")
	(princ (func-result-type func))
	(princ " ")
	(princ (func-name func))
	(princ-func-args (func-args func) t)
	(princ ";\n")
  )
)

(defun insert-function (func with-block)
  "Inserts a definition for FUNCTION in front of point.
Optional 2nd arg (prefix arg if interactive) non-nil means insert a
definition block too."
  (interactive (list (read-func-name "Insert what function: " nil t)
					 current-prefix-arg))
  (let* ((f (func-entry func))
		 (res (func-result-type f))
		 (args (func-args f))
		 (standard-output (current-buffer)))
	(insert "/* " (func-name f) "()\n" (func-doc-string f) "\n*/\n")
	(insert res ?\n (car f))
	(princ-func-args args t)
	(insert "\n")
	(if with-block (insert "{\n}\n"))
  )
)

(defun set-func-file (func)
  (interactive (list (read-func-name "Set file for what function: " nil t)))
  (setcar (cddr (func-entry func))
		  (expand-file-name
		   (read-file-name (format "File containing %s: " func) nil t)))
)

(defun set-func-mod (func)
  (interactive (list (read-func-name "Set module for what function: " nil t)))
  (setcar (cdr (func-entry func))
		  (read-module-name (format "Module containing %s: " func)))
)

(defun visit-function (func)
  "Visits the file containing FUNCTION and places point on the definition."
  (interactive (list (read-func-name "Visit what function: " nil t)))
  (let ((f (func-entry func)))
	(find-file (or (func-file f)
				   (error "Function has no file")))
	(beginning-of-buffer)
	(re-search-forward (concat "^" (func-name f)))
  )
)

(defun kill-function (func)
  "Kills the definition of FUNCTION in function-list."
  (interactive (list (read-func-name "Kill what function: " nil t)))
  (setq function-list
		(filter function-list
				(function (lambda (e) (not (string= (func-name e) func))))))
)

(defvar default-doc-string
  "*Replace this with Documentation*"
  "A string which is the default documentation string for functions")

(defun define-function (fname module res doc args file)
  "Defines a function named FUNCTION in module MODULE.
The result type is RESULT.  4th arg DOCUMENTATION is the doc string.
5th arg is a list of argument descriptors, as described in function-list.
Last arg FILE is containing source file.  If interactive, a non-nil prefix arg
means don't associate function with this buffer's file."
  (interactive
   (let (fn)
	 (list
	  (setq fn (read-string "Define what function: "))
	  (read-string "Module: ")
	  (read-string "Result Type: ")
	  (edit-string default-doc-string (format "*Doc of %s*" fn) t)
	  (let (argl arg)
		(while (not (string= (setq arg (read-string "Arg: ")) ""))
		  (setq argl (cons
					  (list
					   arg
					   (read-string (format "Type of '%s': " arg))
					   (edit-string default-doc-string
									(format "*Doc for %s*" arg) t)
					   )
					  argl))
		  )
		argl
		)
	  (if (not current-prefix-arg)
		  (buffer-file-name))
	 )
   )
  )
;;; It would be really great to allow filling out a "form" in a
;;; separate buffer.  This could be init'ed with the current values of
;;; each field, so that some things could be left unspecified if desired.
;;; To do this, we just need an appropriate set of key bindings to be used
;;; when invoking edit-string.
  (add-module module)
  (setq function-list
		(cons (list fname module file res doc (reverse args))
			  function-list)
  )
)

(defconst brief-func-hdr
"
FUNCTION                                 MODULE      FILE
--------                                 ------      ----\n")

(defun brief-func-info (func &optional full-path)
  "Princ's brief info on FUNCTION to the standard output stream.
Optional 2nd arg FULL-PATH shows the containing file's full path name."
  (let ((fn (func-name func))
		(fm (func-module func))
		(fa (func-args func))
		(fi (func-file func))
		len)
	(setq len (+ (length (princ fn))
				 (princ-func-args fa)))
	(princ ":")
	;; This is a retarded way to print N spaces...
	(mapcar '(lambda (q) (princ " ")) (iota (- 40 len)))
	(princ fm)
	(mapcar '(lambda (q) (princ " ")) (iota (- 12 (length fm))))
	(princ (if full-path fi (file-name-nondirectory fi)))
	(terpri)
  )
)

(defun show-funcs-of-module (module &optional full-path)
  "Pops up a buffer showing brief info for all functions in MODULE.
Optional arg FULL-PATH (prefix arg if interactive) non-nil means show
full path of containing files."
  (interactive
   (list (read-module-name "Show functions of what module: " nil t)
		 current-prefix-arg)
  )
  (with-output-to-temp-buffer (format "*Functions of %s*" module)
	(princ brief-func-hdr)
	(mapcar (function (lambda (f) (brief-func-info f full-path)))
			(filter function-list
					(function (lambda (f) (string= module (func-module f))))))
  )
)

(defun show-funcs-of-file (file &optional full-path)
  "Pops up a buffer showing brief info for all functions in FILE.
Optional arg FULL-PATH (prefix arg if interactive) non-nil means show
full path of containing files."
  (interactive
   (list (expand-file-name
		  (read-file-name "Show functions of what file: " nil
						  (buffer-file-name (current-buffer))))
		 current-prefix-arg)
  )
  (with-output-to-temp-buffer (format "*Functions of %s*" file)
	(princ brief-func-hdr)
	(mapcar (function (lambda (f) (brief-func-info f full-path)))
			(filter function-list
					(function (lambda (f) (string= file (func-file f))))))
  )
)

(defun show-funcs (&optional full-path)
  "Pops up a buffer showing brief info for all functions currently defined.
Optional arg FULL-PATH (prefix arg if interactive) non-nil means show
full path of containing files."
  (interactive "P")
  (with-output-to-temp-buffer "*Functions*"
	(princ brief-func-hdr)
	(mapcar (function (lambda (f) (brief-func-info f full-path)))
			function-list)
  )
)

(defun write-funcs-to-file (module file)
  "Writes the functions associated with MODULE to a file.
If MODULE is a lone star ('*'), write the functions in all modules."
  (interactive
   (let* ((m (read-module-name "Write functions from what module: " nil t))
		  (df (if (string= m "*")
				  "FUNCTIONS"
				(concat (upcase m) "-FUNCTIONS"))))
	 (list m
		   (expand-file-name
			(read-file-name (format "Write to File [%s]: " df) nil df))
     )
   )
  )
  (let* ((buf (find-file-noselect file))
		 (standard-output buf))
	(if (string= module "*") (setq module ".*"))
	(set-buffer buf)
	(erase-buffer)
	(mapcar (function (lambda (f)
						(print-func-info f)
						(princ "\n\014\n")))
			(filter function-list
					(function (lambda (f) (string-match module (func-module f)))))
    )
	(save-buffer)
	(kill-buffer (current-buffer))
  )
)

(defconst arg-header "\n^Arg [0-9]+:\t")

(defvar func-symbol-chars "a-zA-Z0-9_"
  "A string giving the valid chars in a symbol, ala skip-chars-forward")

(defun read-args (pmax)
  "Reads function argument descriptions, and returns a list of descriptors.
PMAX is buffer position of end of argument info area."
  (let (args s e aname atype adoc)
	;; There are some arguments...
	(while (and (< (point) pmax) (re-search-forward arg-header pmax t))
	  (setq s (point))
	  (end-of-line)
	  (backward-word 1)
	  (setq aname (grab-word func-symbol-chars))
	  (setq atype (buffer-substring s (1- (point))))
	  (beginning-of-line 2)
	  (setq s (point))
	  (setq e (1- (save-excursion
					(if (re-search-forward arg-header pmax t)
						(match-beginning 0)
					  pmax))))
	  (setq adoc (buffer-substring s e))
	  ;; Got all the info -- add arg to list
	  (setq args (cons (list aname atype adoc) args))
    )
	(reverse args)
  )
)

(defun read-funcs-from-file (file)
  "Reads the function info in FILE, and installs them in function-list."
  (interactive "fRead Functions from what file: ")
  (let ((buf (find-file-noselect file))
		func fmod fn ft fargs fdoc argend docstart)
	(set-buffer buf)
	(beginning-of-buffer)
	(catch 'func-error
	  (while (not (eobp))
		(if (not (re-search-forward "^Module:\t" (point-max) t))
			(throw 'func-error nil))
		(setq fmod (grab-word func-symbol-chars))
		(if (not (re-search-forward "^File:\t" (point-max) t))
			(throw 'func-error nil))
		(setq fn (grab-word "-a-zA-Z/_."))
		(if (not (re-search-forward "^Type:\t" (point-max) t))
			(throw 'func-error nil))
		(setq ft (buffer-substring (point) (progn (end-of-line) (point))))
		(if (not (re-search-forward "^Name:\t" (point-max) t))
			(throw 'func-error nil))
		(setq func (grab-word func-symbol-chars))

		;; A function description is guaranteed to have a Documentation
		;; header, even if only for an empty doc string slot.
		(save-excursion
		  (if (re-search-forward "^Documentation:\n" (point-max) t)
			  (progn (setq argend (1- (match-beginning 0)))
					 (setq docstart (match-end 0)))
			(throw 'func-error nil)))
		(setq fargs (read-args argend))
		(setq fdoc (buffer-substring
					docstart
					(if (re-search-forward "^\014" (point-max) t)
						(1- (match-beginning 0))
					  (throw 'func-error nil))))
		(define-function func fmod ft fdoc fargs fn)
      )
    )
  )
)

(defun kill-arg (func arg)
  (interactive
   (let (f)
	 (list (setq f (read-func-name "Kill arg of what function: " nil t))
		   (read-arg-name f "Kill what arg: " nil t))
   )
  )
  (setcar (cdddddr (func-entry func))
		  (filter (func-args func)
				  (function (lambda (a) (string= (func-arg-name a) arg)))))
)

(defun set-func-type (func type)
  "Sets the result type of FUNCTION to TYPE."
  (interactive
   (let (f)
	 (list (setq f (func-entry
					(read-func-name "Set type of what function: " nil t)))
		   (read-string (format "Result Type of %s: " (func-name f))
						(func-result-type f)))
   )
  )
  (setcar (cdddr func) type)
)

(defun set-arg-type (func arg type)
  "Sets the type of FUNCTION's argument ARG to TYPE."
  (interactive
   (let (f a)
	 (list (setq f (read-func-name "Set arg type of what function: " nil t))
		   (setq a
				 (func-arg f
						   (read-arg-name f "Set type of what arg: " nil t)))
		   (read-string (format "Type of %s: " (func-arg-name a))
						(func-arg-type a)))
   )
  )
  (setcar (cdr arg) type)
)

(defun nab-function (fmod)
  "Defines a function in function-list from the definition starting at point."
  (interactive
   (list (read-module-name "Add function to what module: ")))
  (let (ft fn fdoc fa argend an at ad)
	(setq ft (grab-re "^.*$"))
	(beginning-of-line 2)
	(setq fn (grab-word))
	(beginning-of-line 2)
	(setq argend (save-excursion (end-of-defun) (backward-sexp 1) (point)))
	(while (and (< (point) argend)
				(re-search-forward "[,;]" argend t))
	  (save-excursion
		(backward-sexp 1)
		(setq an (grab-word))
		;; Would be nice to trim off trailing blanks of arg type...
		(setq at (buffer-substring
				  (save-excursion (beginning-of-line) (point))
				  (point)))
	  )
	  (setq adoc (edit-string default-doc-string
							  (format "*Doc for %s*" an) t))
	  (setq fa (cons (list an at adoc) fa))
    )
	(setq fdoc (edit-string default-doc-string
							(format "*Doc for %s*" fn) t))
	(define-function fn fmod ft fdoc fa (buffer-file-name (current-buffer)))
  )
)

(defun func-pred (e)
;;; Relies on 'prefix being bound to the prefix of the function name
;;; See documentation for do-completion.
  "A predicate for determining whether FUNCTION-DESC is a match for 'prefix."
  (string-match prefix (func-name e))
)

(defun do-completion (syms &optional pred)
  "Completes the symbol before point from SYMBOL-LIST.
Optional 2nd arg PREDICATE to detect match.  PREDICATE can find the prefix of
the symbol bound to 'prefix."
  (interactive)
  (let* ((pref-end (point))
		 (pref-start
		  (cond ((= (char-syntax (char-after (1- pref-end))) ?w)
				 (save-excursion
				   (and (re-search-backward "\\<" (point-min) t) (point))))
				(t pref-end)))
		 (prefix (buffer-substring pref-start pref-end))
		 sym)
	(progn
	  (setq sym (try-completion prefix syms
								(or pred
									'(lambda (e)
									   (string-match prefix (car e))))))
	  (cond ((eq sym t)) ; Do nothing -- exact match
			((null sym)
			 (message "No completion for '%s'" prefix)
			 (beep))
			((string= prefix sym)
			 (setq sym (completing-read
						"Symbol: " syms
						(or pred
							'(lambda (e) (string-match prefix (car e)))
							t prefix)))
			)
	  )
	  (cond ((stringp sym)
			 (delete-region pref-start pref-end)
			 (insert-string sym)))
    )
  )
)

(defun complete-func ()
  "Completes the function whose name starts before point from function-list."
  (interactive)
  (do-completion function-list 'func-pred)
)

(setq function-map (list 'keymap
						 '(?\t . complete-func)
						 '(?a . set-arg-type)
						 '(?A . edit-arg-doc)
						 '(?c . call-func)
						 '(?d . define-function)
						 '(?e . insert-extern)
						 '(?f . show-funcs)
						 '(?F . show-funcs-of-file)
						 '(?i . insert-function)
						 '(?k . kill-function)
						 '(?m . show-funcs-of-module)
						 '(?M . set-func-mod)
						 '(?n . nab-function)
						 '(?r . read-funcs-from-file)
						 '(?R . reset-func-list)
						 '(?s . set-func-doc)
						 '(?S . set-func-file)
						 '(?t . set-func-type)
						 '(?v . visit-function)
						 '(?w . write-funcs-to-file)
						 '(?? . func-info)
				   )
)

(define-key help-map "\C-f" function-map)
