Re: no "perldoc" in emacs?

[Lee Sau Dan]

>>>>> "Dan" == Dan Jacobson <jidanni@deadspam.com> writes:

    Dan> I notice in the shell there is $ man and $ perldoc but in
    Dan> emacs there is only the man stuff.  An apropos search on perl
    Dan> shows no perldoc stuff.  Does this mean one must leave emacs
    Dan> and go to the shell for the latter functionality?

No, because  I also wanted to have  this feature in Emacs  and hence I
have just hacked some code for it.  It's still ugly, but it works.


;;; perldoc.el --- browse Perldoc documentation pages

;; Copyright (C) 2002 Free Software Foundation, Inc.

;; Author:              LEE Sau Dan <danlee@informatik.uni-freiburg.de>
;; Keywords:            help, perldoc
;; $Id: perldoc.el,v 1.1 2002/02/08 12:41:37 sdlee Exp $

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This code provides a few functions for viewing Perl's perldoc
;; manual pages from within Emacs.  `perldoc-function' retrieves
;; the perldoc page for a Perl built-in function.  `perldoc-faq'
;; looks up the FAQ list for questions matching the given regexp.
;; perldoc-module retrieves the perldoc page for the given module.
;; The generic function `perldoc' invokes one of the above functions
;; by guess on the given string.
;; Formatting is done in background so that you
;; can continue to use your Emacs while processing is going on.
;;
;; This library makes use of the code from "man.el" which provides the
;; `man' function.  Most functions there are reused.  A few functions
;; are copied from there and adjusted to make them work for `perldoc'.
;; As a result, please consult also "man.el" for details, esp. on
;; customizations.


;;; Code:

(require 'man)

(defvar perldoc-program "perldoc"
  "The command name for Perl's 'perldoc'")

(defun perldoc (generic-name)
  "Get a perldoc page for the given string.  Guess which that string
means and dispatches to one of `perldoc-function', `perldoc-module' and
`perldoc-faq'."
  (interactive
   (list (let* ((default-entry (Man-default-man-entry))
                (input (read-string
                        (format "Perldoc for%s: "
                                (if (string= default-entry "")
                                    ""
                                  (format " (default %s)" default-entry))))))
           (if (string= input "")
               (if (string= default-entry "")
                   (error "No Perldoc given")
                 default-entry)
             input))))

  (cond ((string-match "^[a-z]+$" generic-name)
         (perldoc-function generic-name))
        ((string-match "^[A-Z][A-Za-z0-9_]+\\(::[A-Z][A-Za-z0-9_]+\\)+$"
                       generic-name)
         (perldoc-module generic-name))
        (t (perldoc-faq generic-name))))


;;;###autoload
(defun perldoc-function (function-name)
  "Get a perldoc page for a built-in Perl function
and put it in a buffer.
This command runs the \"perldoc\"
command to retrieve and clean a documentation page
in the background and places the
results in a Man mode (manpage browsing) buffer.  See variable
`Man-notify-method' for what happens when the buffer is ready.
If a buffer already exists for this perldoc page, it will display immediately."
  (interactive
   (list (let* ((default-entry (Man-default-man-entry))
                (input (read-string
                        (format "Perl builtin function%s: "
                                (if (string= default-entry "")
                                    ""
                                  (format " (default %s)" default-entry))))))
           (if (string= input "")
               (if (string= default-entry "")
                   (error "No Perl function given")
                 default-entry)
             input))))

  ;; Possibly translate the "subject(section)" syntax into the
  ;; "section subject" syntax and possibly downcase the section.
  (perldoc-getpage-in-background (concat "-f " function-name)))

;;;###autoload
(defun perldoc-module (module-name)
  "Get a perldoc page for a module and put it in a buffer.
This command runs the \"perldoc\"
command to retrieve and clean a documentation page
in the background and places the
results in a Man mode (manpage browsing) buffer.  See variable
`Man-notify-method' for what happens when the buffer is ready.
If a buffer already exists for this perldoc page, it will display immediately."
  (interactive
   (list (let* ((default-entry (Man-default-man-entry))
                (input (read-string
                        (format "Perl module%s: "
                                (if (string= default-entry "")
                                    ""
                                  (format " (default %s)" default-entry))))))
           (if (string= input "")
               (if (string= default-entry "")
                   (error "No module name given")
                 default-entry)
             input))))

  ;; Possibly translate the "subject(section)" syntax into the
  ;; "section subject" syntax and possibly downcase the section.
  (perldoc-getpage-in-background module-name))

;;;###autoload
(defun perldoc-faq (faq-regex)
  "Get an faq page for a question (not answer!) matching the given
regular expression and put it in a buffer.
This command runs the \"perldoc\"
command to retrieve and clean a documentation page
in the background and places the
results in a Man mode (manpage browsing) buffer.  See variable
`Man-notify-method' for what happens when the buffer is ready.
If a buffer already exists for this perldoc page, it will display immediately."
  (interactive
   (list (let* ((default-entry (Man-default-man-entry))
                (input (read-string
                        (format "Perl FAQ regex%s: "
                                (if (string= default-entry "")
                                    ""
                                  (format " (default %s)" default-entry))))))
           (if (string= input "")
               (if (string= default-entry "")
                   (error "No FAQ regex given")
                 default-entry)
             input))))

  ;; Possibly translate the "subject(section)" syntax into the
  ;; "section subject" syntax and possibly downcase the section.
  (perldoc-getpage-in-background (concat "-q " faq-regex)))



(defun perldoc-getpage-in-background (args)
  "Call 'perldoc' with args build and fire off the
   perldoc page and cleaning command."
  (let* ((bufname (concat "*perldoc " args "*"))
         (buffer  (get-buffer bufname)))
    (if buffer
        (Man-notify-when-ready buffer)
      (require 'env)
      (message "Invoking %s %s in the background" perldoc-program args)
      (setq buffer (generate-new-buffer bufname))
      (save-excursion
        (set-buffer buffer)
        (setq perldoc-original-frame (selected-frame))
        (setq perldoc-arguments args))
      (let ((process-environment (copy-sequence process-environment))
            ;; The following is so Awk script gets \n intact
            ;; But don't prevent decoding of the outside.
            (coding-system-for-write 'raw-text-unix)
            ;; Avoid possible error by using a directory that always exists.
            (default-directory "/"))
        ;; Prevent any attempt to use display terminal fanciness.
        (setenv "TERM" "dumb")
        (setenv "PERLDOC_PAGER" "cat") ;; sign!  perldoc isn't that friendly!
        (if (fboundp 'start-process)
            (set-process-sentinel
             (start-process manual-program buffer "sh" "-c"
                            (format "%s %s" perldoc-program args))
             'perldoc-bgproc-sentinel)
          (progn
            (let ((exit-status
                   (call-process shell-file-name nil (list buffer nil) nil "-c"
                                 (format "%s %s" perldoc-program args)))
                  (msg ""))
              (or (and (numberp exit-status)
                       (or (= exit-status 0) (= exit-status 255)))
                  (and (numberp exit-status)
                       (setq msg
                             (format "exited abnormally with code %d"
                                     exit-status)))
                  (setq msg exit-status))
              (perldoc-bgproc-sentinel bufname msg))))))))


(defun perldoc-bgproc-sentinel (process msg)
  "Perldoc page background process sentinel.
When 'perldoc' command is run asynchronously, PROCESS is the process 
object for the manpage command; when manpage command is run
synchronously, PROCESS is the name of the buffer where the manpage
command is run.  Second argument MSG is the exit message of the
manpage command."
  (let ((perldoc-buffer (if (stringp process) (get-buffer process)
                      (process-buffer process)))
        (delete-buff nil)
        (err-mess nil))

    (if (null (buffer-name perldoc-buffer)) ;; deleted buffer
        (or (stringp process)
            (set-process-buffer process nil))

      (save-excursion
        (set-buffer perldoc-buffer)
        (let ((case-fold-search nil))
          (goto-char (point-min))
          (cond ((or (looking-at "No documentation for .* found")
                     (looking-at "No documentation found for"))
                 (setq err-mess (buffer-substring (point)
                                                  (progn
                                                    (end-of-line) (point)))
                       delete-buff t))
                ((or (stringp process)
                     (not (and (eq (process-status process) 'exit)
                               (= (process-exit-status process) 0))))
                 (or (zerop (length msg))
                     (progn
                       (setq err-mess
                             (concat (buffer-name perldoc-buffer)
                                     ": process "
                                     (let ((eos (1- (length msg))))
                                       (if (= (aref msg eos) ?\n)
                                           (substring msg 0 eos) msg))))
                       (goto-char (point-max))
                       (insert (format "\nprocess %s" msg))))
                 ))
        (if delete-buff
            (kill-buffer perldoc-buffer)
          (if Man-fontify-manpage-flag
              (Man-fontify-manpage)
            (Man-cleanup-manpage))
          (run-hooks 'Man-cooked-hook)
          (Man-mode)
          (set-buffer-modified-p nil)
          ))
        ;; Restore case-fold-search before calling
        ;; Man-notify-when-ready because it may switch buffers.

        (if (not delete-buff)
            (Man-notify-when-ready perldoc-buffer))

        (if err-mess
            (error err-mess))
        ))))


(provide 'perldoc)

;; end of file; bye!




-- 
Lee Sau Dan                     李守敦(Big5)                    ~{@nJX6X~}(HZ) 

E-mail: danlee@informatik.uni-freiburg.de
Home page: http://www.informatik.uni-freiburg.de/~danlee