cgit.sxemacs.org Git - packages/blob - mule-packages/lookup/packages/dict-misc/foldoc.el

   1 ;;; foldoc.el --- supplement file for "FOLDOC"
   2 ;; Copyright (C) 1999 Lookup Development Team <lookup@ring.gr.jp>
   3
   4 ;; Author: Keisuke Nishida <kei@psn.net>
   5 ;; Target: ndic 1.0, ndict 1.0
   6 ;; Format: 1.1
   7 ;; Version: $Id: foldoc.el,v 1.1 1999-07-23 07:17:34 steveb Exp $
   8
   9 ;; This program is free software; you can redistribute it and/or
  10 ;; modify it under the terms of the GNU General Public License
  11 ;; as published by the Free Software Foundation; either version 2
  12 ;; of the License, or (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program; if not, write to the Free Software Foundation,
  21 ;; Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22
  23 ;;; Code:
  24
  25 (require 'lookup-package)
  26
  27 (defconst foldoc-arrange-functions
  28   '(foldoc-fix-by-black-list
  29     foldoc-arrange-references
  30     lookup-arrange-default-headings
  31     lookup-arrange-fill-paragraphs))
  32
  33 (defconst foldoc-adjust-functions
  34   '(lookup-adjust-check-references
  35     lookup-adjust-goto-min))
  36
  37 (setq lookup-package-dictionary-options
  38       (list (cons ':title "FOLDOC")
  39             (cons ':arranges foldoc-arrange-functions)
  40             (cons ':adjusts foldoc-adjust-functions)))
  41
  42 (defun foldoc-fix-by-black-list (entry)
  43   (let ((heading (lookup-entry-heading entry)))
  44     (cond
  45      ((string= heading "control flow")
  46       (search-forward "structures}") (replace-match "structure}")))))
  47
  48 (defun foldoc-arrange-references (entry)
  49   (let ((dictionary (lookup-entry-dictionary entry))
  50         start end heading url reference)
  51     (while (re-search-forward "{[^}]+}" nil t)
  52       (setq start (1+ (match-beginning 0)) end (1- (match-end 0)))
  53       (setq heading (buffer-substring-no-properties start end))
  54       (while (string-match "\n *" heading)
  55         (setq heading (replace-match " " t t heading)))
  56       (if (string-match " *(\\([a-z]+://[^)]*\\))" heading)
  57           (setq url (match-string 1 heading)
  58                 heading (if (eq (match-beginning 0) 0) url
  59                           (substring heading 0 (match-beginning 0)))
  60                 reference (lookup-make-url-reference url heading))
  61         (setq reference (lookup-make-reference dictionary heading heading))
  62         (lookup-reference-make-dynamic reference 'lookup-dynamic-code-search))
  63       (lookup-set-link start end reference)
  64       (delete-region end (1+ end))
  65       (delete-region (1- start) start))))
  66
  67 ;;; foldoc.el ends here