man-preview.el -- put nroff source through man

This is a kinda polished version of code I've used to run "man" over
nroff source, mostly for previewing while editing.  It wasn't meant to
be quite this big, but by the time you setup compilation-mode for errors
and attempt some coding system stuff it grows.

;;; man-preview.el --- preview nroff man file source

;; Copyright 2008 Kevin Ryde
;;
;; Author: Kevin Ryde <user42 <at> zip.com.au>
;; Version: 1
;; Keywords: docs
;; URL: http://www.geocities.com/user42_kevin/man-preview/index.html
;;
;; man-preview.el 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 3, or (at your option) any later
;; version.
;;
;; man-preview.el 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 can get a copy of the GNU General Public License online at
;; <http://www.gnu.org/licenses>.

;;; Commentary:

;; M-x man-preview displays a preview of man nroff source using "man -l".
;; The best feature is that when re-previewing the same file or buffer the
;; existing position in the preview is preserved, so if you've just changed
;; the source a little you should be still quite close to where you were in
;; the preview, to see how the change has come out.
;;
;; M-x man "-l filename" does almost the same as this, but it depends on
;; having a disk copy of a buffer, so it can't work out of tar-mode members
;; etc.

;;; Emacsen:
;;
;; Designed for Emacs 21 and 22.  Works in XEmacs 21.

;;; Install:
;;
;; Put man-preview.el somewhere in your `load-path', and in your .emacs
;; add
;;
;;     (autoload 'man-preview "man-preview" nil t)
;;
;; This makes M-x man-preview available, or you might like to bind it
;; to a key, for example f8 in nroff-mode,
;;
;;     (add-hook 'nroff-mode-hook
;;               (lambda ()
;;                 (define-key nroff-mode-map [f8] 'man-preview)))
;;

;;; History:
;;
;; Version 1 - the first version

;;; Code:

(require 'man)

;; xemacs incompatibility
(defalias 'man-preview-make-temp-file
  (if (fboundp 'make-temp-file)
      'make-temp-file   ;; emacs
    ;; xemacs21
    (autoload 'mm-make-temp-file "mm-util") ;; from gnus
    'mm-make-temp-file))

(defconst man-preview-buffer "*man-preview*"
  "The name of the buffer for `man-preview' output.")

(defconst man-preview-error-buffer "*man-preview-errors*"
  "The name of the buffer for `man-preview' error messages.")

(defvar man-preview-origin nil
  "The name of the input buffer being displayed in `man-preview-buffer'.")

;;;###autoload
(defun man-preview ()
  "Preview man page nroff source in the current buffer.
The buffer is put through \"man -l\" and the formatted result
displayed in a buffer.

Errors from man or nroff are shown in a `compilation-mode' buffer
and `next-error' (\\[next-error]) can step through them to see
the offending parts of the source.

------
For reference, non-ascii characters in man page source files
usually don't work very well.  Groff 1.18 for instance can
produce unicode output, but its input is basically bytes (latin1
by default, in principle configurable) and you give roff
directives for the higher characters.

Recent versions of man-db will convert other input codings to
latin1; either from a \"coding:\" cookie in the file or a subdir
like /fr.UTF-8/man1.  The coding cookie is best for
`man-preview', since it just sends to man's stdin, there's no
subdir name for it to follow.

`man-preview' sends bytes as per `buffer-file-coding-system', the
same as if it was a file that man ran on.  Output from man is
requested as -Tlatin1 if the input coding is latin-1, or -Tutf8
for anything else if running in an Emacs which has utf-8."

  (interactive)
  (get-buffer-create man-preview-buffer)

  (let ((origin-buffer (current-buffer))
        (origin-coding buffer-file-coding-system)
        (T-option      "-Tlatin1")
        (T-coding      'iso-8859-1)
        (errorfile     (man-preview-make-temp-file "man-preview-"))
        (directory     default-directory))

    (when (and (not (eq origin-coding 'iso-8859-1))
               (member 'utf-8 (coding-system-list)))
      (setq T-option "-Tutf8")
      (setq T-coding 'utf-8))

    (switch-to-buffer man-preview-buffer)
    (setq buffer-read-only nil)

    ;; default-directory set from the source buffer, so that find-file or
    ;; whatever offers the same default as the source buffer.  This is
    ;; inherited on initial creation of the preview buffer, but has to be
    ;; set explicitly when previewing a new source buffer with a different
    ;; default-directory.
    (setq default-directory directory)

    ;; if previewing a different buffer then erase here so as not to restore
    ;; point+window position into a completely different document
    (if (not (equal man-preview-origin (buffer-name origin-buffer)))
        (erase-buffer))
    (setq man-preview-origin (buffer-name origin-buffer))

    ;; record current point+window positions as line/column
    (let ((point-column (current-column))
          (point-line   (count-lines (point-min) (line-beginning-position)))
          (window-line  (count-lines (point-min) (window-start))))
      (erase-buffer)

      ;; Running man with "-Tlatin1" makes it print overstrikes and
      ;; underscores for bold and italics, which `Man-fontify-manpage' below
      ;; crunches into fontification.
      ;;
      ;; "-Tutf8" output would also be possible, but for now its only effect
      ;; is to make unicode hyphens and other stuff that doesn't display on
      ;; a latin1 tty.  In the future if pod2man put extended characters
      ;; through in way groff understood then probably would want -Tutf8 so
      ;; as to see those.
      ;;
      ;; For man-db (version 2.5 at least) a side-effect of either of those
      ;; -T options is to lose input charset guessing (its "manconv"
      ;; program).
      ;;
      (with-current-buffer origin-buffer
        (let ((coding-system-for-write origin-coding)
              (coding-system-for-read  T-coding))
          (call-process-region (point-min) (point-max) "man"
                               nil ;; don't delete input
                               (list man-preview-buffer errorfile)
                               nil ;; don't redisplay
                               T-option "-l" "-")))

      (with-current-buffer (get-buffer-create man-preview-error-buffer)
        (setq buffer-read-only nil)
        (erase-buffer)
        (insert-file-contents errorfile)

        ;; emacs21 compilation regexps don't like "<standard input>" as a
        ;; filename, so mung that (which is easier than adding to the
        ;; patterns)
        (goto-char (point-min))
        (while (re-search-forward "^<standard input>:" nil t)
          (replace-match "standardinput:" t t))

        (if (= (point-min) (point-max))
            (kill-buffer (current-buffer))

          ;; emacs21 ignores the first two lines of a compilation-mode
          ;; buffer, so add in dummies
          (goto-char (point-min))
          (insert "man-preview\n\n")

          (compilation-mode)
          ;; in emacs21 save-selected-window mangles current-buffer somehow,
          ;; so do it after `compilation-mode'
          (save-selected-window
            (switch-to-buffer-other-window (current-buffer)))))
      (delete-file errorfile)

      (if (fboundp 'Man-mode)
          ;; emacs21 and emacs22
          (progn
            (Man-fontify-manpage)
            (Man-mode))
        ;; xemacs21
        (Manual-nuke-nroff-bs)
        (Manual-mode))

      ;; Restore point line/column and window-start line, if possible.
      ;; But don't let window-start be the very end of the buffer, since
      ;; that would leave it completely blank.
      (goto-line (1+ window-line))
      (if (= (point) (point-max))
          (forward-line -1))
      (set-window-start (selected-window) (point))
      (goto-line (1+ point-line))
      (move-to-column point-column))))

(defadvice compilation-find-file (around man-preview activate)
  "Use `man-preview-origin' buffer for its man/nroff errors."
  (if (equal filename "standardinput")
      (setq ad-return-value man-preview-origin)
    ad-do-it))

(provide 'man-preview)

;;; man-preview.el ends here

_______________________________________________
gnu-emacs-sources mailing list
gnu-emacs-sources <at> gnu.org
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources