lisp/textmodes/nroff-mode.el

   1 ;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source
   2
   3 ;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2014 Free Software
   4 ;; Foundation, Inc.
   5
   6 ;; Maintainer: emacs-devel@gnu.org
   7 ;; Keywords: wp
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This package is a major mode for editing nroff source code.  It knows
  27 ;; about various nroff constructs, ms, mm, and me macros, and will fill
  28 ;; and indent paragraphs properly in their presence.  It also includes
  29 ;; a command to count text lines (excluding nroff constructs), a command
  30 ;; to center a line, and movement commands that know how to skip macros.
  31
  32 ;; Paragraph filling and line-counting currently don't respect comments,
  33 ;; as they should.
  34
  35 ;;; Code:
  36
  37 (defgroup nroff nil
  38   "Nroff mode."
  39   :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
  40   :group 'wp
  41   :prefix "nroff-")
  42
  43
  44 (defcustom nroff-electric-mode nil
  45   "Non-nil means automatically closing requests when you insert an open."
  46   :group 'nroff
  47   :type 'boolean)
  48
  49 (defvar nroff-mode-map
  50   (let ((map (make-sparse-keymap))
  51         (menu-map (make-sparse-keymap)))
  52     (define-key map "\t"  'tab-to-tab-stop)
  53     (define-key map "\es" 'center-line)
  54     (define-key map "\e?" 'nroff-count-text-lines)
  55     (define-key map "\n"  'nroff-electric-newline)
  56     (define-key map "\en" 'nroff-forward-text-line)
  57     (define-key map "\ep" 'nroff-backward-text-line)
  58     (define-key map "\C-c\C-c" 'nroff-view)
  59     (define-key map [menu-bar nroff-mode] (cons "Nroff" menu-map))
  60     (define-key menu-map [nn]
  61       '(menu-item "Newline" nroff-electric-newline
  62                   :help "Insert newline for nroff mode; special if nroff-electric mode"))
  63     (define-key menu-map [nc]
  64       '(menu-item "Count text lines" nroff-count-text-lines
  65                   :help "Count lines in region, except for nroff request lines."))
  66     (define-key menu-map [nf]
  67       '(menu-item "Forward text line" nroff-forward-text-line
  68                   :help "Go forward one nroff text line, skipping lines of nroff requests"))
  69     (define-key menu-map [nb]
  70       '(menu-item "Backward text line" nroff-backward-text-line
  71                   :help "Go backward one nroff text line, skipping lines of nroff requests"))
  72     (define-key menu-map [ne]
  73       '(menu-item "Electric newline mode"
  74                   nroff-electric-mode
  75                   :help "Auto insert closing requests if necessary"
  76                   :button (:toggle . nroff-electric-mode)))
  77     (define-key menu-map [npm]
  78       '(menu-item "Preview as man page" nroff-view
  79                   :help "Run man on this file."))
  80     map)
  81   "Major mode keymap for `nroff-mode'.")
  82
  83 (defvar nroff-mode-syntax-table
  84   (let ((st (copy-syntax-table text-mode-syntax-table)))
  85     ;; " isn't given string quote syntax in text-mode but it
  86     ;; (arguably) should be for use round nroff arguments (with ` and
  87     ;; ' used otherwise).
  88     (modify-syntax-entry ?\" "\"  2" st)
  89     ;; Comments are delimited by \" and newline.
  90     ;; And in groff also \# to newline.
  91     (modify-syntax-entry ?# ".  2"  st)
  92     (modify-syntax-entry ?\\ "\\  1" st)
  93     (modify-syntax-entry ?\n ">" st)
  94     st)
  95   "Syntax table used while in `nroff-mode'.")
  96
  97 (defvar nroff-imenu-expression
  98   ;; man headers:
  99   '((nil "^\\.SH \"?\\([^\"\n]*\\)\"?$" 1)))
 100
 101 (defcustom nroff-font-lock-keywords
 102   (list
 103    ;; Directives are . or ' at start of line, followed by
 104    ;; optional whitespace, then command (which my be longer than
 105    ;; 2 characters in groff).  Perhaps the arguments should be
 106    ;; fontified as well.
 107    "^[.']\\s-*\\sw+"
 108    ;; There are numerous groff escapes; the following get things
 109    ;; like \-, \(em (standard troff) and \f[bar] (groff
 110    ;; variants).  This won't currently do groff's \A'foo' and
 111    ;; the like properly.  One might expect it to highlight an escape's
 112    ;; arguments in common cases, like \f.
 113    (concat "\\\\"                     ; backslash
 114          "\\("                        ; followed by various possibilities
 115          (mapconcat 'identity
 116                     '("[f*n]*\\[.+?]" ; some groff extensions
 117                       "(.."           ; two chars after (
 118                       "[^(\"#]"       ; single char escape
 119                       ) "\\|")
 120          "\\)")
 121    )
 122   "Font-lock highlighting control in `nroff-mode'."
 123   :group 'nroff
 124   :type '(repeat regexp))
 125
 126 (defcustom nroff-mode-hook nil
 127   "Hook run by function `nroff-mode'."
 128   :type 'hook
 129   :group 'nroff)
 130
 131 ;;;###autoload
 132 (define-derived-mode nroff-mode text-mode "Nroff"
 133   "Major mode for editing text intended for nroff to format.
 134 \\{nroff-mode-map}
 135 Turning on Nroff mode runs `text-mode-hook', then `nroff-mode-hook'.
 136 Also, try `nroff-electric-mode', for automatically inserting
 137 closing requests for requests that are used in matched pairs."
 138   (set (make-local-variable 'font-lock-defaults)
 139        ;; SYNTAX-BEGIN is set to backward-paragraph to avoid slow-down
 140        ;; near the end of large buffers due to searching to buffer's
 141        ;; beginning.
 142        '(nroff-font-lock-keywords nil t nil backward-paragraph))
 143   (set (make-local-variable 'outline-regexp) "\\.H[ ]+[1-7]+ ")
 144   (set (make-local-variable 'outline-level) 'nroff-outline-level)
 145   ;; now define a bunch of variables for use by commands in this mode
 146   (set (make-local-variable 'page-delimiter) "^\\.\\(bp\\|SK\\|OP\\)")
 147   (set (make-local-variable 'paragraph-start)
 148        (concat "[.']\\|" paragraph-start))
 149   (set (make-local-variable 'paragraph-separate)
 150        (concat "[.']\\|" paragraph-separate))
 151   ;; Don't auto-fill directive lines starting . or ' since they normally
 152   ;; have to be one line.  But do auto-fill comments .\" .\# and '''.
 153   ;; Comment directives (those starting . or ') are [.'][ \t]*\\[#"]
 154   ;; or ''', and this regexp is everything except those.  So [.']
 155   ;; followed by not backslash and not ' or followed by backslash but
 156   ;; then not # or "
 157   (set (make-local-variable 'auto-fill-inhibit-regexp)
 158        "[.'][ \t]*\\([^ \t\\']\\|\\\\[^#\"]\\)")
 159   ;; comment syntax added by mit-erl!gildea 18 Apr 86
 160   (set (make-local-variable 'comment-start) "\\\" ")
 161   (set (make-local-variable 'comment-start-skip) "\\\\[\"#][ \t]*")
 162   (set (make-local-variable 'comment-column) 24)
 163   (set (make-local-variable 'comment-indent-function) 'nroff-comment-indent)
 164   (set (make-local-variable 'comment-insert-comment-function)
 165        'nroff-insert-comment-function)
 166   (set (make-local-variable 'imenu-generic-expression) nroff-imenu-expression))
 167
 168 (defun nroff-outline-level ()
 169   (save-excursion
 170     (looking-at outline-regexp)
 171     (skip-chars-forward ".H ")
 172     (string-to-number (buffer-substring (point) (+ 1 (point))))))
 173
 174 ;; Compute how much to indent a comment in nroff/troff source.
 175 ;; By mit-erl!gildea April 86
 176 (defun nroff-comment-indent ()
 177   "Compute indent for an nroff/troff comment.
 178 Puts a full-stop before comments on a line by themselves."
 179   (let ((pt (point)))
 180     (unwind-protect
 181         (progn
 182           (skip-chars-backward " \t")
 183           (if (bolp)
 184               (progn
 185                 ;; FIXME delete-horizontal-space?
 186                 (setq pt (1+ pt))
 187                 (insert ?.)
 188                 1)
 189             (if (save-excursion
 190                   (backward-char 1)
 191                   (looking-at "^[.']"))
 192                 1
 193               (max comment-column
 194                    (* 8 (/ (+ (current-column)
 195                               9) 8)))))) ; add 9 to ensure at least two blanks
 196       (goto-char pt))))
 197
 198 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg01869.html
 199 (defun nroff-insert-comment-function ()
 200   "Function for `comment-insert-comment-function' in `nroff-mode'."
 201   (indent-to (nroff-comment-indent))
 202   (insert comment-start))
 203
 204 (defun nroff-count-text-lines (start end &optional print)
 205   "Count lines in region, except for nroff request lines.
 206 All lines not starting with a period are counted up.
 207 Interactively, print result in echo area.
 208 Noninteractively, return number of non-request lines from START to END."
 209   (interactive "r\np")
 210   (if print
 211       (message "Region has %d text lines" (nroff-count-text-lines start end))
 212     (save-excursion
 213       (save-restriction
 214         (narrow-to-region start end)
 215         (goto-char (point-min))
 216         (- (buffer-size) (nroff-forward-text-line (buffer-size)))))))
 217
 218 (defun nroff-forward-text-line (&optional cnt)
 219   "Go forward one nroff text line, skipping lines of nroff requests.
 220 An argument is a repeat count; if negative, move backward."
 221   (interactive "p")
 222   (if (not cnt) (setq cnt 1))
 223   (while (and (> cnt 0) (not (eobp)))
 224     (forward-line 1)
 225     (while (and (not (eobp)) (looking-at "[.']."))
 226       (forward-line 1))
 227     (setq cnt (- cnt 1)))
 228   (while (and (< cnt 0) (not (bobp)))
 229     (forward-line -1)
 230     (while (and (not (bobp))
 231                 (looking-at "[.']."))
 232       (forward-line -1))
 233     (setq cnt (+ cnt 1)))
 234   cnt)
 235
 236 (defun nroff-backward-text-line (&optional cnt)
 237   "Go backward one nroff text line, skipping lines of nroff requests.
 238 An argument is a repeat count; negative means move forward."
 239   (interactive "p")
 240   (nroff-forward-text-line (- cnt)))
 241
 242 (defconst nroff-brace-table
 243   '((".(b" . ".)b")
 244     (".(l" . ".)l")
 245     (".(q" . ".)q")
 246     (".(c" . ".)c")
 247     (".(x" . ".)x")
 248     (".(z" . ".)z")
 249     (".(d" . ".)d")
 250     (".(f" . ".)f")
 251     (".LG" . ".NL")
 252     (".SM" . ".NL")
 253     (".LD" . ".DE")
 254     (".CD" . ".DE")
 255     (".BD" . ".DE")
 256     (".DS" . ".DE")
 257     (".DF" . ".DE")
 258     (".FS" . ".FE")
 259     (".KS" . ".KE")
 260     (".KF" . ".KE")
 261     (".LB" . ".LE")
 262     (".AL" . ".LE")
 263     (".BL" . ".LE")
 264     (".DL" . ".LE")
 265     (".ML" . ".LE")
 266     (".RL" . ".LE")
 267     (".VL" . ".LE")
 268     (".RS" . ".RE")
 269     (".TS" . ".TE")
 270     (".EQ" . ".EN")
 271     (".PS" . ".PE")
 272     (".BS" . ".BE")
 273     (".G1" . ".G2")                     ; grap
 274     (".na" . ".ad b")
 275     (".nf" . ".fi")
 276     (".de" . "..")))
 277
 278 (defun nroff-electric-newline (arg)
 279   "Insert newline for nroff mode; special if nroff-electric mode.
 280 In `nroff-electric-mode', if ending a line containing an nroff opening request,
 281 automatically inserts the matching closing request after point."
 282   (interactive "P")
 283   (let ((completion (save-excursion
 284                       (beginning-of-line)
 285                       (and (null arg)
 286                            nroff-electric-mode
 287                            (<= (point) (- (point-max) 3))
 288                            (cdr (assoc (buffer-substring (point)
 289                                                          (+ 3 (point)))
 290                                        nroff-brace-table)))))
 291         (needs-nl (not (looking-at "[ \t]*$"))))
 292     (if (null completion)
 293         (newline (prefix-numeric-value arg))
 294       (save-excursion
 295         (insert "\n\n" completion)
 296         (if needs-nl (insert "\n")))
 297       (forward-char 1))))
 298
 299 (define-minor-mode nroff-electric-mode
 300   "Toggle automatic nroff request pairing (Nroff Electric mode).
 301 With a prefix argument ARG, enable Nroff Electric mode if ARG is
 302 positive, and disable it otherwise.  If called from Lisp, enable
 303 the mode if ARG is omitted or nil.
 304
 305 Nroff Electric mode is a buffer-local minor mode, for use with
 306 `nroff-mode'.  When enabled, Emacs checks for an nroff request at
 307 the beginning of the line, and inserts the matching closing
 308 request if necessary.  This command toggles that mode (off->on,
 309 on->off), with an argument, turns it on if arg is positive,
 310 otherwise off."
 311   :lighter " Electric"
 312   (or (derived-mode-p 'nroff-mode) (error "Must be in nroff mode")))
 313
 314 (declare-function Man-getpage-in-background "man" (topic))
 315
 316 (defun nroff-view ()
 317   "Run man on this file."
 318   (interactive)
 319   (require 'man)
 320   (let* ((file (buffer-file-name))
 321          (viewbuf (get-buffer (concat "*Man " file "*"))))
 322     (unless file
 323       (error "Buffer is not associated with any file"))
 324     (and (buffer-modified-p)
 325          (y-or-n-p (format "Save buffer %s first? " (buffer-name)))
 326          (save-buffer))
 327     (if viewbuf
 328         (kill-buffer viewbuf))
 329     (Man-getpage-in-background file)))
 330
 331 ;; Old names that were not namespace clean.
 332 (define-obsolete-function-alias 'count-text-lines 'nroff-count-text-lines "22.1")
 333 (define-obsolete-function-alias 'forward-text-line 'nroff-forward-text-line "22.1")
 334 (define-obsolete-function-alias 'backward-text-line 'nroff-backward-text-line "22.1")
 335 (define-obsolete-function-alias 'electric-nroff-newline 'nroff-electric-newline "22.1")
 336 (define-obsolete-function-alias 'electric-nroff-mode 'nroff-electric-mode "22.1")
 337
 338 (provide 'nroff-mode)
 339
 340 ;;; nroff-mode.el ends here