comparison lisp/hyperbole/hib-doc-id.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: hib-doc-id.el
4 ;; SUMMARY: Implicit button type for document id index entries.
5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: docs, extensions, hypermedia
7 ;;
8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Motorola, Inc., PWDG
10 ;;
11 ;; ORIG-DATE: 30-Sep-92 at 19:39:59
12 ;; LAST-MOD: 14-Apr-95 at 15:58:21 by Bob Weiner
13 ;;
14 ;; This file is part of Hyperbole.
15 ;; Available for use and distribution under the same terms as GNU Emacs.
16 ;;
17 ;; Copyright (C) 1992-1995, Free Software Foundation, Inc.
18 ;; Developed with support from Motorola Inc.
19 ;;
20 ;; DESCRIPTION:
21 ;;
22 ;; TO USE:
23 ;;
24 ;; Pressing the Action Key on a doc id such as, [Emacs-001],
25 ;; displays the online version of the document, if any. Pressing the
26 ;; Assist Key on it displays its document index entry.
27 ;;
28 ;; TO INSTALL:
29 ;;
30 ;; Set the value of 'doc-id-indices' before using the 'doc-id'
31 ;; implicit button type defined herein or you will get an error telling you
32 ;; to do so. See the documentation for 'doc-id-indices'.
33 ;;
34 ;; You must explicitly load this package in order to use it, since
35 ;; Hyperbole does not load it by default.
36 ;;
37 ;; At this site, we use doc ids of the form, [Emacs-001], delimited by
38 ;; brackets, starting with a subject name, followed by a -, followed by a
39 ;; multi-digit numeric identifier.
40 ;;
41 ;; Typically an index entry should have links to all available forms of its
42 ;; document, e.g. online, printed, source. Below is the index entry form
43 ;; we use. The default variable settings herein work with our formats. If
44 ;; you prefer different ones, you must change all of the variable values.
45 ;;
46 ;; --------------------------------------------------------------------------
47 ;; Title: ID: []
48 ;; Email-To:
49 ;; Distribution:
50 ;;
51 ;; Abstract:
52 ;;
53 ;;
54 ;; References:
55 ;;
56 ;; Author:
57 ;; Copyright:
58 ;; Keywords:
59 ;;
60 ;; Online-Format:
61 ;; Online-Loc: ""
62 ;; Printed-Format:
63 ;; Printed-Loc: Local Library
64 ;; Printable-Loc: ""
65 ;; Source-Format:
66 ;; Source-Loc: ""
67 ;;
68 ;; Date:
69 ;; Version:
70 ;; Version-Changes:
71 ;; --------------------------------------------------------------------------
72 ;;
73 ;; DESCRIP-END.
74
75 ;;; ************************************************************************
76 ;;; Public implicit button types
77 ;;; ************************************************************************
78
79 ;;; ========================================================================
80 ;;; Displays a documentation index entry given an ID.
81 ;;; ========================================================================
82
83 (defact link-to-doc (doc-id)
84 "Displays online version of a document given by DOC-ID (no delimiters), in other window.
85 If online version of document is not found in `doc-id-indices', an error is signalled."
86 (interactive "sID for document to link to (omit delimiters): ")
87 (let ((rolo-display-buffer (hypb:help-buf-name "Doc ID"))
88 (delim-doc-id (concat doc-id-start doc-id doc-id-end)))
89 (cond ((null doc-id-indices)
90 (error "(doc-id-index-entry): You must set the 'doc-id-indices' variable first."))
91 ((let ((rolo-entry-regexp doc-id-index-entry-regexp))
92 (= 0 (rolo-grep (funcall doc-id-match doc-id)
93 1 doc-id-indices nil 'no-display)))
94 (error "(doc-id-index-entry): %s not found in document index."
95 delim-doc-id))
96 ;; Matching index entry has been put into 'rolo-display-buffer'.
97 (t (save-excursion
98 (set-buffer rolo-display-buffer)
99 (goto-char (point-min))
100 (message "Searching for document %s..." delim-doc-id)
101 (if (re-search-forward doc-id-online-regexp nil t)
102 (progn
103 (goto-char (match-beginning 1))
104 (let ((doc-path (buffer-substring
105 (match-beginning 1) (match-end 1)))
106 (ibut (ibut:at-p)))
107 (if ibut
108 (progn (hbut:act ibut)
109 (message "Displaying %s." delim-doc-id))
110 (error "(link-to-doc): %s invalid online location: %s"
111 delim-doc-id doc-path))))
112 (error "(link-to-doc): %s is unavailable in online form."
113 delim-doc-id)))))))
114
115 (defib doc-id ()
116 "Displays an index entry for a site-specific document given its id.
117 Ids must be delimited by 'doc-id-start' and 'doc-id-end' and must
118 match the function given by 'doc-id-p'."
119 (and (not (bolp))
120 (let* ((id-and-pos (hbut:label-p t doc-id-start doc-id-end t))
121 (id (car id-and-pos)))
122 (if (funcall doc-id-p id)
123 (progn (ibut:label-set id-and-pos)
124 (hact 'link-to-doc id))))))
125
126
127 ;;; ========================================================================
128 ;;; Displays a doc from SW Process Tree (Motorola Paging Products Specific)
129 ;;; ========================================================================
130
131 (if (file-exists-p "/proj/process/ppg/")
132 (defib ppg-sw-process ()
133 "Display a Paging Products software process document from document id at point."
134 (let ((path (hpath:at-p nil t)))
135 (if (and path (string-match "/.+%s.+%s" path))
136 (progn (require 'sw-process)
137 (ibut:label-set path)
138 (setq path (format path ppg-sw-process-file-format
139 ppg-sw-process-file-suffix))
140 (if (file-exists-p path)
141 (hact 'link-to-file path)
142 (if (re-search-forward
143 "^Source-Loc:[ \t]*\"\\([^\"]+\\)\"" nil t)
144 (progn
145 (goto-char (match-beginning 1))
146 (let ((path-but (ibut:at-p)))
147 (if path-but
148 (hbut:act path-but)))))))))))
149
150 ;;; ************************************************************************
151 ;;; Public variables
152 ;;; ************************************************************************
153
154 (defvar doc-id-indices '()
155 "List of pathnames in which to search for site-specific document index entries.
156 Each file must utilize a wrolo record format, with each record start
157 delimited by 'doc-id-index-entry-regexp'.")
158
159 ;;; ************************************************************************
160 ;;; Private functions
161 ;;; ************************************************************************
162
163 (defun doc-id:help (but)
164 "Displays site-specific document index entry given by doc-id BUT, in other window.
165 Also displays standard Hyperbole help for implicit button BUT."
166 (let ((rolo-entry-regexp doc-id-index-entry-regexp)
167 (rolo-display-buffer (hypb:help-buf-name "Doc ID"))
168 (doc-id (hbut:key-to-label (hattr:get but 'lbl-key))))
169 (cond ((null doc-id-indices)
170 (error "(doc-id-index-entry): You must set the 'doc-id-indices' variable first."))
171 ((= 0 (rolo-grep (funcall doc-id-match doc-id) 1 doc-id-indices))
172 (error
173 "(doc-id-index-entry): No document index entry found for %s%s%s."
174 doc-id-start doc-id doc-id-end)))
175 (let* ((report-buf (hypb:help-buf-name))
176 (temp-buffer-show-hook
177 (function
178 (lambda (buffer)
179 (setq *hkey-wconfig*
180 (current-window-configuration)))
181 (let ((wind (get-buffer-create buffer)))
182 (setq minibuffer-scroll-window wind))))
183 (temp-buffer-show-function temp-buffer-show-hook))
184 (hbut:report but)
185 (save-excursion
186 (set-buffer rolo-display-buffer)
187 (setq buffer-read-only nil)
188 (goto-char (point-max))
189 (insert-buffer report-buf)
190 (set-buffer-modified-p nil)
191 (setq buffer-read-only nil)
192 (goto-char (point-min)))
193 (kill-buffer report-buf)
194 )))
195
196 ;;; ************************************************************************
197 ;;; Private variables
198 ;;; ************************************************************************
199
200 (defvar doc-id-start "["
201 "String which delimits start of a site-specific document id.")
202 (defvar doc-id-end "]"
203 "String which delimits end of a site-specific document id.")
204
205 (defvar doc-id-index-entry-regexp "^------+[ \t\n]+Title:"
206 "Regexp which matches start of a site-specific document index entry.")
207
208 (defvar doc-id-match
209 (function (lambda (doc-id)
210 (concat "ID:[ \t]*\\[" (regexp-quote doc-id) "\\]")))
211 "Function which returns regexp which matches only in DOC-ID's index entry.")
212
213 (defvar doc-id-p (function
214 (lambda (str)
215 (and (stringp str)
216 (> (length str) 0)
217 (= ?w (char-syntax (aref str 0)))
218 (string-match "\\`\\w+-[0-9][0-9][0-9]+\\'" str))))
219 "Boolean function to test whether arg 'str' is a doc id or not.")
220
221 (defvar doc-id-online-regexp "^Online-Loc:[ \t]*\"\\([^\"]+\\)\""
222 "Regexp whose 1st grouping matches an implicit button which displays an online document within an index entry.")
223
224 (provide 'hib-doc-id)