emacs での perldoc 環境整備

以下を参考に perl ドキュメント環境を強化

• unwind-protect:emacs の中から perldoc -m
• perl開発に便利なemacs設定 - hakutoitoi’s blog
• EmacsでPerl開発する上で必須な設定 #3 - perldoc-m - Kentaro Kuribayashi's blog
• Perlマニュアルの歩き方 - モダンなPerl入門 - モダンなPerl入門
• Perldocの話 - JPerl Advent Calendar 2009

2010-10-30 Windows 環境以外も考慮
2010-10-27 *Perl * バッファでperldocが開かないのを修正
2010-10-22 色々修正

;; ---------------------------------------------------------
;; perldoc などの情報を表示
;; ---------------------------------------------------------
;; カーソル付近、またはミニバッファで指定したのモジュールの情報を表示
;; [元ネタ]
;; http://saltyduck.blog12.fc2.com/blog-entry-24.html
;; http://d.hatena.ne.jp/hakutoitoi/20090208/1234069614
;; http://d.hatena.ne.jp/antipop/20080702/1214926316
;; http://perl-users.jp/articles/advent-calendar/2009/casual/12.html
;; [使い方]
;; M-x my-perldoc
;;  my-perldoc-* を選択する anything 起動
;; M-x my-perldoc-module
;;  perldoc -m を実行
;; M-x my-perldoc-pod
;;  perldoc。PODをバッファに表示
;; M-x my-perldoc-info
;;  モジュールの名前、パス、バージョンを表示
;; M-x my-perldoc-function
;;  perldoc -f
;; M-x my-perldoc-section
;;  perldoc [perl section]
;; M-x my-perldoc-file
;;  他のウィンドウにファイルをオープン
;; M-x my-perldoc-switch-file
;;  現在のウィンドウでファイルをオープン

;; my-perldoc-section で補完するセクションのリスト
(setq my-perldoc-section-completion-list
      (list "perldoc"
            "perl"
            "perlvar"
            "perlre"
            "perlretut"
            "perlopentut"
            "perlipc"
            "perlxs"
            "perlapi"
            "perlapio"
            "perlguts"
            "perlclib"))

(put 'perl-module-thing 'end-op
     (lambda ()
       (re-search-forward "\\=[a-zA-Z][a-zA-Z0-9_:]*" nil t)))
(put 'perl-module-thing 'beginning-op
     (lambda ()
       (if (re-search-backward "[^a-zA-Z0-9_:]" nil t)
           (forward-char)
         (goto-char (point-min)))))

(defun my-perldoc-get-module-name (prompt &optional collection)
  (interactive)
  (let ((module
         (substring-no-properties (thing-at-point 'perl-module-thing))))
    (setq prompt (or prompt "Module: "))
    (completing-read prompt collection nil nil module)))

(defun my-perldoc-create-and-switch-buffer (mode buffer-name text)
  (interactive)
  (let ((buffer (get-buffer-create buffer-name)))
    (unless (string-match "*Perl " (buffer-name))
      (progn
        (when (one-window-p)
          (split-window))
        (other-window 1) ))
    (switch-to-buffer buffer)
    (toggle-read-only -1)
    (erase-buffer)
    (insert text)
    (goto-char (point-min))
    (funcall mode)
    (toggle-read-only 1)))

(defun my-perldoc-common (cmd mode prompt &optional collection)
  (interactive)
  (let ((module (my-perldoc-get-module-name prompt collection)))
    (let ((result
           (substring
            (shell-command-to-string (concat cmd " " module)) 0 -1)))
      (if (string-match "No module found for" result)
          (message "%s" result)
        (my-perldoc-create-and-switch-buffer
         mode (format "*Perl %s(%s)*" module cmd) result)))))

;; cperl-perldoc、cperl-perldoc-at-point でもいいか？
(defun my-perldoc-module ()
  "perldoc -m"
  (interactive)
  (my-perldoc-common "perldoc -t -T -m" 'cperl-mode "Module: "))

(defun my-perldoc-pod ()
  "perldoc -T"
  (interactive)
  (my-perldoc-common "perldoc -t -T" 'fundamental-mode "Module: "))

(defun my-perldoc-function ()
  "perldoc -f"
  (interactive)
  (my-perldoc-common "perldoc -t -T -f" 'fundamental-mode "Function: "))

(defun my-perldoc-section ()
  "perldoc"
  (interactive)
  (my-perldoc-common "perldoc -t -T"
                     'fundamental-mode
                     "Section: "
                     my-perldoc-section-completion-list))

(defun my-perldoc-info ()
  "show perl info using Module::Build::ModuleInfo"
  (interactive)
  (my-perldoc-common
   "show_perl_module_info.pl" 'fundamental-mode "Module: "))

(defun my-perldoc-file (&optional switch)
  "open file"
  (interactive)
  (let ((module (my-perldoc-get-module-name "File: "))
        (path))
    (setq path
          (substring
           (shell-command-to-string (concat "perldoc -l " module)) 0 -1))
    (if (string-match "No module found for" path)
        (message "%s" path)
      ;; Meadow のときは cygwin を使っていると仮定
      (if (featurep 'meadow)
          (setq path
                (substring
                 (shell-command-to-string
                  (concat "cygpath.exe -wl " path)) 0 -1)))
      (when (not switch)
        (when (one-window-p)
          (split-window))
        (other-window 1))
      (find-file path)
      (toggle-read-only 1))))

(defun my-perldoc-switch-file ()
  "open file at current buffer"
  (interactive)
  (my-perldoc-file t))

(setq my-perldoc-c-source
      '(
        (name . "Perldoc")
        (candidates . (lambda() (list
                                 "my-perldoc-module"
                                 "my-perldoc-pod"
                                 "my-perldoc-function"
                                 "my-perldoc-section"
                                 "my-perldoc-info"
                                 "my-perldoc-file"
                                 "my-perldoc-switch-file")))
        (type . command)
    ))

(defun my-perldoc ()
  "short-cut my-perldoc-*"
  (interactive)
  (anything (list my-perldoc-c-source) "my-perldoc-"))

show_perl_module_info.pl

#!/usr/bin/perl
use strict;
use warnings;
use Module::Build::ModuleInfo;
use Data::Dumper;

my $module = shift || die "need module name";

my $info_ref = Module::Build::ModuleInfo->new_from_module($module);
print "Name    : ", $info_ref->name,     $/;
print "Path    : ", $info_ref->filename, $/;
print "Version : ", $info_ref->version,  $/;
print "Misc    : ", $/, Dumper($info_ref);