File: hmous-info.el

package info (click to toggle)
xemacs21-packages 2009.02.17.dfsg.1-1
  • links: PTS
  • area: main
  • in suites: squeeze
  • size: 116,928 kB
  • ctags: 88,975
  • sloc: lisp: 1,232,060; ansic: 16,570; java: 13,514; xml: 6,477; sh: 4,611; makefile: 4,036; asm: 3,007; perl: 839; cpp: 500; ruby: 257; csh: 96; haskell: 93; awk: 49; python: 47
file content (228 lines) | stat: -rw-r--r-- 7,506 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
;;; hmous-info.el --- Walks through Info networks using one key.

;; Copyright (C) 1989, 1990, 1991, 2006 Free Software Foundation, Inc.
;; Developed with support from Motorola Inc.

;; Author: Bob Weiner, Brown U.
;; Maintainer: Mats Lidell <matsl@contactor.se>
;; Keywords: docs, help, hypermedia, mouse

;; This file is part of GNU Hyperbole.

;; GNU Hyperbole is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; GNU Hyperbole is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:
;;
;;  This code is machine independent.
;;
;;  To install:  See hui-mouse.el
;;

;;; Code:

;;;###autoload
(defun smart-info ()
  "Walks through Info documentation networks using one key or mouse key.

If key is pressed within:
 (1) the first line of an Info Menu Entry or Cross Reference, the desired node
       is found;
 (2) the Up, Next, or Previous entries of a Node Header (first line),
       the desired node is found;
 (3) the File entry of a Node Header (first line),       
       the 'Top' node within that file is found;
 (4) at the end of the current node, the Next node is found (this will
       descend subtrees if the function 'Info-global-next' is bound);
 (5) anywhere else (e.g. at the end of a line), the current node entry is
       scrolled up one windowful.

Returns t if key is pressed within an Info Node Header, Cross Reference,
or a Menu; otherwise returns nil."

  (interactive)
  (cond 
    ;;
    ;; If at end of node, go to next node
    ;;
    ((last-line-p)
     (if (fboundp 'Info-global-next) (Info-global-next)
       (Info-next)))
    ((Info-handle-in-node-hdr))
    ((Info-handle-in-note))
    ((Info-handle-in-menu))
    ((pos-visible-in-window-p (point-max))
     (if (fboundp 'Info-global-next) (Info-global-next)
       (Info-next)))
    ;;
    ;; If nothing else scroll forward a windowful.
    ;;
    ((smart-scroll-up))))

;;;###autoload
(defun smart-info-assist ()
  "Walks through Info documentation networks using one assist-key or mouse assist-key.

If assist-key is pressed within:
 (1) the first line of an Info Menu Entry or Cross Reference, the desired node
       is found;
 (2) the Up, Next, or Previous entries of a Node Header (first line),
       the last node in the history list is found;
 (3) the File entry of a Node Header (first line),       
       the 'DIR' root-level node is found;
 (4) at the end of the current node, the Previous node is found (this will
       return from subtrees if the function 'Info-global-prev is bound);
 (5) anywhere else (e.g. at the end of a line), the current node entry is
       scrolled down one windowful.

Returns t if assist-key is pressed within an Info Node Header, Cross Reference,
or a Menu; otherwise returns nil."

  (interactive)
  (cond
    ;;
    ;; If at end or beginning of node, go to previous node
    ;;
    ((last-line-p)
     (if (fboundp 'Info-global-prev) (Info-global-prev)
       (Info-prev)))
    ((Info-handle-in-node-hdr-assist))
    ((Info-handle-in-note))
    ((Info-handle-in-menu))
    ((pos-visible-in-window-p (point-min))
     (if (fboundp 'Info-global-prev) (Info-global-prev)
       (Info-prev)))
    ;;
    ;; If anywhere else, scroll backward a windowful.
    ;;
    ((smart-scroll-down))))

(defun Info-handle-in-node-hdr ()
  "If within an Info node header, move to <FILE>Top, <Up>, <Previous>, or
<Next> node, depending on which label point is on, and return t.
Otherwise, return nil."
  ;;
  ;; Test if on 1st line of node, i.e. node header
  ;;
  (if (not (first-line-p))
      nil
    (let ((nodename "Top") (filep nil))
      (save-excursion
	(if (and
	      (re-search-forward "[:, \t\n]" nil t)
	      (re-search-backward
		"\\(File\\|Node\\|Up\\|Prev\\|Previous\\|Next\\):[ \t]" nil t))
	    (progn (setq filep (string-equal
				 "file"
				 (downcase (buffer-substring
					     (match-beginning 1)
					     (match-end 1)))))
		   (if (re-search-forward (concat ":[ \n]\\([^,\t\n"
						  (if filep " ")
						  "]*\\)") nil t)
		       (setq nodename (buffer-substring
					(match-beginning 1)
					(match-end 1)))))
	  (error "Node header not found.")))
      (setq nodename
	    (cond ((= (aref nodename 0) ?\() nodename)
		  (filep (concat "(" nodename ")" "Top"))
		  (buffer-file-name (concat "(" buffer-file-name ")" nodename))
		  (t nodename)))
      (if hyperb:xemacs-p
	  (Info-goto-node nodename nil t)
	(Info-goto-node nodename))
      t)))

(defun Info-handle-in-node-hdr-assist ()
  "If within an Info node header when the 'smart-info-assist' command is
executed, when within the <FILE> header go to the DIR top-level node.  When
within any other header (<Up>, <Previous>, or <Next>) go to last node from
history list.  Return t if in Info node header.  Otherwise return nil."
  ;;
  ;; Test if on 1st line of node, i.e. node header
  ;;
  (if (not (first-line-p))
      nil
    (save-excursion
      (if (and 
	    (re-search-forward "[:, \t\n]" nil t)
	    (re-search-backward
	      "\\(File\\|Node\\|Up\\|Prev\\|Previous\\|Next\\):[ \t]" nil t) )
	  ;; If in <FILE> hdr
	  (progn (if (string-equal
		       "file"
		       (downcase (buffer-substring
				   (match-beginning 1)
				   (match-end 1))))
		     (Info-directory)
		   (Info-last))
		 t)
	(error "Node header not found.")
	nil))))

;;;###autoload
(defun Info-handle-in-note ()
  "Follows an Info cross-reference.
If point is within the first line of an Info note (cross-reference), follows
cross-reference and returns t; otherwise returns nil."
  (let ((note-name) (opoint (point)))
    (save-excursion
      (skip-chars-forward "^:")
      (if (and (re-search-backward
		"\*\\(Ref\\|Note\\|See\\)\\([ \t\n]+\\|$\\)" nil t)
	       (looking-at "\*\\(Ref\\|Note\\|See\\)[ \t\n]+\\([^:]*\\):")
	       (<= (match-beginning 0) opoint)
	       (> (match-end 0) opoint))
	  ;; Remove newline and extra spaces from 'note-name'
	  (setq note-name (hypb:replace-match-string
			   "[ \n\t]+"
			   (buffer-substring
			    (match-beginning 2) (match-end 2))
			   " " t))))
    (if note-name
	(progn (Info-follow-reference note-name) t))))

(defun Info-handle-in-menu ()
  "Displays node referred to by an Info Menu Entry.
If point is within an Info menu entry, goes to node referenced by
entry and returns t; otherwise returns nil."
  ;;
  ;; Test if there is a menu in this node
  ;;
  (let ((in-menu nil) (curr-point (point)))
    (save-excursion
      (goto-char (point-min))
      (setq in-menu 
	    (and (search-forward "\n* menu:" nil t)
		 (< (point) curr-point))))
    (if (not in-menu)
	nil
      (let ((node))
	(save-excursion
	  (forward-char) ; Pass '*' char if point is in front of
	  (if (search-backward "\n*" nil t)
	      (progn (forward-char 2)
		     (setq node (Info-extract-menu-node-name)))))
	(if (null node)
	    nil
	  (if hyperb:xemacs-p
	      (Info-goto-node node nil t)
	    (Info-goto-node node))
	  t)))))

(provide 'hmous-info)

;;; hmous-info.el ends here