home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3171 / perl-descr.el next >
Encoding:
Text File  |  1991-04-08  |  2.6 KB  |  86 lines
  1. ;; @(#)@ perl-descr.el    1.6 - describe-perl-symbol
  2.  
  3. ;; This file defines the function 'describe-perl-symbol, which
  4. ;; displays a one-line information on a perl symbol.
  5.  
  6. ;; Based on 'describe-lisp-symbol' and others.
  7. ;; Hacked for Perl by Johan Vromans <jv@mh.nl>
  8.  
  9. (defvar perl-doc-file "~/elisp/perl-descr.txt"
  10.   "*Where the documentation file can be found.")
  11.  
  12. (defun perl-symbol-at-point ()
  13.   "Get the closest Perl symbol to point, but don't change your
  14. position. Has a preference for looking backward when not
  15. directly on a symbol."
  16.  
  17.   (let ((perl-wordchars "a-zA-Z0-9_") start end symbol)
  18.           
  19.     (save-excursion
  20.  
  21.       ;; first see if you're just past a symbol
  22.       (if (eobp)
  23.       (if (not (bobp))
  24.           (backward-char 1))
  25.     (if (looking-at "[] \t\n[{}()]")
  26.         (progn
  27.           (skip-chars-backward " \n\t\r({[]})")
  28.           (if (not (bobp))
  29.           (backward-char 1)))))
  30.  
  31.       (if (looking-at (concat "[$%@]?[" perl-wordchars "]"))
  32.       (progn
  33.         (skip-chars-backward perl-wordchars)
  34.         (setq start (point))
  35.         ; Get identifier. Include leading $ % @ to find things like
  36.         ; @ARGV and %ENV .
  37.         (if (string-match "[$%@]" (char-to-string (preceding-char)))
  38.         (setq start (1- start))
  39.           (forward-char 1))
  40.         (skip-chars-forward perl-wordchars))
  41.  
  42.     ;; else a symbol?
  43.       (progn
  44.         (setq start (point))
  45.         (if (looking-at "[$@][^ \n\t]") ; special variable
  46.         (forward-char 1)
  47.           (if (string-match "[$@]" (char-to-string (preceding-char)))
  48.           (setq start (1- start))))
  49.         (forward-char 1)))
  50.       (buffer-substring start (point)))))
  51.  
  52. (defun describe-perl-symbol (symbol)
  53.   "Display the documentation of SYMBOL, a Perl operator."
  54.   (interactive
  55.     (let ((fn (perl-symbol-at-point))
  56.       (enable-recursive-minibuffers t)
  57.       (case-fold-search nil)    ;require that case match for search
  58.       val args-file regexp)
  59.       (setq val (read-from-minibuffer
  60.           (if fn
  61.               (format "Symbol (default %s): " fn)
  62.             "Symbol: ")))
  63.       (if (string= val "")
  64.       (setq val fn))
  65.       (setq regexp (concat "^" (regexp-quote val) "\\([ \t([/]\\|$\\)"))
  66.  
  67.       ;; get the buffer with the documentation text
  68.       (if (not (get-file-buffer perl-doc-file))
  69.       (progn
  70.         (setq args-file
  71.           (find-file-noselect perl-doc-file))
  72.         (set-buffer args-file)
  73.         (rename-buffer "*PERL-DOC*")
  74.         (setq buffer-read-only t)))
  75.       (set-buffer (get-file-buffer perl-doc-file))
  76.  
  77.       ;; lookup in the doc
  78.       (goto-char (point-min))
  79.       (list (if (re-search-forward regexp (point-max) t)
  80.         (save-excursion
  81.           (beginning-of-line 1)
  82.           (let ((lnstart (point)))
  83.             (end-of-line)
  84.             (message "%s" (buffer-substring lnstart (point)))))
  85.           (error (format "No definition for %s" val)))))))
  86.