home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / alt / lucidem / help / 151 < prev    next >
Encoding:
Text File  |  1992-07-27  |  8.3 KB  |  239 lines
  1. Newsgroups: alt.lucid-emacs.help
  2. Path: sparky!uunet!fornax!bremner
  3. From: bremner@cs.sfu.ca (David Bremner)
  4. Subject: patch for info-dg.el
  5. Message-ID: <1992Jul27.224215.17785@cs.sfu.ca>
  6. Summary: works for me.
  7. Keywords: quick and dirty
  8. Reply-To: bremner@cs.sfu.ca (David Bremner)
  9. Organization: CSS, Simon Fraser University, Burnaby, B.C., Canada
  10. Date: Mon, 27 Jul 1992 22:42:15 GMT
  11. Lines: 226
  12.  
  13.  
  14. What follows is my quick and dirty mashing together of Dave Gillespie's 
  15. enhanced info  mode, and the font and mouse stuff from lemacs 19.2.
  16.  
  17. Some  day when I have time I'll go through and clean it up so that 
  18. it works under both lucid and other gnu emacses.
  19.  
  20. In the mean time, here it is.
  21.  
  22. It is, in all senses of the word a derivative work, and I assert no
  23. additional copyright on MY twelve keystrokes :-)
  24.  
  25. Cheers,
  26.  
  27. David.
  28.  
  29. P.S. I may take a few weeks to  respond to bug reports.
  30. P.P.S. info-dg.el is available from
  31.  
  32. info-dg (1.05)      92-03-08
  33.      Dave Gillespie, <daveg@synaptics.com>
  34.      archive.cis.ohio-state.edu:/pub/gnu/emacs/elisp-archive/modes/info.el.Z
  35.      Info reader with many enhancements; replaces standard info.el.
  36.  
  37. ---------------------------cut here-----------------------------------
  38. *** info-dg.orig    Mon Jul 27 15:22:52 1992
  39. --- info-dg.el    Fri Jul 24 11:06:08 1992
  40. ***************
  41. *** 529,535 ****
  42.             (setq thisfilepos (read (current-buffer)))
  43.             ;; read in version 19 stops at the end of number.
  44.             ;; Advance to the next line.
  45. !           ;; (forward-line 1)
  46.             (if (> thisfilepos nodepos)
  47.             (throw 'foo t))
  48.             (setq lastfilename thisfilename)
  49. --- 529,535 ----
  50.             (setq thisfilepos (read (current-buffer)))
  51.             ;; read in version 19 stops at the end of number.
  52.             ;; Advance to the next line.
  53. !           (forward-line 1)
  54.             (if (> thisfilepos nodepos)
  55.             (throw 'foo t))
  56.             (setq lastfilename thisfilename)
  57. ***************
  58. *** 1906,1910 ****
  59. --- 1906,2082 ----
  60.          (message "Tags may have changed.  Use Info-tagify if necessary")))
  61.   
  62.   (run-hooks 'Info-load-hook)
  63. + 
  64. + ;;; fontification and mousability for info
  65. + ;;; Copied from the Lucid Emacs 19.2 distribution
  66. + ;;; July 15, 1992
  67. + 
  68. + ;; Turn off Dave Gillespie's mouse support
  69. + (setq Info-mouse-support nil)
  70. + 
  71. + ;; Fontify the nodes 
  72. + (setq Info-select-hook 'Info-fontify-node)
  73. + 
  74. + ;; Bind the mouse buttons
  75. + (define-key Info-mode-map 'button2 'Info-follow-indicated-node)
  76. + (define-key Info-mode-map 'button3 'Info-select-node-menu)
  77. + 
  78. + (defvar Info-fontify t)
  79. + 
  80. + (defvar Info-footnote-tag "Note" 
  81. +   "If we are loading this file on top of something that does not define
  82. + Info-footnote-tag, set to the default")
  83. + 
  84. + ;; This should really quote Info-footnote-tag in case someone sets it to a 
  85. + ;; regexp
  86. + 
  87. + (defvar Info-xref-regexp (concat "\\*" 
  88. +                  (regexp-quote Info-footnote-tag)
  89. +                  "[ \n\t]*\\([^:]*\\):"))
  90. + 
  91. + (or (find-face 'info-node) (make-face 'info-node))
  92. + (or (find-face 'info-xref) (make-face 'info-xref))
  93. + 
  94. + (if purify-flag  ; being preloaded
  95. +     nil
  96. +   (or (face-differs-from-default-p 'info-node (selected-screen))
  97. +       (copy-face 'bold-italic 'info-node (selected-screen)))
  98. +   (or (face-differs-from-default-p 'info-xref (selected-screen))
  99. +       (copy-face 'bold 'info-xref (selected-screen))))
  100. + 
  101. + 
  102. + (defun Info-fontify-node ()
  103. +   (if Info-fontify
  104. +       (save-excursion
  105. +     (map-extents (function (lambda (x y) (delete-extent x)))
  106. +              (current-buffer) (point-min) (point-max) nil)
  107. +     (let ((case-fold-search t)
  108. +           extent)
  109. +       (goto-char (point-min))
  110. +       (if (looking-at "^File: [^,: \t]+,?[ \t]+")
  111. +           (progn
  112. +         (goto-char (match-end 0))
  113. +         (while
  114. +             (looking-at "[ \t]*[^:, \t\n]+:[ \t]+\\([^:,\t\n]+\\),?")
  115. +           (goto-char (match-end 0))
  116. +           (setq extent (make-extent (match-beginning 1) (match-end 1)))
  117. +           (set-extent-face extent 'info-xref)
  118. +           (set-extent-attribute extent 'highlight))))
  119. +       (goto-char (point-min))
  120. +       (while (re-search-forward Info-xref-regexp nil t)
  121. +         (if (= (char-after (1- (match-beginning 0))) ?\") ; hack
  122. +         nil
  123. +           (setq extent (make-extent (match-beginning 0) (match-end 1)))
  124. +           (set-extent-face extent 'info-xref)
  125. +           (set-extent-attribute extent 'highlight)))
  126. +       (goto-char (point-min))
  127. +       (if (search-forward "\n* menu:" nil t)
  128. +           (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t)
  129. +         (setq extent (make-extent (match-beginning 0) (match-end 1)))
  130. +         (set-extent-face extent 'info-node)
  131. +         (set-extent-attribute extent 'highlight)))))))
  132. + 
  133. + (defun Info-indicated-node (event)
  134. +   (save-window-excursion
  135. +     (save-excursion
  136. +       (mouse-set-point event)
  137. +       (let* ((buffer (window-buffer (event-window event)))
  138. +          (p (event-point event))
  139. +          (extent (and p (extent-at p buffer 'highlight)))
  140. +          (text (and extent
  141. +             (save-excursion
  142. +               (set-buffer buffer)
  143. +               (buffer-substring
  144. +                (extent-start-position extent)
  145. +                (extent-end-position extent)))))
  146. +          (case-fold-search t)
  147. +          i)
  148. +     (cond ((null extent)
  149. +            nil)
  150. +           ((string-match  (concat "\\`" Info-xref-regexp "?\\'") text)
  151. +            ;; it's a cross-reference
  152. +            (setq text (substring text (match-beginning 1) (match-end 1)))
  153. +            (while (setq i (string-match "[ \n\t]+" text i))
  154. +          (setq text (concat (substring text 0 i) " "
  155. +                     (substring text (match-end 0))))
  156. +          (setq i (1+ i)))
  157. +            (list 'Info-follow-reference text))
  158. +           ((and (save-excursion (goto-char (extent-start-position extent))
  159. +                     (= ?\n (preceding-char)))
  160. +             (string-match "\\`\\* \\([^:\t\n]+\\):?\\'" text))
  161. +            ;; it's a menu entry
  162. +            (setq text (substring text (match-beginning 1) (match-end 1)))
  163. +            (list 'Info-menu text))
  164. +           (t
  165. +            ;; otherwise, it must be a node-name in the first line
  166. +            (list 'Info-goto-node text)))))))
  167. + 
  168. + 
  169. + (defun Info-follow-indicated-node (event)
  170. +   "Follow the crossreference or menu item at the click-location."
  171. +   (interactive "e")
  172. +   (mouse-set-point event)
  173. +   (eval (or (Info-indicated-node event)
  174. +         (error "click on a cross-reference to follow"))))
  175. + 
  176. + 
  177. + (defun Info-select-node-menu (event)
  178. +   "Pops up a menu of applicable Info commands."
  179. +   (interactive "e")
  180. +   (select-window (event-window event))
  181. +   (let ((case-fold-search t)
  182. +     up-p prev-p next-p menu
  183. +     i text xrefs subnodes in)
  184. +     (save-excursion
  185. +       (goto-char (point-min))
  186. +       (if (looking-at ".*\\bNext:") (setq next-p t))
  187. +       (if (looking-at ".*\\bPrev:") (setq prev-p t))
  188. +       (if (looking-at ".*Up:") (setq up-p t))
  189. +       (setq menu (nconc (list "" "Info Commands:" "----")
  190. +             (if (setq in (Info-indicated-node event))
  191. +                 (list (vector (car (cdr in)) in t)))
  192. +             (list
  193. +              ["Goto Info Top-level" Info-directory t]
  194. +              (vector "Next Node" 'Info-next next-p)
  195. +              (vector "Previous Node" 'Info-prev prev-p)
  196. +              (vector "Parent Node (Up)" 'Info-up up-p)
  197. +              ["Goto Node..." Info-goto-node t]
  198. +              ["Goto Last Visited Node" Info-last t])))
  199. +       (while (re-search-forward Info-xref-regexp nil t)
  200. +     (setq text (buffer-substring (match-beginning 1) (match-end 1)))
  201. +     (while (setq i (string-match "[ \n\t]+" text i))
  202. +       (setq text (concat (substring text 0 i) " "
  203. +                  (substring text (match-end 0))))
  204. +       (setq i (1+ i)))
  205. +     (setq xrefs (cons text xrefs)))
  206. +       (setq xrefs (nreverse xrefs))
  207. +       (if (> (length xrefs) 21) (setcdr (nthcdr 20 xrefs) '(more)))
  208. +       (goto-char (point-min))
  209. +       (if (search-forward "\n* menu:" nil t)
  210. +       (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t)
  211. +         (setq text (buffer-substring (match-beginning 1) (match-end 1)))
  212. +         (setq subnodes (cons text subnodes))))
  213. +       (setq subnodes (nreverse subnodes))
  214. +       (if (> (length subnodes) 21) (setcdr (nthcdr 20 subnodes) '(more)))
  215. +       )
  216. +     (if xrefs
  217. +     (nconc menu (list "----" "Cross-References:" "----")
  218. +            (mapcar (function (lambda (xref)
  219. +                    (if (eq xref 'more)
  220. +                        "...more..."
  221. +                      (vector xref
  222. +                          (list 'Info-follow-reference xref)
  223. +                          t))))
  224. +                xrefs)))
  225. +     (if subnodes
  226. +     (nconc menu (list "----" "Sub-Nodes:" "----")
  227. +            (mapcar (function (lambda (node)
  228. +                    (if (eq node 'more)
  229. +                        "...more..."
  230. +                      (vector node (list 'Info-menu node)
  231. +                          t))))
  232. +                subnodes)))
  233. +     (popup-menu menu)))
  234. + 
  235.   
  236.   ;;; End.
  237. -- 
  238. bremner@cs.sfu.ca                           ubc-cs!fornax!bremner
  239.