;; Info package for Emacs  -- could use a "create node" feature.
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

(require 'info)
(require 'cl)
(require 'scr-pool)
(require 'add-hook)

(defvar Info-disaster nil)

(defvar Info-mouse-map (create-mouse-map))

;;------------------------------------------------------------------------
;;------------------------------------------------------------------------
;;                    UNIX MANUAL HYPER-TEXT CAPABILITY
;; by Daniel Remler
;;    Simon Kaplan
;;    Alan Carroll
;; at University of Illinois Urbana-Champaign
;;------------------------------------------------------------------------
;;------------------------------------------------------------------------
;; This code that follows is a hook and is dependent on the function 
;; add-hook. Add-hook may be obtained from 
;;     Ciaran A Byrne      ciaran@hrc63.co.uk
;;                         !seismo!mcvax!ukc!gec-rl-hrc!ciaran
;;------------------------------------------------------------------------


(make-variable-buffer-local 'Menu-Buttons)
(make-variable-buffer-local 'CrossRef-Buttons)
(make-variable-buffer-local 'Prev-Button)
(make-variable-buffer-local 'Next-Button)
(make-variable-buffer-local 'Up-Button)

(setq-default Menu-Buttons nil)
(setq-default CrossRef-Buttons nil)
(setq-default Prev-Button nil)
(setq-default Next-Button nil)
(setq-default Up-Button nil)
(setq-default Hyper-History nil)
            
;; ------------------------------------------------
;; Bind the left mouse button to my local function:
;; ------------------------------------------------
(define-mouse Info-mouse-map mouse-left mouse-up 'Info-Mouse-Click-Button)
(define-mouse Info-mouse-map mouse-left mouse-down t)

(defconst HYPER-DIRECTORY (substitute-in-file-name "$HOME/hyper-man"))

(defvar Info-active-attribute (reserve-attribute)
  "Attribute for active buttons")
(defvar Info-inactive-attribute (reserve-attribute)
  "Attribute for italicized text")
(defvar Info-underline-attribute (reserve-attribute)
  "Attribute for underlined text")

(if (> (number-of-colors) 2)
  (progn
    (set-attribute-global Info-active-attribute "red" (background))
    (set-attribute-global Info-inactive-attribute "turquoise" (background))
    (set-attribute-global Info-underline-attribute "yellow" (background))))

(defvar Default-Info-directory nil)
(defvar In-Hyper-Man)
(defvar Error-Message)

(global-set-key  "\C-hu" 'hyper-man-begin)
(global-set-key  "\C-hi" 'pre-info)


            
;; ---------              
;; T O O L S
;; ---------

(defun add-button-inclusive (start end attribute)
  (add-button start end attribute
	      (buffer-substring start end)))

;; ----------------------------------
;; Just for use in the 'Section' node
;; ----------------------------------
(defun allign-column (relative-line)
  (save-excursion
    (forward-line relative-line)
    (beginning-of-line)
    (setq Begin-Point (point))
    (skip-chars-forward "^)")
    (forward-char 3)
    (just-one-space)
    (insert-char ?  (- (+ Begin-Point 45) (point)))))

;; ------------------
;; MY "last" function
;; ------------------
(defun Pre-Info-last ()
  (interactive)
  (if In-Hyper-Man
      (if (car (cdr Hyper-History))
	  (progn
	    (setq temp (car (cdr Hyper-History)))
	    (setq Hyper-History (cdr (cdr Hyper-History)))
	    (Info-goto-node temp))
	(message "This is the last node that you looked at"))
    (Info-last)))

(defun Info-directory ()
  (interactive)
  (if In-Hyper-Man
      (Info-find-node "Unix-dir" "top")
    (Info-find-node "dir" "top")))

;; ---------------------------------------------------------------------
;; ALL movement to nodes passes through the Info function Info-goto-node
;; This is a Prehook to that function which intercepts and preprocesses
;; nodes if the user is inside the Hyper-Man system
;; ---------------------------------------------------------------------
(add-hook
 'Info-goto-node '()
 '(if In-Hyper-Man
      (progn (setq Hyper-History (cons nodename Hyper-History))
	     (Unix-node-preprocess nodename))))

(defun pre-info ()
  "Start up Info, make sure Info-directory is it's default value"
  (interactive)
  (if Default-Info-directory
      (setq Info-directory Default-Info-directory))
  (setq In-Hyper-Man nil)
  (info))

(add-hook 'Info-select-node 
          '(save-excursion
             (let ((buffer-read-only nil))
               (goto-char (point-min))
               (setq File-Button
                     (if (re-search-forward
                          "File:[ \t]*\\([^ ,\t\n]+\\)" nil t)
                         (add-button-inclusive (match-beginning 1)
                                               (match-end 1) Info-inactive-attribute)
                       nil))
               (goto-char (point-min))
               (setq Node-Button
                     (if (re-search-forward "Node:[ \t]*\\([^,\t\n]+\\)" nil t)
                         (add-button (match-beginning 1)
                                            (match-end 1) Info-inactive-attribute nil)
                       nil))
               (goto-char (point-min))
               (setq Prev-Button
                     (if (re-search-forward
                          "\\(Prev\\|Previous\\):[ \t]*\\([^,\t\n]+\\)" nil t)
                         (add-button (match-beginning 2)
                                            (match-end 2) Info-active-attribute nil)
                       nil))
               (goto-char (point-min))
               (setq Up-Button
                     (if (re-search-forward "Up:[ \t]*\\([^,\t\n]+\\)" nil t)
                         (add-button-inclusive (match-beginning 1)
                                               (match-end 1) Info-active-attribute)
                       nil))
               (goto-char (point-min))
               (setq Next-Button
                     (if (re-search-forward "Next:[ \t]*\\([^,\t\n]+\\)" nil t)
                         (add-button (match-beginning 1)
                                            (match-end 1) Info-active-attribute nil)
                       nil))
               ;; -------------------------------------------
               ;; Make buttons on menu names; store in a list:
               ;; -------------------------------------------
               (setq Menu-Buttons nil)
               (goto-char (point-min))
               (if (search-forward "\n* Menu:" nil t)
                   (while (re-search-forward "^\\* \\([^:]*\\)" nil t)
                     (setq Menu-Buttons
                           (cons (add-button-inclusive
                                  (match-beginning 1) (match-end 1) Info-active-attribute)
                                 Menu-Buttons))))
               ;; --------------------------------
               ;; Make buttons on cross references:
               ;; --------------------------------
               (setq CrossRef-Buttons nil)
               (goto-char (point-min))
               (while (re-search-forward "\\*note[ \t\n]+\\([^:\t]*\\):" nil t)
                 (setq CrossRef-Buttons
                       (cons (add-button-inclusive
                             (match-beginning 1) (match-end 1) Info-active-attribute)
                             CrossRef-Buttons)))
               ;; -------------------------------------------------------
               ;; If in Hyper-Man, make buttons on underlined words
               ;; -------------------------------------------------------
               (let ((case-fold-search nil))
                 (cond (In-Hyper-Man
                        (goto-char (point-min))
                        (while (search-forward "_" (point-max) t)
                          (backward-char 2)
                          (setq Underline-Begin (point))
                          (while (looking-at "_")
                            (delete-char 2)
                            (forward-char 1))
                          (add-button Underline-Begin
                                             (point) Info-underline-attribute nil))
                        ;; -------------------------------------------------
                        ;; Get rid of remaining ^H chars - note: you might
                        ;; think that I could combine this with the above
                        ;; code to highlight underlined words - not trivial!
                        ;; -------------------------------------------------
                        (goto-char (point-min))
                        (while (search-forward "" (point-max) t)
                          (delete-backward-char 2))
;; --------------------------------------------------------------------------
;; Unfortunately it is non trivial to figure out whethere ther is another
;; cross ref button.  This is because of bugs in the manual. In the majority
;; of cases each "see also" topic is seperated by commas.  mailtool(1) breaks
;; this.  Also, usually all the entries are actual manual entries.  But
;; aliases(5) breaks that assumtion as well.  Thus we have to be smart...
;; --------------------------------------------------------------------------
                        (goto-char (point-max))
                        (cond
                         ((re-search-backward "SEE ALSO[ \t\n]+" (point-min) t)
                          (goto-char (match-end 0))
                          (setq CrossRef-Buttons nil)
                          (while
                              (looking-at
                               ",?\n?[ \t]*[a-zA-Z0-9_.]+\\(-\n[ \t]*\\)?[a-zA-Z0-9_.]*([0-9][A-Z]?)")
                            (setq CrossRef-Buttons
                                  (cons
                                   (add-button
                                    (progn
                                      (skip-chars-forward ", \t\n")
                                      (point))
                                    (progn
                                      (re-search-forward "[^)]+)")
                                      (point))
                                    Info-active-attribute
                                    (progn
                                      (setq slice
                                            (buffer-substring
                                             (match-beginning 0)
                                             (match-end 0)))
                                      (if (string-match "[\n\t -]+" slice)
                                          (concat
                                           (substring
                                            slice 0 (match-beginning 0))
                                           (substring
                                            slice (match-end 0) nil))
                                        slice)))
                                   CrossRef-Buttons))))))))
               (Info-display-current-node)
               (set-buffer-modified-p nil)))
          '(clear-buttons))

(defun Info-display-current-node ()
  (pool:get-shrink-wrapped-screen
    Info-screen-pool
    (current-buffer)
    (list 10 120 4 40))
  (title (Info-node-title))
  (icon-name (Info-node-title)))

;; -----------------------------------------------------------------
;; Determine whether user clicked mouse on a button.  If so, and the
;; button "has direction" (is red, and will take us to another node)
;; then call the corresponding Info function.
;; If item is a unix manual node, filter it before displaying
;; -----------------------------------------------------------------
(defun Info-Mouse-Click-Button (ArgList)
  (mouse::set-point ArgList)
  (pool:mark-screen Info-screen-pool (current-screen))	;clicking is a "use"
  (if (setq Current-Button (button-at (point)))
      (cond ((equal Current-Button File-Button)
             (princ "The `File` Button does nothing"))
            ((equal Current-Button Node-Button)
             (princ "The `Node` Button does nothing"))
            ((equal Current-Button Prev-Button)
             (princ "Previous Node...")
             (Info-prev))
            ((equal Current-Button Up-Button)
             (Info-up))
            ((equal Current-Button Next-Button)
             (princ "Next Node...")
             (Info-next))
            ((memq Current-Button Menu-Buttons)
             (Info-menu (button-data Current-Button)))
            ((memq Current-Button CrossRef-Buttons)
             (if In-Hyper-Man
                 (Info-goto-node (button-data Current-Button))
               (Info-follow-reference (button-data Current-Button))))
            (t (message "This button leads nowhere")))
    (message "There is no button at this point in the buffer"))
  (set-buffer-modified-p nil))

(defun make-rawbuf ()
  (save-excursion
    (let ((the-buf (get-buffer-create "rawbuf")))
      (set-buffer the-buf)
      (erase-buffer)
      the-buf)))

;;---------------------------------------------------------------------
;; Find the correct man file.  Read into
;; buffer and process it to look like an info node.  then concatinate 
;; this buffer onto the end of the main buffer *info*
;; --------------------------------------------------------------------
(defun Unix-node-preprocess (Node-name)
  (setq Info-disaster nil)
  (if (and In-Hyper-Man (equal Node-name "Top"))
      (progn
        (setq Info-disaster t)
        (hyper-man-begin))
    (save-excursion 
      (setq Actual-file-name
	    (substring Node-name
		       0 (string-match "([0-9]" Node-name)))
      (setq Bin-name
	    (substring Node-name
		       (1+ (string-match "([0-9]" Node-name))
		       (match-end 0)))
      ;;----------------------------------------------
      ;; Run "man" on actual file name and grab output
      ;;----------------------------------------------
      (message "Reformatting man page: %s" Node-name)
      (if (string= "Section" Actual-file-name)
	  (call-process "man" nil 
			(make-rawbuf)
			nil "-k" (concat "\(" Bin-name))
	(call-process "man" nil
		      (make-rawbuf)
		      nil Bin-name (downcase  Actual-file-name)))
      (setq mainbuf
	    (get-buffer-create (Info-make-buffer-name "Unix-dir" Node-name)))
      (set-buffer "rawbuf")
      (catch 'error-exit
	(setq Info-disaster nil)
	(if (< (count-lines (point-min) (point-max)) 3)
	    (progn
	      (setq Error-Message
		    (buffer-substring (point-min) (point-max)))
	      (message Error-Message)
	      (sit-for 5)
	      (setq Info-disaster t)
	      (throw 'error-exit nil)))
	(setq buffer-read-only nil)
	(goto-char (point-min))
	;;-------------------------------------------
	;; Put in "File:" "Node" and "Up" keywords...
	;;-------------------------------------------
	(insert "\n\nFile: Unix-dir\tNode: " Node-name "\tUp: "
		(if (string= Actual-file-name "Section")
		    "Top" (format "Section(%s)" Bin-name)) "\n")
	;;-----------------------------------------------------------------
	;; Delete the first header (requires special treatment).  Also skip
	;; this section if the node is any of the "List" pages.
	;;-----------------------------------------------------------------
	(goto-char (point-min))
	(cond ((not (string= Actual-file-name "Section"))
	       (forward-line 3)
	       (let ((case-fold-search nil))
		 (kill-region (point)
			      (progn
				(search-forward "NAME")
					;(forward-line -2)
				(beginning-of-line) (forward-char -1)
				(point))))))
	;;-------------------------------------------------------------------
	;; Take out headers and footers and space in between
	;; (Note: I would rather be more safe and only search for \nNode-name,
	;;        but some entries, like admin are prefixed by "SCCS" making
	;;        that impossible.  Also, since I don't want the code to be
	;;        machine dependent, I cannot search for "Sun release".  I 
	;;        take the precaution of making the Node-name appear twice on
	;;        the same line though.)
	;; Also note that in the case of manual entries like SORT(1V), the
	;; "V" does not occur in the headers and footers - so I search for
	;; "SORT(1" instead.
	;;-------------------------------------------------------------------
	(while (search-forward
		(format "%s(%s" Actual-file-name Bin-name)
		(point-max) t)
	  (cond ((search-forward
		  (format "%s(%s" Actual-file-name Bin-name)
		  (save-excursion (end-of-line) (point))
		  t)
		 (forward-line 1)
		 (delete-region (point)
				(progn (re-search-backward "^[ \t]+[^ \t\n]" nil t)
				       (end-of-line) (forward-char 1)
				       (point))))))
	;;-------------------------------------
	;; Special code to take out last footer
	;;-------------------------------------
	(goto-char (point-max))
	(delete-char -1)
	(delete-blank-lines)
	(forward-line -3)
	(delete-blank-lines)
	
	;; ------------------------------------------------------------
	;; Special handling if in a directory node (section(1-8))
	;; Many things must be done here: First, take out any garbage
	;; nroff commands at the beginning of lines.  Second, deal with
	;; multiple entries on one line.
	;; ------------------------------------------------------------
	(cond ((string= Actual-file-name "Section")
	       (goto-line 4)
	       (insert "\n\n\n* MENU: \n\n")
	       (forward-line -1)
	       (while (search-forward "\n" (point-max) t)
		 (insert "* ")
		 (if (looking-at "\\.")
		     (delete-region (point)
				    (progn
				      (re-search-forward "[^ \t\n]*[ \t\n]")
				      (match-end 0))))
		 (if (looking-at
                      "\\([---a-zA-Z0-9_%@]+\\),[ \t]*\\([---a-zA-Z0-9_%@]+,[ \t]*\\)*[---a-zA-Z0-9_%@]+[ \t]*\\(([0-9][A-Z]?)\\)\\([^\n]*\\)")
		     (progn
		       (setq Keyword
			     (buffer-substring
			      (match-beginning 1) (match-end 1)))
		       (setq Suffix
			     (buffer-substring
			      (match-beginning 3) (match-end 3)))
		       (setq Description
			     (buffer-substring
			      (match-beginning 4) (match-end 4)))
		       (setq StopPoint
			     (set-marker (make-marker) (match-beginning 4)))
		       (re-search-forward ",[ \t]*"
					  (marker-position StopPoint) t)
		       (replace-match
			(format "%s::%s\n* " Suffix Description))
		       (allign-column -1)
		       (while (re-search-forward  ",[ \t]*"
						  (marker-position StopPoint)
						  t)
			 (replace-match
			  (format ": %s%s.%s\n* "
				  Keyword Suffix Description))
			 (allign-column -1))
		       (re-search-forward  "[ \t]*([0-9][A-Z]?)"
					   (marker-position StopPoint) t)
		       (replace-match
			(format ": %s%s." Keyword Suffix)))
		   (progn
		     (skip-chars-forward "^(")
		     (delete-char -1)
		     (skip-chars-forward "^)")
		     (forward-char 1)
		     (insert "::")))
		 (allign-column 0))))
          
	(set-buffer-modified-p nil)
        (set-buffer mainbuf)
        (use-local-mouse-map Info-mouse-map)
        (save-excursion
          (save-restriction
            (widen)
            (goto-char (point-max))
            (let ((buffer-read-only nil))
              (insert-buffer "rawbuf"))))
        (kill-buffer "rawbuf")))))
  
(defun hyper-man-begin ()
  "Access Unix Manual through the info hyper-text system"
  (interactive)
  (if (not (file-directory-p HYPER-DIRECTORY))
          (call-process  "mkdir" nil nil nil
                         (substitute-in-file-name "$HOME/hyper-man")))
      (cond ((not (file-exists-p
                   (concat HYPER-DIRECTORY "/Unix-dir")))
             (generate-new-buffer "dirbuf")
             (set-buffer "dirbuf")
             (setq buffer-read-only nil)
             (insert "\n\nFile: Unix-dir\tNode: Top\n\n\n\n"
                     "\tThis is the top node of the full\n\n"
                     "\t     U N I X    M A N U A L\n\n\n"
                     "* Menu:\n\n"
                     "* Section(1)::\t USER COMMANDS\n\n"
                     "* Section(2)::\t SYSTEM CALLS\n\n"
                     "* Section(3)::\t C LIBRARY FUNCTIONS\n\n"
                     "* Section(4)::\t DEVICES AND NETWORK INTERFACES\n\n"
                     "* Section(5)::\t FILE FORMATS\n\n"
                     "* Section(6)::\t GAMES AND DEMOS\n\n"
                     "* Section(7)::\t PUBLIC FILES, TABLES AND TROFF MACROS\n\n"
                     "* Section(8)::\t MAINTENANCE COMMANDS")
             (write-region (point-min) (point-max)
                           (concat HYPER-DIRECTORY "/Unix-dir"))
             (kill-buffer "dirbuf")))
      (if (not (string= Info-directory HYPER-DIRECTORY))
          (setq Default-Info-directory Info-directory))
      (setq Info-directory HYPER-DIRECTORY)
      (setq In-Hyper-Man t)
      
      (Info-find-node  (concat HYPER-DIRECTORY "/Unix-dir") "top"))


