cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hib-doc-id.el

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