View on
Florian Ragwitz > pod-mode > pod-mode.el


Annotate this POD



Open  2
View/Report Bugs

(defun pod-linkable-sections-for-module (module) "Extract POD sections from MODULE. Opens the documentation of an installed perl MODULE and returns a list of all section names in it.

`pod-linkable-sections-for-buffer' is used to actually extract the sections." (with-current-buffer (get-buffer-create (concat "*POD " module "*")) (unwind-protect (progn (kill-all-local-variables) (erase-buffer) (text-mode) (let ((default-directory "/")) (call-process "perldoc" nil (current-buffer) nil "-T" "-u" module) (goto-char (point-min)) (when (and (> (count-lines (point-min) (point-max)) 1) (not (re-search-forward "No documentation found for .*" nil t))) (pod-linkable-sections-for-buffer (current-buffer))))) (kill-buffer (current-buffer)))))

(defun pod-linkable-sections (&optional module) "Extract POD sections. Extracts all POD sections from either the current buffer, or, if MODULE is given, from the POD documentation of an installed module.

If MODULE is given, `pod-linkable-sections-for-module' will be called. Otherwise `pod-linkable-sections-for-buffer' for `current-buffer', and with all additional POD section keywords as provided by `pod-weaver-section-keywords'." (if module (pod-linkable-sections-for-module module) (pod-linkable-sections-for-buffer (current-buffer) (mapcar (lambda (i) (car i)) pod-weaver-section-keywords))))

(defun pod-linkable-modules (&optional re-cache) "Find all installed perl modules. Returns a list of all installed perl modules, as provided by function `perldoc-modules-alist'. This requires `perldoc' to be loadable.

If the optional argument RE-CACHE is non-nil, a possibly cached version of the module list will be discarded and rebuilt." (save-current-buffer (when (ignore-errors (require 'perldoc)) (when (or re-cache (not perldoc-modules-alist)) (message "Building completion list of all perl modules...")) (mapcar (lambda (i) (car i)) (perldoc-modules-alist re-cache)))))

(defun pod-link (link &optional text) "Insert a POD hyperlink formatting code. Inserts a POD L<> formatting code at point. The content of the code will be LINK.

If the optional argument TEXT is a string and contains anything that's not whitespace, it will be used as the link title." (insert (concat "" (when (and (stringp text) (string-match-p "[^\s]" text)) (concat text "")))

(defun pod-completing-read (prompt choices) "Use `completing-read' to do a completing read." (completing-read prompt choices))

(defun pod-icompleting-read (prompt choices) "Use iswitchb to do a completing read." (let ((iswitchb-make-buflist-hook (lambda () (setq iswitchb-temp-buflist choices)))) (unwind-protect (progn (when (not iswitchb-mode) (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) (iswitchb-read-buffer prompt)) (when (not iswitchb-mode) (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))

(defun pod-ido-completing-read (prompt choices) "Use ido to do a completing read." (ido-completing-read prompt choices))

(defcustom pod-completing-read-function #'pod-icompleting-read "Ask the user to select a single item from a list. Used by `pod-link-section', `pod-link-module', and `pod-link-module-section'." :group 'pod-mode :type '(radio (function-item :doc "Use Emacs' standard `completing-read' function." pod-completing-read) (function-item :doc "Use iswitchb's completing-read function." pod-icompleting-read) (function-item :doc "Use ido's completing-read function." pod-ido-completing-read) (function)))

(defun pod-do-completing-read (&rest args) "Do a completing read with the configured `pod-completing-read-function'." (apply pod-completing-read-function args))

(defun pod-link-uri (uri &optional text) "Insert POD hyperlink formatting code for a URL. Calls `pod-link' with URI and TEXT.

When called interactively, URI and TEXT will be read from the minibuffer." (interactive (list (read-string "URI: ") (read-string "Text: "))) (pod-link uri text))

(defun pod-link-section (section &optional text) "Insert hyperlink formatting code for a POD section. Insert an L<> formatting code pointing to a section within the current document.

When called interactively, SECTION and TEXT will be read using `pod-do-completing-read'.

When reading SECTION, `pod-linkable-sections' will be used to provide completions." (interactive (list (pod-do-completing-read "Section: " (pod-linkable-sections)) (read-string "Text: "))) (pod-link-module-section "" section text))

(defun pod-link-module (module &optional text) "Insert POD hyperlink formatting code for a module. Insert an L<> formatting code pointing to a MODULE.

When called interactively, MODULE and TEXT will be read using `pod-do-completing-read'.

When reading MODULE, `pod-linkable-modules' will be used to provide completions." (interactive (list (pod-do-completing-read "Module: " (pod-linkable-modules current-prefix-arg)) (read-string "Text: "))) (pod-link module text))

(defun pod-link-module-section (module section &optional text) "Insert POD hyperlink formatting code for a section in a module. Insert an L<> formatting code pointing to a part of MODULE documentation as described by SECTION.

When called interactive, MODULE, SECTION, and TEXT will be read using `pod-do-completing-read'.

When reading MODULE and SECTION, `pod-linkable-modules' and `pod-linkable-sections', respectively, will be used to provide completions." (interactive (let ((module (pod-do-completing-read "Module: " (pod-linkable-modules current-prefix-arg)))) (list module (pod-do-completing-read "Section: " (pod-linkable-sections module)) (read-string "Text: ")))) (pod-link (concat module "/" (if (string-match-p "\s" section) (concat "\"" section "\"") section)) text))

(defvar pod-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-l u") 'pod-link-uri) (define-key map (kbd "C-c C-l s") 'pod-link-section) (define-key map (kbd "C-c C-l m") 'pod-link-module) (define-key map (kbd "C-c C-l M") 'pod-link-module-section) map) "Keymap for POD major mode.")

(defvar pod-mode-syntax-table (let ((st (make-syntax-table))) st) "Syntax table for `pod-mode'.")

(defun pod-add-support-for-outline-minor-mode (&rest sections) "Provides additional menus from section commands for function `outline-minor-mode'.

SECTIONS can be used to supply section commands in addition to the POD defaults." (make-local-variable 'outline-regexp) (setq outline-regexp (format "=%s\s" (regexp-opt (append (loop for i from 1 to 4 collect (format "head%d" i)) '("item") sections)))) (make-local-variable 'outline-level) (setq outline-level (lambda () (save-excursion (save-match-data (let ((sect (format "^=%s\s" (regexp-opt (mapcar (lambda (i) (car i)) pod-weaver-section-keywords) t)))) (cond ((looking-at sect) (cdr (assoc (match-string-no-properties 1) pod-weaver-section-keywords))) ((looking-at "^=item\s") 5) ((string-to-number (buffer-substring (+ (point) 5) (+ (point) 6)))))))))))

(defun pod-add-support-for-imenu (&rest sections) "Set up `imenu-generic-expression' for pod section commands. SECTIONS can be used to supply section commands in addition to the POD defaults." (setq imenu-generic-expression `((nil ,(format "^=\\(?:%s\\)\s+\\(.*\\)" (regexp-opt (append (loop for i from 1 to 4 collect (format "head%d" i)) '("item") sections))) 1))))

(defun pod-enable-weaver-collector-keywords (collectors) "Enable support for Pod::Weaver collector commands. Enables fontification for all commands described by COLLECTORS.

Also updates `pod-weaver-section-keywords', `outline-regexp', and `imenu-generic-expression' accordingly." (let ((collectors-by-replacement)) (save-match-data (setf pod-weaver-section-keywords (loop for col in collectors with cmd with new-cmd with new-name do (progn (setq cmd (getf col 'command) new-cmd (getf col 'new_command) new-name (symbol-name new-cmd)) (let ((pos (loop for i in collectors-by-replacement do (when (equal (car i) new-cmd) (return i))))) (if (not pos) (push (list new-cmd cmd) collectors-by-replacement) (setcdr (last pos) (list cmd))))) when (string-match "^head\\([1-4]\\)$" new-name) collect (cons (symbol-name cmd) (string-to-number (match-string-no-properties 1 new-name))) when (string-match "^item$" new-name) collect (cons (symbol-name cmd) 5)))) (let ((sections (mapcar (lambda (i) (car i)) pod-weaver-section-keywords))) (apply #'pod-add-support-for-outline-minor-mode sections) (apply #'pod-add-support-for-imenu sections)) (setf pod-font-lock-keywords (append (mapcar (lambda (i) (append (list (format "^\\(=%s\\)\\(.*\\)" (regexp-opt (mapcar (lambda (k) (symbol-name k)) (cdr i))))) (let ((n (symbol-name (car i)))) (if (string-match-p "^head[1-4]$" n) (list `(1 (quote ,(intern (format "pod-mode-%s-face" n)))) `(2 (quote ,(intern (format "pod-mode-%s-text-face" n))))) (list '(1 'pod-mode-command-face) '(2 'pod-mode-command-text-face)))))) collectors-by-replacement) pod-font-lock-keywords)) (setq font-lock-mode-major-mode nil) (font-lock-fontify-buffer)))

(defun pod-enable-weaver-features (buffer weaver-config) "Enable support for Pod::Weaver features. Enables support for custom Pod::Weaver commands within a BUFFER.

WEAVER-CONFIG is a structure as returned by \"dzil weaverconf -f lisp\".

Currently only supports collector commands via `pod-enable-weaver-collector-keywords'." (with-current-buffer buffer (pod-enable-weaver-collector-keywords (getf weaver-config 'collectors)) (message "Pod::Weaver keywords loaded.")))

(defun pod-load-weaver-config (dir) "Load additional pod keywords from dist.ini/weaver.ini in DIR." (let* ((proc (start-process-shell-command (concat "weaverconf-" (buffer-name (current-buffer))) nil (format "cd %s; dzil weaverconf -f lisp" dir)))) (set-process-plist proc (list :buffer (current-buffer) :output "")) (set-process-filter proc (lambda (proc str) (let ((plist (process-plist proc))) (plist-put plist :output (concat (plist-get plist :output) str))))) (set-process-sentinel proc (lambda (proc event) (if (string-equal event "finished\n") (let* ((plist (process-plist proc)) (weaver-config (ignore-errors (eval (car (read-from-string (plist-get plist :output))))))) (if weaver-config (pod-enable-weaver-features (plist-get (process-plist proc) :buffer) weaver-config))))))))

(defun pod-add-support-for-weaver () "Enable support for Pod::Weaver features in the current buffer. Calls `pod-load-weaver-config' with the project directory of the current buffer's file. To be able to successfully determine the project directory, `eproject-maybe-turn-on' will be used and 'eproject.el' is expected to be loaded.

Does nothing if finding the project directory fails." (let ((project-root (ignore-errors (eproject-maybe-turn-on)))) (if project-root (pod-load-weaver-config project-root))))

;;;###autoload (defun pod-mode () "Major mode for editing POD files (Plain Old Documentation for Perl).

Commands:\\<pod-mode-map> \\[pod-link] `pod-link' \\[pod-link-section] `pod-link-section' \\[pod-link-module] `pod-link-module' \\[pod-link-module-section] `pod-link-module-section'

Turning on pod mode calls the hooks in `pod-mode-hook'." (interactive) (kill-all-local-variables) (set-syntax-table pod-mode-syntax-table) (use-local-map pod-mode-map) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(pod-font-lock-keywords 't)) (setq major-mode 'pod-mode) (setq mode-name "POD") (pod-add-support-for-imenu) (pod-add-support-for-outline-minor-mode) (run-hooks 'pod-mode-hook) (pod-add-support-for-weaver))

(provide 'pod-mode)

;;; pod-mode.el ends here

syntax highlighting: