comparison lisp/hyperbole/hib-doc-id.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 4103f0995bd7
children 4be1180a9e89
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
4 ;; SUMMARY: Implicit button type for document id index entries. 4 ;; SUMMARY: Implicit button type for document id index entries.
5 ;; USAGE: GNU Emacs Lisp Library 5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: docs, extensions, hypermedia 6 ;; KEYWORDS: docs, extensions, hypermedia
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: InfoDock Associates 9 ;; ORG: Motorola, Inc., PWDG
10 ;; 10 ;;
11 ;; ORIG-DATE: 30-Sep-92 at 19:39:59 11 ;; ORIG-DATE: 30-Sep-92 at 19:39:59
12 ;; LAST-MOD: 12-Dec-96 at 15:15:28 by Bob Weiner 12 ;; LAST-MOD: 14-Apr-95 at 15:58:21 by Bob Weiner
13 ;; 13 ;;
14 ;; This file is part of Hyperbole. 14 ;; This file is part of Hyperbole.
15 ;; Available for use and distribution under the same terms as GNU Emacs. 15 ;; Available for use and distribution under the same terms as GNU Emacs.
16 ;; 16 ;;
17 ;; Copyright (C) 1992-1996, InfoDock Associates 17 ;; Copyright (C) 1992-1995, Free Software Foundation, Inc.
18 ;; Developed with support from Motorola Inc. 18 ;; Developed with support from Motorola Inc.
19 ;; 19 ;;
20 ;; DESCRIPTION: 20 ;; DESCRIPTION:
21 ;; 21 ;;
22 ;; TO USE: 22 ;; TO USE:
32 ;; to do so. See the documentation for 'doc-id-indices'. 32 ;; to do so. See the documentation for 'doc-id-indices'.
33 ;; 33 ;;
34 ;; You must explicitly load this package in order to use it, since 34 ;; You must explicitly load this package in order to use it, since
35 ;; Hyperbole does not load it by default. 35 ;; Hyperbole does not load it by default.
36 ;; 36 ;;
37 ;; Motorola PPG uses doc ids of the form, [Emacs-001], delimited by 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 - and a 38 ;; brackets, starting with a subject name, followed by a -, followed by a
39 ;; multi-digit numeric identifier. 39 ;; multi-digit numeric identifier.
40 ;; 40 ;;
41 ;; Typically an index entry should have links to all available forms of its 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 42 ;; document, e.g. online, printed, source. Below is the index entry form
43 ;; we use. The default variable settings herein work with PPG's formats. If 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. 44 ;; you prefer different ones, you must change all of the variable values.
45 ;; 45 ;;
46 ;; -------------------------------------------------------------------------- 46 ;; --------------------------------------------------------------------------
47 ;; Title: ID: [] 47 ;; Title: ID: []
48 ;; Email-To: 48 ;; Email-To:
80 ;;; Displays a documentation index entry given an ID. 80 ;;; Displays a documentation index entry given an ID.
81 ;;; ======================================================================== 81 ;;; ========================================================================
82 82
83 (defact link-to-doc (doc-id) 83 (defact link-to-doc (doc-id)
84 "Displays online version of a document given by DOC-ID (no delimiters), in other window. 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 85 If online version of document is not found in `doc-id-indices', an error is signalled."
86 signalled."
87 (interactive "sID for document to link to (omit delimiters): ") 86 (interactive "sID for document to link to (omit delimiters): ")
88 (let ((rolo-display-buffer (hypb:help-buf-name "Doc ID")) 87 (let ((rolo-display-buffer (hypb:help-buf-name "Doc ID"))
89 (delim-doc-id (concat doc-id-start doc-id doc-id-end))) 88 (delim-doc-id (concat doc-id-start doc-id doc-id-end)))
90 (cond ((null doc-id-indices) 89 (cond ((null doc-id-indices)
91 (error "(doc-id-index-entry): You must set the `doc-id-indices' variable first.")) 90 (error "(doc-id-index-entry): You must set the 'doc-id-indices' variable first."))
92 ((let ((rolo-entry-regexp doc-id-index-entry-regexp)) 91 ((let ((rolo-entry-regexp doc-id-index-entry-regexp))
93 (= 0 (rolo-grep (funcall doc-id-match doc-id) 92 (= 0 (rolo-grep (funcall doc-id-match doc-id)
94 1 doc-id-indices nil 'no-display))) 93 1 doc-id-indices nil 'no-display)))
95 (error "(doc-id-index-entry): %s not found in document index." 94 (error "(doc-id-index-entry): %s not found in document index."
96 delim-doc-id)) 95 delim-doc-id))
106 (match-beginning 1) (match-end 1))) 105 (match-beginning 1) (match-end 1)))
107 (ibut (ibut:at-p))) 106 (ibut (ibut:at-p)))
108 (if ibut 107 (if ibut
109 (progn (hbut:act ibut) 108 (progn (hbut:act ibut)
110 (message "Displaying %s." delim-doc-id)) 109 (message "Displaying %s." delim-doc-id))
111 (error 110 (error "(link-to-doc): %s invalid online location: %s"
112 "(link-to-doc): %s online location is invalid: \"%s\"" 111 delim-doc-id doc-path))))
113 delim-doc-id doc-path))))
114 (error "(link-to-doc): %s is unavailable in online form." 112 (error "(link-to-doc): %s is unavailable in online form."
115 delim-doc-id))))))) 113 delim-doc-id)))))))
116 114
117 (defib doc-id () 115 (defib doc-id ()
118 "Displays an index entry for a site-specific document given its id. 116 "Displays an index entry for a site-specific document given its id.
119 Ids must be delimited by `doc-id-start' and `doc-id-end' and must 117 Ids must be delimited by 'doc-id-start' and 'doc-id-end' and must
120 match the function given by `doc-id-p'." 118 match the function given by 'doc-id-p'."
121 (and (not (bolp)) 119 (and (not (bolp))
122 (let* ((id-and-pos (hbut:label-p t doc-id-start doc-id-end t)) 120 (let* ((id-and-pos (hbut:label-p t doc-id-start doc-id-end t))
123 (id (car id-and-pos))) 121 (id (car id-and-pos)))
124 (if (funcall doc-id-p id) 122 (if (funcall doc-id-p id)
125 (progn (ibut:label-set id-and-pos) 123 (progn (ibut:label-set id-and-pos)
128 126
129 ;;; ======================================================================== 127 ;;; ========================================================================
130 ;;; Displays a doc from SW Process Tree (Motorola Paging Products Specific) 128 ;;; Displays a doc from SW Process Tree (Motorola Paging Products Specific)
131 ;;; ======================================================================== 129 ;;; ========================================================================
132 130
133 (if (and (boundp 'ppg-sw-process-directory) ppg-sw-process-directory 131 (if (file-exists-p "/proj/process/ppg/")
134 (file-exists-p ppg-sw-process-directory))
135 (defib ppg-sw-process () 132 (defib ppg-sw-process ()
136 "Display a Paging Products software process document whose location is at point." 133 "Display a Paging Products software process document from document id at point."
137 (let ((path (hpath:at-p nil t))) 134 (let ((path (hpath:at-p nil t)))
138 (if (and path (string-match "/.+%s.+%s" path)) 135 (if (and path (string-match "/.+%s.+%s" path))
139 (progn (require 'sw-process) 136 (progn (require 'sw-process)
140 (ibut:label-set path) 137 (ibut:label-set path)
141 (setq path (format path ppg-sw-process-file-format 138 (setq path (format path ppg-sw-process-file-format
146 "^Source-Loc:[ \t]*\"\\([^\"]+\\)\"" nil t) 143 "^Source-Loc:[ \t]*\"\\([^\"]+\\)\"" nil t)
147 (progn 144 (progn
148 (goto-char (match-beginning 1)) 145 (goto-char (match-beginning 1))
149 (let ((path-but (ibut:at-p))) 146 (let ((path-but (ibut:at-p)))
150 (if path-but 147 (if path-but
151 (hbut:act path-but) 148 (hbut:act path-but)))))))))))
152 (error
153 "(ppg-sw-process): \"%s\" does not exist." path)
154 ))))))))))
155 149
156 ;;; ************************************************************************ 150 ;;; ************************************************************************
157 ;;; Public variables 151 ;;; Public variables
158 ;;; ************************************************************************ 152 ;;; ************************************************************************
159 153
160 (defvar doc-id-indices '() 154 (defvar doc-id-indices '()
161 "List of pathnames in which to search for site-specific document index entries. 155 "List of pathnames in which to search for site-specific document index entries.
162 Each file must utilize a wrolo record format, with each record start 156 Each file must utilize a wrolo record format, with each record start
163 delimited by `doc-id-index-entry-regexp'.") 157 delimited by 'doc-id-index-entry-regexp'.")
164 158
165 ;;; ************************************************************************ 159 ;;; ************************************************************************
166 ;;; Private functions 160 ;;; Private functions
167 ;;; ************************************************************************ 161 ;;; ************************************************************************
168 162
180 doc-id-start doc-id doc-id-end))) 174 doc-id-start doc-id doc-id-end)))
181 (let* ((report-buf (hypb:help-buf-name)) 175 (let* ((report-buf (hypb:help-buf-name))
182 (temp-buffer-show-hook 176 (temp-buffer-show-hook
183 (function 177 (function
184 (lambda (buffer) 178 (lambda (buffer)
185 (setq *hkey-wconfig* (current-window-configuration))) 179 (setq *hkey-wconfig*
180 (current-window-configuration)))
186 (let ((wind (get-buffer-create buffer))) 181 (let ((wind (get-buffer-create buffer)))
187 (setq minibuffer-scroll-window wind)))) 182 (setq minibuffer-scroll-window wind))))
188 (temp-buffer-show-function temp-buffer-show-hook)) 183 (temp-buffer-show-function temp-buffer-show-hook))
189 (hbut:report but) 184 (hbut:report but)
190 (save-excursion 185 (save-excursion
219 (lambda (str) 214 (lambda (str)
220 (and (stringp str) 215 (and (stringp str)
221 (> (length str) 0) 216 (> (length str) 0)
222 (= ?w (char-syntax (aref str 0))) 217 (= ?w (char-syntax (aref str 0)))
223 (string-match "\\`\\w+-[0-9][0-9][0-9]+\\'" str)))) 218 (string-match "\\`\\w+-[0-9][0-9][0-9]+\\'" str))))
224 "Function with a boolean result which tests whether or not arg `str' is a doc id.") 219 "Boolean function to test whether arg 'str' is a doc id or not.")
225 220
226 (defvar doc-id-online-regexp "^Online-Loc:[ \t]*\"\\([^\"]+\\)\"" 221 (defvar doc-id-online-regexp "^Online-Loc:[ \t]*\"\\([^\"]+\\)\""
227 "Regexp whose 1st grouping matches an implicit button which displays an online document within an index entry.") 222 "Regexp whose 1st grouping matches an implicit button which displays an online document within an index entry.")
228 223
229 (provide 'hib-doc-id) 224 (provide 'hib-doc-id)