Avoid segfaults when some display vector is an empty string
[emacs.git] / lisp / textmodes / nroff-mode.el
blobcea0c604baf78034de2a48785cc822288de81a9a
1 ;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source
3 ;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2017 Free Software
4 ;; Foundation, Inc.
6 ;; Maintainer: emacs-devel@gnu.org
7 ;; Keywords: wp
9 ;; This file is part of GNU Emacs.
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.
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.
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/>.
24 ;;; Commentary:
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.
32 ;; Paragraph filling and line-counting currently don't respect comments,
33 ;; as they should.
35 ;;; Code:
37 (defgroup nroff nil
38 "Nroff mode."
39 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
40 :group 'text
41 :prefix "nroff-")
44 (defcustom nroff-electric-mode nil
45 "Non-nil means automatically closing requests when you insert an open."
46 :group 'nroff
47 :type 'boolean)
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'.")
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'.")
97 (defvar nroff-imenu-expression
98 ;; man headers:
99 '((nil "^\\.SH \"?\\([^\"\n]*\\)\"?$" 1)))
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 "\\)")
122 "Font-lock highlighting control in `nroff-mode'."
123 :group 'nroff
124 :type '(repeat regexp))
126 (defcustom nroff-mode-hook nil
127 "Hook run by function `nroff-mode'."
128 :type 'hook
129 :group 'nroff)
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))
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))))))
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 ?.)
189 (if (save-excursion
190 (backward-char 1)
191 (looking-at "^[.']"))
193 (max comment-column
194 (* 8 (/ (+ (current-column)
195 9) 8)))))) ; add 9 to ensure at least two blanks
196 (goto-char pt))))
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))
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)))))))
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)
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)))
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" . "..")))
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))))
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.
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")))
314 (declare-function Man-getpage-in-background "man" (topic))
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)))
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")
338 (provide 'nroff-mode)
340 ;;; nroff-mode.el ends here