--- a/lisp/packages/hyper-apropos.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/packages/hyper-apropos.el	Mon Aug 13 09:02:59 2007 +0200
@@ -54,7 +54,6 @@
 ;; additions by Ben Wing <wing@666.com> July 1995:
 ;; added support for function aliases, made programmer's apropos be the
 ;; default, various other hacking.
-;; Massive changes by Christoph Wedler <wedler@fmi.uni-passau.de>
 
 ;;; Code:
 
@@ -68,9 +67,6 @@
   "*If non-nil, `hyper-apropos' will display some documentation in the
 \"*Hyper Apropos*\" buffer.  Setting this to nil will speed up searches.")
 
-(defvar hypropos-shrink-window nil
-  "*If non-nil, shrink *Hyper Help* buffer if possible.")
-
 (defvar hypropos-prettyprint-long-values t
   "*If non-nil, then try to beautify the printing of very long values.")
 
@@ -81,7 +77,6 @@
 output.  If nil, then only functions that are interactive and variables that
 are user variables are found by `hyper-apropos'.")
 
-(defvar hypropos-ref-buffer)
 (defvar hypropos-prev-wconfig)
 
 ;; #### - move this to subr.el
@@ -157,8 +152,6 @@
 			    ;; movement
 			    (define-key map " "     'scroll-up)
 			    (define-key map "b"     'scroll-down)
-			    (define-key map [delete] 'scroll-down)
-			    (define-key map [backspace] 'scroll-down)
 			    (define-key map "/"     'isearch-forward)
 			    (define-key map "?"     'isearch-backward)
 			    ;; follow links
@@ -181,11 +174,9 @@
 (defvar hypropos-map (let ((map (make-sparse-keymap)))
 		       (set-keymap-name map 'hypropos-map)
 		       (set-keymap-parents map (list hypropos-help-map))
-		       ;; slightly different scrolling...
+		       ;; slightly differrent scrolling...
 		       (define-key map " "     'hypropos-scroll-up)
 		       (define-key map "b"     'hypropos-scroll-down)
-		       (define-key map [delete] 'hypropos-scroll-down)
-		       (define-key map [backspace] 'hypropos-scroll-down)
 		       ;; act on the current line...
 		       (define-key map "w"     'hypropos-where-is)
 		       (define-key map "i"     'hypropos-invoke-fn)
@@ -210,10 +201,6 @@
 (defvar hypropos-currently-showing nil)	; symbol documented in help buffer now
 (defvar hypropos-help-history nil)	; chain of symbols followed as links in
 					; help buffer
-(defvar hypropos-face-history nil)
-;;;(defvar hypropos-variable-history nil)
-;;;(defvar hypropos-function-history nil)
-(defvar hypropos-regexp-history nil)
 (defvar hypropos-last-regexp nil)	; regex used for last apropos
 (defconst hypropos-apropos-buf "*Hyper Apropos*")
 (defconst hypropos-help-buf "*Hyper Help*")
@@ -224,9 +211,7 @@
 in buffer \"*Hyper Apropos*\".  If optional prefix arg is given, then the value
 of `hypropos-programming-apropos' is toggled for this search.
 See also `hyper-apropos-mode'."
-  (interactive (list (read-from-minibuffer "List symbols matching regexp: "
-					   nil nil nil 'hypropos-regexp-history)
-		     current-prefix-arg))
+  (interactive "sList symbols matching regexp: \nP")
   (or (memq major-mode '(hyper-apropos-mode hyper-help-mode))
       (setq hypropos-prev-wconfig (current-window-configuration)))
   (if (string= "" regexp)
@@ -270,7 +255,7 @@
   (hyper-apropos hypropos-last-regexp nil))
 
 (defun hypropos-grok-functions (fns)
-  (let (fn bind doc type)
+  (let (fn bind type)
     (while (setq fn (car fns))
       (setq bind (symbol-function fn)
 	    type (cond ((subrp bind) ?i)
@@ -284,30 +269,36 @@
       (insert type (if (commandp fn) "* " "  "))
       (insert-face (format "%-30S" fn) 'hyperlink)
       (and hypropos-show-brief-docs
-	   (setq doc (documentation fn))
-	   (insert-face (if doc
-			    (concat " - "
-				    (substring doc 0 (string-match "\n" doc)))
-			  " Not documented.")
-			'documentation))
+	   (if (function-obsolete-p fn)
+	       (insert-face " - Obsolete." 'documentation)
+	     (let ((doc (documentation fn)))
+	       (if (not doc)
+		   (insert-face " - Not documented." 'documentation)
+		 (insert-face (concat " - "
+				      (substring doc 0
+						 (string-match "\n" doc)))
+			      'documentation)))))
       (insert ?\n)
       (setq fns (cdr fns))
       )))
 
 (defun hypropos-grok-variables (vars)
-  (let (var doc userp)
+  (let (var userp)
     (while (setq var (car vars))
       (setq userp (user-variable-p var)
 	    vars (cdr vars))
       (insert (if userp " * " "   "))
       (insert-face (format "%-30S" var) 'hyperlink)
       (and hypropos-show-brief-docs
-	   (setq doc (documentation-property var 'variable-documentation))
-	   (insert-face (if doc
-			    (concat " - " (substring doc (if userp 1 0)
-						     (string-match "\n" doc)))
-			  " - Not documented.")
-			'documentation))
+	   (if (variable-obsolete-p var)
+	       (insert-face " - Obsolete." 'documentation)
+	     (let ((doc (documentation-property var 'variable-documentation)))
+	       (if (not doc)
+		   (insert-face " - Not documented." 'documentation)
+		 (insert-face (concat " - "
+				      (substring doc (if userp 1 0)
+						 (string-match "\n" doc)))
+			      'documentation)))))
       (insert ?\n)
       )))
 
@@ -345,267 +336,74 @@
 	buffer-read-only t
 	truncate-lines t
 	hypropos-last-regexp regexp
-	modeline-buffer-identification
-	(list (cons modeline-buffer-id-left-extent "Hyper Apropos: ")
-	      (cons modeline-buffer-id-right-extent (concat "\"" regexp "\""))))
+	modeline-buffer-identification (concat "Hyper Apropos: "
+					       "\"" regexp "\""))
   (setq mode-motion-hook 'mode-motion-highlight-line)
   (use-local-map hypropos-map)
   (run-hooks 'hyper-apropos-mode-hook))
 
 ;; ---------------------------------------------------------------------- ;;
 
-;; similar to `describe-key-briefly', copied from prim/help.el by CW
-
 ;;;###autoload
-(defun hyper-describe-key (key)
-  (interactive "kDescribe key: ")
-  (hyper-describe-key-briefly key t))
-
-;;;###autoload
-(defun hyper-describe-key-briefly (key &optional show)
-  (interactive "kDescribe key briefly: \nP")
-  (let (menup defn interm final msg)
-    (setq defn (key-or-menu-binding key 'menup))    
-    (if (or (null defn) (integerp defn))
-        (or (numberp show) (message "%s is undefined" (key-description key)))
-      (cond ((stringp defn)
-	     (setq interm defn
-		   final (key-binding defn)))
-	    ((vectorp defn)
-	     (setq interm (append defn nil))
-	     (while (and interm
-			 (member (key-binding (vector (car interm)))
-				 '(universal-argument digit-argument)))
-	       (setq interm (cdr interm)))
-	     (while (and interm
-			 (not (setq final (key-binding (vconcat interm)))))
-	       (setq interm (butlast interm)))
-	     (if final
-		 (setq interm (vconcat interm))
-	       (setq interm defn 
-		     final (key-binding defn)))))
-      (setq msg (format
-		 "%s runs %s%s%s"
-		 ;; This used to say 'This menu item' but it could also
-		 ;; be a scrollbar event.  We can't distinguish at the
-		 ;; moment.
-		 (if menup "This item" (key-description key))
-		 ;;(if (symbolp defn) defn (key-description defn))
-		 (if (symbolp defn) defn (prin1-to-string defn))
-		 (if final (concat ", " (key-description interm) " runs ") "")
-		 (if final
-		     (if (symbolp final) final (prin1-to-string final))
-		   "")))
-      (if (numberp show)
-	  (or (not (symbolp defn))
-	      (memq (symbol-function defn)
-		    '(zkey-init-kbd-macro zkey-init-kbd-fn))
-	      (progn (princ msg) (princ "\n")))
-	(message "%s" msg)
-	(if final (setq defn final))
-	(if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn))))
-		 defn
-		 show)
-	    (hypropos-get-doc defn t))))))
-
-;;;###autoload
-(defun hyper-describe-face (symbol &optional this-ref-buffer)
-  "Describe face..
-See also `hyper-apropos' and `hyper-describe-function'."
-  ;; #### - perhaps a prefix arg should suppress the prompt...
-  (interactive
-   (let (v val)
-     (setq v (hypropos-this-symbol))	; symbol under point
-     (or (find-face v)
-	 (setq v (variable-at-point)))
-     (setq val (let ((enable-recursive-minibuffers t))
-                 (completing-read
-		  (concat (if (hypropos-follow-ref-buffer current-prefix-arg)
-			      "Follow face"
-			    "Describe face")
-			  (if v
-			      (format " (default %s): " v)
-			    ": "))
-		  (mapcar (function (lambda (x) (list (symbol-name x))))
-			  (face-list))
-		  nil t nil 'hypropos-face-history)))
-     (list (if (string= val "")
-	       (progn (push (symbol-name v) hypropos-face-history) v)
-	     (intern-soft val))
-	   current-prefix-arg)))
-  (if (null symbol)
-      (message "Sorry, nothing to describe.")
-    (or (memq major-mode '(hyper-apropos-mode hyper-help-mode))
-	(setq hypropos-prev-wconfig (current-window-configuration)))
-    (hypropos-get-doc symbol t nil this-ref-buffer)))
-
-;;;###autoload
-(defun hyper-describe-variable (symbol &optional this-ref-buffer)
+(defun hyper-describe-variable (symbol)
   "Hypertext drop-in replacement for `describe-variable'.
 See also `hyper-apropos' and `hyper-describe-function'."
   ;; #### - perhaps a prefix arg should suppress the prompt...
-  (interactive (list (hypropos-read-variable-symbol
-		      (if (hypropos-follow-ref-buffer current-prefix-arg)
-			  "Follow variable"
-			"Describe variable"))
-		     current-prefix-arg))
-  (if (null symbol)
-      (message "Sorry, nothing to describe.")
-    (or (memq major-mode '(hyper-apropos-mode hyper-help-mode))
-	(setq hypropos-prev-wconfig (current-window-configuration)))
-    (hypropos-get-doc symbol t nil this-ref-buffer)))
-
-(defun hyper-where-is (symbol)
-  "Print message listing key sequences that invoke specified command."
-  (interactive (list (hypropos-read-function-symbol "Where is function")))
-  (if (null symbol)
-      (message "Sorry, nothing to describe.")
-    (where-is symbol)))
-
-;;;###autoload
-(defun hyper-describe-function (symbol &optional this-ref-buffer)
-  "Hypertext replacement for `describe-function'.  Unlike `describe-function'
-in that the symbol under the cursor is the default if it is a function.
-See also `hyper-apropos' and `hyper-describe-variable'."
-  ;; #### - perhaps a prefix arg should suppress the prompt...
-  (interactive (list (hypropos-read-function-symbol
-		      (if (hypropos-follow-ref-buffer current-prefix-arg)
-			  "Follow function"
-			"Describe function"))
-		     current-prefix-arg))
+  (interactive 
+   (let* ((v (variable-at-point))
+          (val (let ((enable-recursive-minibuffers t))
+                 (completing-read
+		  (if v
+		      (format "Describe variable (default %s): " v)
+		    "Describe variable: ")
+		  obarray 'boundp t))))
+     (list (if (string= val "") v (intern-soft val)))))
   (if (null symbol)
       (message "Sorry, nothing to describe.")
     (or (memq major-mode '(hyper-apropos-mode hyper-help-mode))
 	(setq hypropos-prev-wconfig (current-window-configuration)))
-    (hypropos-get-doc symbol t nil this-ref-buffer)))
+    (hypropos-get-doc symbol t)))
 
 ;;;###autoload
-(defun hypropos-read-variable-symbol (prompt &optional predicate)
-  "Hypertext drop-in replacement for `describe-variable'.
-See also `hyper-apropos' and `hyper-describe-function'."
+(defun hyper-describe-function (symbol)
+  "Hypertext replacement for `describe-function'.  Unlike `describe-function'
+in that the symbol under the cursor is the default if it is a function.
+See also `hyper-apropos' and `hyper-describe-variable'."
   ;; #### - perhaps a prefix arg should suppress the prompt...
-  (or predicate (setq predicate 'boundp))
-  (let (v val)
-    (setq v (hypropos-this-symbol))	; symbol under point
-    (or (funcall predicate v)
-	(setq v (variable-at-point)))
-    (or (funcall predicate v)
-	(setq v nil))
-    (setq val (let ((enable-recursive-minibuffers t))
-		(completing-read
-		 (concat prompt
-			 (if v
-			     (format " (default %s): " v)
-			   ": "))
-		 obarray predicate t nil 'variable-history)))
-    (if (string= val "")
-	(progn (push (symbol-name v) variable-history) v)
-      (intern-soft val))))
-
-(defun hypropos-read-function-symbol (prompt)
-  "Read function symbol from minibuffer."
-  (let ((fn (hypropos-this-symbol))
-	val)
-    (or (fboundp fn)
-	(setq fn (function-called-at-point)))
-    (setq val (let ((enable-recursive-minibuffers t))
-		(completing-read (if fn
-				     (format "%s (default %s): " prompt fn)
-				   (format "%s: " prompt))
-				 obarray 'fboundp t nil
-				 'function-history)))
-    (if (equal val "")
-	(progn (push (symbol-name fn) function-history) fn)
-      (intern-soft val))))
+  (interactive
+   (let (fn val)
+     (setq fn (hypropos-this-symbol))	; symbol under point
+     (or (fboundp fn)
+	 (setq fn (function-called-at-point)))
+     (setq val (let ((enable-recursive-minibuffers t))
+		 (completing-read
+		  (if fn 
+		      (format "Describe function (default %s): " fn)
+		    "Describe function: ")
+		  obarray 'fboundp t)))
+     (list (if (equal val "") fn (intern-soft val)))))
+  (if (null symbol)
+      (message "Sorry, nothing to describe.")
+    (or (memq major-mode '(hyper-apropos-mode hyper-help-mode))
+	(setq hypropos-prev-wconfig (current-window-configuration)))
+    (hypropos-get-doc symbol t)))
 
 (defun hypropos-last-help (arg)
   "Go back to the last symbol documented in the *Hyper Help* buffer."
   (interactive "P")
-  (let ((win (get-buffer-window hypropos-help-buf)))
-    (or arg (setq arg (if win 1 0)))
-    (cond ((= arg 0))
-	  ((<= (length hypropos-help-history) arg)
+  (let ((win (get-buffer-window hypropos-help-buf))
+	(n (prefix-numeric-value arg)))
+    (cond ((and (not win) (not arg))
+	   ;; don't alter the help-history, just redisplay
+	   )
+	  ((<= (length hypropos-help-history) n)
 	   ;; go back as far as we can...
 	   (setcdr (nreverse hypropos-help-history) nil))
 	  (t
-	   (setq hypropos-help-history (nthcdr arg hypropos-help-history))))
-    (if (or win (> arg 0))
-	(hypropos-get-doc (car hypropos-help-history) t)
-      (display-buffer hypropos-help-buf))))
-
-(defun hypropos-insert-face (string &optional face)
-  "Insert STRING and fontify some parts with face `hyperlink'."
-  (let ((beg (point)) end)
-    (insert-face string (or face 'documentation))
-    (setq end (point))
-    (goto-char beg)
-    (while (re-search-forward
-	    "`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'"
-	    end 'limit)
-      (set-extent-face (make-extent (match-beginning 1) (match-end 1))
-		       'hyperlink))
-    (goto-char beg)
-    (while (re-search-forward
-	    "M-x \\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)"
-	    end 'limit)
-      (set-extent-face (make-extent (match-beginning 1) (match-end 1))
-		       'hyperlink))))
-
-(defun hypropos-insert-keybinding (keys string)
-  (if keys
-      (insert "  (" string " bound to \""
-	      (mapconcat 'key-description
-			 (sort keys #'(lambda (x y)
-					(< (length x) (length y))))
-			 "\", \"")
-	      "\")\n")))
+	   (setq hypropos-help-history (nthcdr n hypropos-help-history))))
+    (hypropos-get-doc (car hypropos-help-history) t)))
 
-(defun hypropos-insert-section-heading (alias-desc &optional desc)
-  (or desc (setq desc alias-desc
-		 alias-desc nil))
-  (if alias-desc
-      (setq desc (concat alias-desc
-			 (if (memq (aref desc 0)
-				   '(?a ?e ?i ?o ?u))
-			     ", an " ", a ")
-			 desc)))
-  (aset desc 0 (upcase (aref desc 0))) ; capitalize
-  (goto-char (point-max))
-  (newline 3) (delete-blank-lines) (newline 2)
-  (hypropos-insert-face desc 'section-heading))
-
-(defun hypropos-insert-value (string symbol val)
-  (insert-face string 'heading)
-  (insert (if (symbol-value symbol)
-	      (if (or (null val) (eq val t) (integerp val))
-		  (prog1
-		      (symbol-value symbol)
-		    (set symbol nil))
-		"see below")
-	    "is void")))
-
-(defun hypropos-follow-ref-buffer (this-ref-buffer) 
-  (and (not this-ref-buffer)
-       (eq major-mode 'hyper-help-mode)
-       hypropos-ref-buffer
-       (buffer-live-p hypropos-ref-buffer)))
-
-(defun hypropos-get-alias (symbol alias-p next-symbol &optional use)
-  "Return (TERMINAL-SYMBOL . ALIAS-DESC)."
-  (let (aliases)
-    (while (funcall alias-p symbol)
-      (setq aliases (cons (if use (funcall use symbol) symbol) aliases))
-      (setq symbol (funcall next-symbol symbol)))
-    (cons symbol
-	  (and aliases
-	       (concat "an alias for `"
-		       (mapconcat 'symbol-name
-				  (nreverse aliases)
-				  "',\nwhich is an alias for `")
-		       "'")))))
-
-;;;###autoload
-(defun hypropos-get-doc (&optional symbol force type this-ref-buffer)
+(defun hypropos-get-doc (&optional symbol force type)
   ;; #### - update this docstring
   "Toggle display of documentation for the symbol on the current line."
   ;; SYMBOL is the symbol to document.  FORCE, if non-nil, means to
@@ -637,291 +435,167 @@
 		;; otherwise clear the history because it's a new search.
 		(list symbol))))
     (save-excursion
-      (if (hypropos-follow-ref-buffer this-ref-buffer)
-	  (set-buffer hypropos-ref-buffer)
-	(setq hypropos-ref-buffer (current-buffer)))
-      (let (standard-output
-	    ok beg
-	    newsym symtype doc obsolete
-	    (local mode-name)
-	    global local-str global-str
-	    font fore back undl
-	    aliases alias-desc desc)
-	(save-excursion
-	  (set-buffer (get-buffer-create hypropos-help-buf))
-	  ;;(setq standard-output (current-buffer))
-	  (setq buffer-read-only nil)
-	  (erase-buffer)
-	  (insert-face (format "`%s'" symbol) 'major-heading)
-	  (insert (format " (buffer: %s, mode: %s)\n"
-			  (buffer-name hypropos-ref-buffer)
-			  local)))
-	;; function ----------------------------------------------------------
+      (set-buffer (get-buffer-create hypropos-help-buf))
+      (setq buffer-read-only nil)
+      (erase-buffer)
+      (let ((standard-output (current-buffer))
+	    ok beg desc
+	    ftype macrop fndef
+	    keys val doc
+	    obsolete aliases alias-desc)
+	(insert-face (format "`%s'\n\n" symbol) 'major-heading)
 	(and (memq 'function type)
 	     (fboundp symbol)
-	     (progn
-	       (setq ok t)
-	       (setq aliases (hypropos-get-alias (symbol-function symbol)
-						 'symbolp
-						 'symbol-function)
-		     newsym (car aliases)
-		     alias-desc (cdr aliases))
-	       (if (eq 'macro (car-safe newsym))
-		   (setq desc "macro"
-			 newsym (cdr newsym))
-		 (setq desc "function"))
-	       (setq symtype (cond ((subrp newsym)                   'subr)
-				   ((compiled-function-p newsym)     'bytecode)
-				   ((eq (car-safe newsym) 'autoload) 'autoload)
-				   ((eq (car-safe newsym) 'lambda)   'lambda))
+	     (progn 
+	       (setq ok t
+		     fndef (symbol-function symbol))
+	       (while (symbolp fndef)
+		 (setq aliases (cons fndef aliases))
+		 (setq fndef (symbol-function fndef)))
+	       (if (eq 'macro (car-safe fndef))
+		   (setq macrop t
+			 fndef (cdr fndef)))
+	       (setq aliases (nreverse aliases))
+	       ;; #### - the gods of internationalization shall strike me down!
+	       (while aliases
+		 (if alias-desc
+		     (setq alias-desc (concat alias-desc ",\nwhich is ")))
+		 (setq alias-desc (concat alias-desc
+					  (format "an alias for `%s'"
+						  (car aliases))))
+		 (setq aliases (cdr aliases)))
+	       (setq ftype (cond ((subrp fndef)                   'subr)
+				 ((compiled-function-p fndef)     'bytecode)
+				 ((eq (car-safe fndef) 'autoload) 'autoload)
+				 ((eq (car-safe fndef) 'lambda)	  'lambda))
 		     desc (concat (if (commandp symbol) "interactive ")
-				  (cdr (assq symtype
+				  (cdr (assq ftype
 					     '((subr     . "built-in ")
 					       (bytecode . "compiled Lisp ")
 					       (autoload . "autoloaded Lisp ")
 					       (lambda   . "Lisp "))))
-				  desc)
-		     local (current-local-map)
-		     global (current-global-map)
-		     obsolete (get symbol 'byte-obsolete-info)
+				  (if macrop "macro" "function")
+				  ))
+	       (if alias-desc
+		   (setq desc (concat alias-desc
+				      (if (memq (aref desc 0)
+						'(?a ?e ?i ?o ?u))
+					  ", an " ", a ")
+				      desc)))
+	       (aset desc 0 (upcase (aref desc 0))) ; capitalize
+	       (insert-face desc 'section-heading)
+	       (and (eq ftype 'autoload)
+		    (insert (format ", (autoloaded from \"%s\")"
+				    (nth 1 fndef))))
+	       ;; #### - should also show local binding in some other
+	       ;; buffer so that this function can be used in place of
+	       ;; describe-function and describe-variable.
+	       (if (setq keys (where-is-internal symbol (current-global-map)
+						 nil nil nil))
+		   (insert (format ", (globally bound to %s)"
+				   (mapconcat
+				    #'(lambda (x)
+					(format "\"%s\""
+						(key-description x)))
+				    (sort keys #'(lambda (x y)
+						   (< (length x) (length y))))
+				    ", "))))
+	       (insert ":\n\n")
+	       (setq beg (point)
 		     doc (or (documentation symbol) "function not documented"))
-	       (save-excursion
-		 (set-buffer hypropos-help-buf)
-		 (goto-char (point-max))
-		 (setq standard-output (current-buffer))
-		 (hypropos-insert-section-heading alias-desc desc)
-		 (and (eq symtype 'autoload)
-		      (insert (format ", (autoloaded from \"%s\")"
-				      (nth 1 newsym))))
-		 (insert ":\n")
-		 (if local
-		     (hypropos-insert-keybinding
-		      (where-is-internal symbol (list local) nil nil nil)
-		      "locally"))
-		 (hypropos-insert-keybinding
-		  (where-is-internal symbol (list global) nil nil nil)
-		  "globally")
-		 (insert "\n")
-		 (if obsolete
-		     (hypropos-insert-face
-		      (format "%s is an obsolete function; %s\n\n" symbol
-			      (if (stringp (car obsolete))
-				  (car obsolete)
-				(format "use `%s' instead." (car obsolete))))
-		      'warning))
-		 (setq beg (point))
-		 (insert-face "arguments: " 'heading)
-		 (cond ((eq symtype 'lambda)
-			(princ (or (nth 1 newsym) "()")))
-		       ((eq symtype 'bytecode)
-			(princ (or (aref newsym 0) "()")))
-		       ((and (eq symtype 'subr)
-			     (string-match
-			      "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'"
-			      doc))
-			(insert (substring doc
-					   (match-beginning 1)
-					   (match-end 1)))
-			(setq doc (substring doc 0 (match-beginning 0))))
-		       ((and (eq symtype 'subr)
-			     (string-match
-			      "[\n\t ]*([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)"
-			      doc))
-			(insert "("
-				(if (match-end 1)
-				    (substring doc
-					       (match-beginning 1)
-					       (match-end 1)))
-				")")
-			(setq doc (substring doc (match-end 0))))
-		       (t (princ "[not available]")))
-		 (insert "\n\n")
-		 (hypropos-insert-face doc)
-		 (insert "\n")
-		 (indent-rigidly beg (point) 2))))
-	;; variable ----------------------------------------------------------
+	       (insert-face "arguments: " 'heading)
+	       (cond ((eq ftype 'lambda)
+		      (princ (or (nth 1 fndef) "()")))
+		     ((eq ftype 'bytecode)
+		      (princ (or (if (fboundp 'compiled-function-arglist)
+				     (compiled-function-arglist fndef)
+				   (aref fndef 0)) "()")))
+		     ((and (eq ftype 'subr)
+			   (string-match
+			    "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'"
+			    doc))
+		      (insert (substring doc
+					 (match-beginning 1)
+					 (match-end 1)))
+		      (setq doc (substring doc 0 (match-beginning 0))))
+		     (t (princ "[not available]")))
+	       (insert "\n\n")
+	       (let ((new
+		      ;; cookbook from bytecomp.el
+		      (get symbol 'byte-obsolete-info)))
+		 (and new
+		      (insert-face
+		       (format "%s is an obsolete function; %s\n\n" symbol
+			       (if (stringp (car new))
+				   (car new)
+				 (format "use %s instead." (car new))))
+		       'warning)))
+	       (insert-face doc 'documentation)
+	       (indent-rigidly beg (point) 1)
+	       (insert"\n\n")
+	       ))
 	(and (memq 'variable type)
-	     (or (boundp symbol) (default-boundp symbol))
+	     (boundp symbol)
 	     (progn 
 	       (setq ok t)
-	       (setq aliases (hypropos-get-alias symbol
-						 'variable-alias
-						 'variable-alias
-						 'variable-alias)
-		     newsym (car aliases)
-		     alias-desc (cdr aliases))
-	       (setq symtype (or (local-variable-p newsym (current-buffer))
-				 (and (local-variable-p newsym
-							(current-buffer) t)
-				      'auto-local))
-		     desc (concat (if (user-variable-p newsym)
-				      "user variable"
-				    "variable")
-				  (cond ((eq symtype t) ", buffer-local")
-					((eq symtype 'auto-local)
-					 ", local when set")))
-		     local (and (boundp newsym)
-				(symbol-value newsym))
-		     local-str (and (boundp newsym)
-				    (prin1-to-string local))
-		     global (and (eq symtype t)
-				 (default-boundp newsym)
-				 (default-value newsym))
-		     global-str (and (eq symtype t)
-				     (default-boundp newsym)
-				     (prin1-to-string global))
-		     obsolete (get symbol 'byte-obsolete-variable)
-		     doc (or (documentation-property symbol
-						     'variable-documentation)
+	       (insert-face (if (user-variable-p symbol)
+				"User variable"
+			      "Variable")
+			    'section-heading)
+	       (and (local-variable-p symbol nil t)
+		    (insert ", local when set"))
+	       (insert ":\n\n")
+	       (setq beg (point)
+		     val (prin1-to-string (symbol-value symbol))
+		     doc (or (documentation-property
+			      symbol 'variable-documentation)
 			     "variable not documented"))
-	       (save-excursion
-		 (set-buffer hypropos-help-buf)
-		 (goto-char (point-max))
-		 (setq standard-output (current-buffer))
-		 (hypropos-insert-section-heading alias-desc desc)
-		 (insert ":\n\n")
-		 (setq beg (point))
-		 (if obsolete
-		     (hypropos-insert-face
-		      (format "%s is an obsolete function; %s\n\n" symbol
-			      (if (stringp obsolete)
-				  obsolete
-				(format "use `%s' instead." obsolete)))
-		      'warning))
-		 ;; generally, the value of the variable is short and the
-		 ;; documentation of the variable long, so it's desirable
-		 ;; to see all of the value and the start of the
-		 ;; documentation.  Some variables, though, have huge and
-		 ;; nearly meaningless values that force you to page
-		 ;; forward just to find the doc string.  That is
-		 ;; undesirable.
-		 (if (and (or (null local-str) (< (length local-str) 69))
-			  (or (null global-str) (< (length global-str) 69)))
-					; 80 cols.  docstrings assume this.
-		     (progn (insert-face "value: " 'heading)
-			    (insert (or local-str "is void"))
-			    (if (eq symtype t)
-				(progn
-				  (insert "\n")
-				  (insert-face "default value: " 'heading)
-				  (insert (or global-str "is void"))))
-			    (insert "\n\n")
-			    (hypropos-insert-face doc))
-		   (hypropos-insert-value "value: " 'local-str local)
-		   (if (eq symtype t)
-		       (progn
-			 (insert ", ")
-			 (hypropos-insert-value "default-value: "
-						'global-str global)))
-		   (insert "\n\n")
-		   (hypropos-insert-face doc)
-		   (if local-str
-		       (progn
-			 (newline 3) (delete-blank-lines) (newline 1)
-			 (insert-face "value: " 'heading)
-			 (if hypropos-prettyprint-long-values
-			     (condition-case nil
-				 (let ((pp-print-readably nil)) (pprint local))
-			       (error (insert local-str)))
-			   (insert local-str))))
-		   (if global-str
-		       (progn
-			 (newline 3) (delete-blank-lines) (newline 1)
-			 (insert-face "default value: " 'heading)
-			 (if hypropos-prettyprint-long-values
-			     (condition-case nil
-				 (let ((pp-print-readably nil)) (pprint global))
-			       (error (insert global-str)))
-			   (insert global-str)))))
-		 (indent-rigidly beg (point) 2))))
-	;; face --------------------------------------------------------------
+	       
+	       (let ((ob (get symbol 'byte-obsolete-variable)))
+		 (setq obsolete
+		       (and ob (format "%s is an obsolete variable; %s\n\n"
+				       symbol
+				       (if (stringp ob)
+					   ob
+					 (format "use %s instead." ob))))))
+	       ;; generally, the value of the variable is short and the
+	       ;; documentation of the variable long, so it's desirable
+	       ;; to see all of the value and the start of the
+	       ;; documentation.  Some variables, though, have huge and
+	       ;; nearly meaningless values that force you to page
+	       ;; forward just to find the doc string.  That is
+	       ;; undesirable.
+	       (if (< (length val) 69)	; 80 cols.  docstrings assume this.
+		   (progn (insert-face "value: " 'heading)
+			  (insert (format "%s\n\n" val))
+			  (and obsolete (insert-face obsolete 'warning))
+			  (insert-face doc 'documentation))
+		 (insert "(see below for value)\n\n")
+		 (and obsolete (insert-face obsolete 'warning))
+		 (insert-face doc 'documentation)
+		 (insert "\n\n")
+		 (insert-face "value: " 'heading)
+		 (if hypropos-prettyprint-long-values
+		     (let ((pp-print-readably nil))
+		       (pprint (symbol-value symbol)))
+		   (insert val)))
+	       (indent-rigidly beg (point) 2)
+	       ))
 	(and (memq 'face type)
 	     (find-face symbol)
 	     (progn
 	       (setq ok t)
-	       (copy-face symbol 'hypropos-temp-face 'global)
-	       (mapcar (function
-			(lambda (property)
-			  (setq symtype (face-property-instance symbol
-								property))
-			  (if symtype
-			      (set-face-property 'hypropos-temp-face
-						 property
-						 symtype))))
-		       built-in-face-specifiers)
-	       (setq font (cons (face-property-instance symbol 'font nil 0 t)
-				(face-property-instance symbol 'font))
-		     fore (cons (face-foreground-instance symbol nil 0 t)
-				(face-foreground-instance symbol))
-		     back (cons (face-background-instance symbol nil 0 t)
-				(face-background-instance symbol))
-		     undl (cons (face-underline-p symbol nil 0 t)
-				(face-underline-p symbol))
-		     doc  (face-doc-string symbol))
 	       ;; #### - add some code here
-	       (save-excursion
-		 (set-buffer hypropos-help-buf)
-		 (setq standard-output (current-buffer))
-		 (hypropos-insert-section-heading "Face:\n\n  ")
-		 (insert-face "ABCDEFHIJKLMNOPQRSTUVWXYZ abcdefhijklmnopqrstuvwxyz 0123456789"
-			      'hypropos-temp-face)
-		 (newline 2)
-		 (insert-face "  Font: " 'heading)
-		 (insert (format (if (numberp (car font)) "(%s)\n" "%s\n")
-				 (and (cdr font)
-				      (font-instance-name (cdr font)))))
-		 (insert-face "  Foreground: " 'heading)
-		 (insert (format (if (numberp (car fore)) "(%s)\n" "%s\n")
-				 (and (cdr fore)
-				      (color-instance-name (cdr fore)))))
-		 (insert-face "  Background: " 'heading)
-		 (insert (format (if (numberp (car back)) "(%s)\n" "%s\n")
-				 (and (cdr back)
-				      (color-instance-name (cdr back)))))
-		 (insert-face "  Underline: " 'heading)
-		 (insert (format (if (numberp (car undl)) "(%s)\n" "%s\n")
-				 (cdr undl)))
-		 (if doc
-		     (progn
-		       (newline)
-		       (setq beg (point))
-		       (insert doc)
-		       (indent-rigidly beg (point) 2))))))
-	;; not bound & property list -----------------------------------------
-	(or ok
-	    (save-excursion
-	      (set-buffer hypropos-help-buf)
-	      (hypropos-insert-section-heading
-	       "symbol is not currently bound\n")))
-	(if (and (setq symtype (symbol-plist symbol))
-		 (or (> (length symtype) 2)
-		     (not (memq 'variable-documentation symtype))))
-	    (save-excursion
-	      (set-buffer hypropos-help-buf)
-	      (goto-char (point-max))
-	      (setq standard-output (current-buffer))
-	      (hypropos-insert-section-heading "property-list:\n\n")
-	      (while symtype
-		(if (memq (car symtype)
-			  '(variable-documentation byte-obsolete-info))
-		    (setq symtype (cdr symtype))
-		  (insert-face (concat "  " (symbol-name (car symtype))
-				       ": ")
-			       'heading)
-		  (setq symtype (cdr symtype))
-		  (indent-to 32)
-		  (insert (prin1-to-string (car symtype)) "\n"))
-		(setq symtype (cdr symtype)))))))
-    (save-excursion
-      (set-buffer hypropos-help-buf)
+	       (insert "Face documentation is \"To be implemented.\"\n\n")
+	       )
+	     )
+	(or ok (insert-face "symbol is not currently bound" 'heading)))
       (goto-char (point-min)) 
       ;; pop up window and shrink it if it's wasting space
-      (if hypropos-shrink-window
-	  (shrink-window-if-larger-than-buffer
-	   (display-buffer (current-buffer)))
-	(display-buffer (current-buffer)))
-      (hyper-help-mode))
-    (setq hypropos-currently-showing symbol)))
+      (shrink-window-if-larger-than-buffer
+       (display-buffer (current-buffer))) 
+      (hyper-help-mode))    )
+  (setq hypropos-currently-showing symbol))
 
 ; -----------------------------------------------------------------------------
 
@@ -1062,7 +736,7 @@
 			(point)))
 		  (en (progn
 			(skip-syntax-forward "w_")
-			(skip-chars-backward ".':") ; : for Local Variables
+			(skip-chars-backward ".")
 			(point))))
 	     (and (not (eq st en))
 		  (intern-soft (buffer-substring st en))))))))
@@ -1080,69 +754,35 @@
 	(t (call-interactively fn))))
 
 ;;;###autoload
-(defun hyper-set-variable (var val &optional this-ref-buffer)
-  (interactive
-   (let ((var (hypropos-read-variable-symbol
-	       (if (hypropos-follow-ref-buffer current-prefix-arg)
-		   "In ref buffer, set user option"
-		 "Set user option")
-	       'user-variable-p)))
-     (list var (hypropos-read-variable-value var) current-prefix-arg)))
-  (hypropos-set-variable var val this-ref-buffer))
-
-;;;###autoload
-(defun hypropos-set-variable (var val &optional this-ref-buffer)
+(defun hypropos-set-variable (var val)
   "Interactively set the variable on the current line."
   (interactive
-   (let ((var (hypropos-this-symbol)))
-     (or (and var (boundp var))
-	 (and (setq var (and (eq major-mode 'hyper-help-mode)
-			     (save-excursion
-			       (goto-char (point-min))
-			       (hypropos-this-symbol))))
-	      (boundp var))
-	 (setq var nil))
-     (list var (hypropos-read-variable-value var))))
-  (and var
-       (boundp var)
-       (progn
-	 (if (hypropos-follow-ref-buffer this-ref-buffer)
-	     (save-excursion
-	       (set-buffer hypropos-ref-buffer)
-	       (set var val))
-	   (set var val))
-	 (hypropos-get-doc var t '(variable) this-ref-buffer))))
-
-(defun hypropos-read-variable-value (var &optional this-ref-buffer)
-  (and var
-       (boundp var)
-       (let ((prop (get var 'variable-interactive))
-	     (print-readably t)
-	     val str)
-	 (hypropos-get-doc var t '(variable) current-prefix-arg)
-	 (if prop
-	     (call-interactively (list 'lambda '(arg)
-				       (list 'interactive prop)
-				       'arg))
-	   (setq val (if (hypropos-follow-ref-buffer this-ref-buffer)
-			 (save-excursion
-			   (set-buffer hypropos-ref-buffer)
-			   (symbol-value var))
-		       (symbol-value var))
-		 str (prin1-to-string val))
-	   (eval-minibuffer
-	    (format "Set %s `%s' to value (evaluated): "
-		    (if (user-variable-p var) "user option" "Variable")
-		    var)
-	    (condition-case nil
-		(progn
-		  (read str)
-		  (format (if (or (consp val)
-				  (and (symbolp val)
-				       (not (memq val '(t nil)))))
-			      "'%s" "%s")
-			  str))
-	      (error nil)))))))
+   (let ((var (save-excursion
+		(and (eq major-mode 'hypropos-help-mode)
+		     (goto-char (point-min)))
+		(hypropos-this-symbol))))
+     (or (boundp var)
+	 (setq var (completing-read "Set variable: "
+				    obarray 'boundp t)))
+     (hypropos-get-doc var t)
+     (list var
+	   (let ((prop (get var 'variable-interactive))
+		 (print-readably t)
+		 (val (symbol-value var)))
+	     (if prop
+		 (call-interactively (list 'lambda '(arg)
+					   (list 'interactive prop)
+					   'arg))
+	       (eval-minibuffer
+		(format "Set `%s' to value (evaluated): " var)
+		(format (if (or (consp val)
+				(and (symbolp val)
+				     (not (memq val '(t nil)))))
+			    "'%s" "%s")
+			(prin1-to-string val))))))
+     ))
+  (set var val)
+  (hypropos-get-doc var t))
 
 ;; ---------------------------------------------------------------------- ;;
 
@@ -1245,3 +885,4 @@
 (provide 'hyper-apropos)
 
 ;; end of hyper-apropos.el
+