From: bremner@cs.sfu.ca (David Bremner)
Subject: Re: Adding Info Directories?
Reply-To: bremner@cs.sfu.ca (David Bremner)
Organization: CSS, Simon Fraser University, Burnaby, B.C., Canada
Date: Tue, 29 Sep 1992 19:06:06 GMT

In article <NEAL.92Sep29132731@neal.ctd.comsat.com> neal@ctd.comsat.com (Neal Becker) writes:
>I have been using 18.58 with the (recently posted) info stuff, which
>allows alternate info directories.  I have been adding new stuff to
>/usr/local/info.  In each new directory, you make a file called
>'localdir'.
>
>Does lemacs support this?  It doesn't appear to work, and I can't find
>any doc on this.

I "ported" Dave Gillespie's nifty info.el to lemacs.  The following
is an updated patch, incorporating some efficency fixes by
Guido Bosch (Info-inhibit-select-hook).  This patch is intended to 
be applied to a brand-new info-dg.el, not on top of the 
patch I posted previously.

----------------------------   cut here ----------------------------------
*** info-dg.el	Tue Aug 18 12:10:12 1992
--- info.el	Tue Aug 18 12:01:36 1992
***************
*** 207,212 ****
--- 207,220 ----
    "*Non-nil allows Info to execute Lisp code associated with nodes.
  The Lisp code is executed when the node is selected.")
  
+ (defvar Info-select-hook)
+ 
+ (defvar Info-inhibit-select-hook nil
+   "If this variable is non-nil, the Info-select-hook is not activated
+ when an Info node is selected. This is done, e.g., in the function
+ Info-elisp-ref")
+ 
+ 
  (defvar Info-restoring-point t
    "*Non-nil means to restore the cursor position when re-entering a node.")
  
***************
*** 623,629 ****
  	       (replace-match (concat "*" Info-footnote-tag "\\1")))
  	     (set-buffer-modified-p bufmod))))
       (Info-reannotate-node)
!      (run-hooks 'Info-select-hook)
       (if Info-enable-active-nodes (eval active-expression)))))
  
  (defun Info-set-mode-line ()
--- 631,639 ----
  	       (replace-match (concat "*" Info-footnote-tag "\\1")))
  	     (set-buffer-modified-p bufmod))))
       (Info-reannotate-node)
!      ;; running of this hook may be inhibited 
!      (or Info-inhibit-select-hook
! 	 (run-hooks 'Info-select-hook))
       (if Info-enable-active-nodes (eval active-expression)))))
  
  (defun Info-set-mode-line ()
***************
*** 1224,1229 ****
--- 1234,1240 ----
  Give a blank topic name to go to the Index node itself."
    (interactive "sIndex topic: ")
    (let ((orignode Info-current-node)
+ 	(Info-inhibit-select-hook t)
  	(rnode nil)
  	(pattern (format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ \t]*%s"
  			 (regexp-quote topic)
***************
*** 1269,1275 ****
  	    (setq exact (cons found exact)
  		  matches (delq found matches)))
  	  (setq Info-index-alternatives (nconc exact (nreverse matches)))
! 	  (Info-index-next 0)))))
  
  (defun Info-index-next (num)
    "Go to the next matching index item from the last `i' command."
--- 1280,1287 ----
  	    (setq exact (cons found exact)
  		  matches (delq found matches)))
  	  (setq Info-index-alternatives (nconc exact (nreverse matches)))
! 	  )))
! 	  (Info-index-next 0))
  
  (defun Info-index-next (num)
    "Go to the next matching index item from the last `i' command."
***************
*** 1313,1319 ****
    (if (equal key "\C-g")
        (keyboard-quit))
    (info)
!   (Info-find-node "emacs" "Top")
    (setq key (key-description key))
    (let (p)
      (if (setq p (string-match "[@{}]" key))
--- 1325,1332 ----
    (if (equal key "\C-g")
        (keyboard-quit))
    (info)
!   (let ((Info-inhibit-select-hook t))
!     (Info-find-node "emacs" "Top"))
    (setq key (key-description key))
    (let (p)
      (if (setq p (string-match "[@{}]" key))
***************
*** 1340,1346 ****
  			   fn (intern val)))))
    (info)
    (condition-case err
!       (Info-find-node "elisp" "Top")
      (error (Info-find-node "lispref" "Top")))
    (Info-index (symbol-name func)))
  
--- 1353,1360 ----
  			   fn (intern val)))))
    (info)
    (condition-case err
!       (let ((Info-inhibit-select-hook t))
! 	(Info-find-node "elisp" "Top"))
      (error (Info-find-node "lispref" "Top")))
    (Info-index (symbol-name func)))
  
***************
*** 1906,1910 ****
--- 1920,2096 ----
         (message "Tags may have changed.  Use Info-tagify if necessary")))
  
  (run-hooks 'Info-load-hook)
+ 
+ ;;; fontification and mousability for info
+ ;;; Copied from the Lucid Emacs 19.2 distribution
+ ;;; July 15, 1992
+ 
+ ;; Turn off Dave Gillespie's mouse support
+ (setq Info-mouse-support nil)
+ 
+ ;; Fontify the nodes 
+ (setq Info-select-hook 'Info-fontify-node)
+ 
+ ;; Bind the mouse buttons
+ (define-key Info-mode-map 'button2 'Info-follow-indicated-node)
+ (define-key Info-mode-map 'button3 'Info-select-node-menu)
+ 
+ (defvar Info-fontify t)
+ 
+ (defvar Info-footnote-tag "Note" 
+   "If we are loading this file on top of something that does not define
+ Info-footnote-tag, set to the default")
+ 
+ ;; This should really quote Info-footnote-tag in case someone sets it to a 
+ ;; regexp
+ 
+ (defvar Info-xref-regexp (concat "\\*" 
+ 				 (regexp-quote Info-footnote-tag)
+ 				 "[ \n\t]*\\([^:]*\\):"))
+ 
+ (or (find-face 'info-node) (make-face 'info-node))
+ (or (find-face 'info-xref) (make-face 'info-xref))
+ 
+ (if purify-flag  ; being preloaded
+     nil
+   (or (face-differs-from-default-p 'info-node (selected-screen))
+       (copy-face 'bold-italic 'info-node (selected-screen)))
+   (or (face-differs-from-default-p 'info-xref (selected-screen))
+       (copy-face 'bold 'info-xref (selected-screen))))
+ 
+ 
+ (defun Info-fontify-node ()
+   (if Info-fontify
+       (save-excursion
+ 	(map-extents (function (lambda (x y) (delete-extent x)))
+ 		     (current-buffer) (point-min) (point-max) nil)
+ 	(let ((case-fold-search t)
+ 	      extent)
+ 	  (goto-char (point-min))
+ 	  (if (looking-at "^File: [^,: \t]+,?[ \t]+")
+ 	      (progn
+ 		(goto-char (match-end 0))
+ 		(while
+ 		    (looking-at "[ \t]*[^:, \t\n]+:[ \t]+\\([^:,\t\n]+\\),?")
+ 		  (goto-char (match-end 0))
+ 		  (setq extent (make-extent (match-beginning 1) (match-end 1)))
+ 		  (set-extent-face extent 'info-xref)
+ 		  (set-extent-attribute extent 'highlight))))
+ 	  (goto-char (point-min))
+ 	  (while (re-search-forward Info-xref-regexp nil t)
+ 	    (if (= (char-after (1- (match-beginning 0))) ?\") ; hack
+ 		nil
+ 	      (setq extent (make-extent (match-beginning 0) (match-end 1)))
+ 	      (set-extent-face extent 'info-xref)
+ 	      (set-extent-attribute extent 'highlight)))
+ 	  (goto-char (point-min))
+ 	  (if (search-forward "\n* menu:" nil t)
+ 	      (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t)
+ 		(setq extent (make-extent (match-beginning 0) (match-end 1)))
+ 		(set-extent-face extent 'info-node)
+ 		(set-extent-attribute extent 'highlight)))))))
+ 
+ (defun Info-indicated-node (event)
+   (save-window-excursion
+     (save-excursion
+       (mouse-set-point event)
+       (let* ((buffer (window-buffer (event-window event)))
+ 	     (p (event-point event))
+ 	     (extent (and p (extent-at p buffer 'highlight)))
+ 	     (text (and extent
+ 			(save-excursion
+ 			  (set-buffer buffer)
+ 			  (buffer-substring
+ 			   (extent-start-position extent)
+ 			   (extent-end-position extent)))))
+ 	     (case-fold-search t)
+ 	     i)
+ 	(cond ((null extent)
+ 	       nil)
+ 	      ((string-match  (concat "\\`" Info-xref-regexp "?\\'") text)
+ 	       ;; it's a cross-reference
+ 	       (setq text (substring text (match-beginning 1) (match-end 1)))
+ 	       (while (setq i (string-match "[ \n\t]+" text i))
+ 		 (setq text (concat (substring text 0 i) " "
+ 				    (substring text (match-end 0))))
+ 		 (setq i (1+ i)))
+ 	       (list 'Info-follow-reference text))
+ 	      ((and (save-excursion (goto-char (extent-start-position extent))
+ 				    (= ?\n (preceding-char)))
+ 		    (string-match "\\`\\* \\([^:\t\n]+\\):?\\'" text))
+ 	       ;; it's a menu entry
+ 	       (setq text (substring text (match-beginning 1) (match-end 1)))
+ 	       (list 'Info-menu text))
+ 	      (t
+ 	       ;; otherwise, it must be a node-name in the first line
+ 	       (list 'Info-goto-node text)))))))
+ 
+ 
+ (defun Info-follow-indicated-node (event)
+   "Follow the crossreference or menu item at the click-location."
+   (interactive "e")
+   (mouse-set-point event)
+   (eval (or (Info-indicated-node event)
+ 	    (error "click on a cross-reference to follow"))))
+ 
+ 
+ (defun Info-select-node-menu (event)
+   "Pops up a menu of applicable Info commands."
+   (interactive "e")
+   (select-window (event-window event))
+   (let ((case-fold-search t)
+ 	up-p prev-p next-p menu
+ 	i text xrefs subnodes in)
+     (save-excursion
+       (goto-char (point-min))
+       (if (looking-at ".*\\bNext:") (setq next-p t))
+       (if (looking-at ".*\\bPrev:") (setq prev-p t))
+       (if (looking-at ".*Up:") (setq up-p t))
+       (setq menu (nconc (list "" "Info Commands:" "----")
+ 			(if (setq in (Info-indicated-node event))
+ 			    (list (vector (car (cdr in)) in t)))
+ 			(list
+ 			 ["Goto Info Top-level" Info-directory t]
+ 			 (vector "Next Node" 'Info-next next-p)
+ 			 (vector "Previous Node" 'Info-prev prev-p)
+ 			 (vector "Parent Node (Up)" 'Info-up up-p)
+ 			 ["Goto Node..." Info-goto-node t]
+ 			 ["Goto Last Visited Node" Info-last t])))
+       (while (re-search-forward Info-xref-regexp nil t)
+ 	(setq text (buffer-substring (match-beginning 1) (match-end 1)))
+ 	(while (setq i (string-match "[ \n\t]+" text i))
+ 	  (setq text (concat (substring text 0 i) " "
+ 			     (substring text (match-end 0))))
+ 	  (setq i (1+ i)))
+ 	(setq xrefs (cons text xrefs)))
+       (setq xrefs (nreverse xrefs))
+       (if (> (length xrefs) 21) (setcdr (nthcdr 20 xrefs) '(more)))
+       (goto-char (point-min))
+       (if (search-forward "\n* menu:" nil t)
+ 	  (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t)
+ 	    (setq text (buffer-substring (match-beginning 1) (match-end 1)))
+ 	    (setq subnodes (cons text subnodes))))
+       (setq subnodes (nreverse subnodes))
+       (if (> (length subnodes) 21) (setcdr (nthcdr 20 subnodes) '(more)))
+       )
+     (if xrefs
+ 	(nconc menu (list "----" "Cross-References:" "----")
+ 	       (mapcar (function (lambda (xref)
+ 				   (if (eq xref 'more)
+ 				       "...more..."
+ 				     (vector xref
+ 					     (list 'Info-follow-reference xref)
+ 					     t))))
+ 		       xrefs)))
+     (if subnodes
+ 	(nconc menu (list "----" "Sub-Nodes:" "----")
+ 	       (mapcar (function (lambda (node)
+ 				   (if (eq node 'more)
+ 				       "...more..."
+ 				     (vector node (list 'Info-menu node)
+ 					     t))))
+ 		       subnodes)))
+     (popup-menu menu)))
+ 
  
  ;;; End.

-- 
bremner@cs.sfu.ca 				          ubc-cs!fornax!bremner