File: c-boxes.el

package info (click to toggle)
recode 3.4.1-11
  • links: PTS
  • area: main
  • in suites: slink
  • size: 1,560 kB
  • ctags: 622
  • sloc: ansic: 10,572; perl: 339; makefile: 317; lisp: 243; sh: 173; lex: 165; awk: 127; sed: 10
file content (406 lines) | stat: -rw-r--r-- 12,900 bytes parent folder | download | duplicates (19)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
;;; Boxed comments for C mode.
;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
;;; Francois Pinard <pinard@iro.umontreal.ca>, April 1991.
;;;
;;; I often refill paragraphs inside C comments, while stretching or
;;; shrinking the surrounding box as needed.  This is a real pain to
;;; do by hand.  Here is the code I made to ease my life on this,
;;; usable from within GNU Emacs.  It would not be fair giving all
;;; sources for a product without also giving the means for nicely
;;; modifying them.
;;;
;;; The function rebox-c-comment adjust comment boxes without
;;; refilling comment paragraphs, while reindent-c-comment adjust
;;; comment boxes after refilling.  Numeric prefixes are used to add,
;;; remove, or change the style of the box surrounding the comment.
;;; Since refilling paragraphs in C mode does make sense only for
;;; comments, this code redefines the M-q command in C mode.  I use
;;; this hack by putting, in my .emacs file:
;;;
;;;	(setq c-mode-hook
;;;	      '(lambda ()
;;;		 (define-key c-mode-map "\M-q" 'reindent-c-comment)))
;;;	(autoload 'rebox-c-comment "c-boxes" nil t)
;;;	(autoload 'reindent-c-comment "c-boxes" nil t)
;;;
;;; The cursor should be within a comment before any of these
;;; commands, or else it should be between two comments, in which case
;;; the command applies to the next comment.  When the command is
;;; given without prefix, the current comment box type is recognized
;;; and preserved.  Given 0 as a prefix, the comment box disappears
;;; and the comment stays between a single opening `/*' and a single
;;; closing `*/'.  Given 1 or 2 as a prefix, a single or doubled lined
;;; comment box is forced.  Given 3 as a prefix, a Taarna style box is
;;; forced, but you do not even want to hear about those.  When a
;;; negative prefix is given, the absolute value is used, but the
;;; default style is changed.  Any other value (like C-u alone) forces
;;; the default box style.
;;;
;;; I observed rounded corners first in some code from Warren Tucker
;;; <wht@n4hgf.mt-park.ga.us>.

(defvar c-box-default-style 'single "*Preferred style for box comments.")
(defvar c-mode-taarna-style nil "*Non-nil for Taarna team C-style.")

;;; Set or reset the Taarna team's own way for a C style.

(defun taarna-mode ()
  (interactive)
  (if c-mode-taarna-style
      (progn

	(setq c-mode-taarna-style nil)
	(setq c-indent-level 2)
	(setq c-continued-statement-offset 2)
	(setq c-brace-offset 0)
	(setq c-argdecl-indent 5)
	(setq c-label-offset -2)
	(setq c-tab-always-indent t)
	(setq c-box-default-style 'single)
	(message "C mode: GNU style"))

    (setq c-mode-taarna-style t)
    (setq c-indent-level 4)
    (setq c-continued-statement-offset 4)
    (setq c-brace-offset -4)
    (setq c-argdecl-indent 4)
    (setq c-label-offset -4)
    (setq c-tab-always-indent t)
    (setq c-box-default-style 'taarna)
    (message "C mode: Taarna style")))

;;; Return the minimum value of the left margin of all lines, or -1 if
;;; all lines are empty.

(defun buffer-left-margin ()
  (let ((margin -1))
    (goto-char (point-min))
    (while (not (eobp))
      (skip-chars-forward " \t")
      (if (not (looking-at "\n"))
	  (setq margin
		(if (< margin 0)
		    (current-column)
		  (min margin (current-column)))))
      (forward-line 1))
    margin))

;;; Return the maximum value of the right margin of all lines.  Any
;;; sentence ending a line has a space guaranteed before the margin.

(defun buffer-right-margin ()
  (let ((margin 0) period)
    (goto-char (point-min))
    (while (not (eobp))
      (end-of-line)
      (if (bobp)
	  (setq period 0)
	(backward-char 1)
	(setq period (if (looking-at "[.?!]") 1 0))
	(forward-char 1))
      (setq margin (max margin (+ (current-column) period)))
      (forward-char 1))
    margin))

;;; Add, delete or adjust a C comment box.  If FLAG is nil, the
;;; current boxing style is recognized and preserved.  When 0, the box
;;; is removed; when 1, a single lined box is forced; when 2, a double
;;; lined box is forced; when 3, a Taarna style box is forced.  If
;;; negative, the absolute value is used, but the default style is
;;; changed.  For any other value (like C-u), the default style is
;;; forced.  If REFILL is not nil, refill the comment paragraphs prior
;;; to reboxing.

(defun rebox-c-comment-engine (flag refill)
  (save-restriction
    (let ((undo-list buffer-undo-list)
	  (marked-point (point-marker))
	  (saved-point (point))
	  box-style left-margin right-margin)

      ;; First, find the limits of the block of comments following or
      ;; enclosing the cursor, or return an error if the cursor is not
      ;; within such a block of comments, narrow the buffer, and
      ;; untabify it.

      ;; - insure the point is into the following comment, if any

      (skip-chars-forward " \t\n")
      (if (looking-at "/\\*")
	  (forward-char 2))

      (let ((here (point)) start end temp)

	;; - identify a minimal comment block

	(search-backward "/*")
	(setq temp (point))
	(beginning-of-line)
	(setq start (point))
	(skip-chars-forward " \t")
	(if (< (point) temp)
	    (progn
	      (goto-char saved-point)
	      (error "text before comment's start")))
	(search-forward "*/")
	(setq temp (point))
	(end-of-line)
	(if (looking-at "\n")
	    (forward-char 1))
	(setq end (point))
	(skip-chars-backward " \t\n")
	(if (> (point) temp)
	    (progn
	      (goto-char saved-point)
	      (error "text after comment's end")))
	(if (< end here)
	    (progn
	      (goto-char saved-point)
	      (error "outside any comment block")))

	;; - try to extend the comment block backwards

	(goto-char start)
	(while (and (not (bobp))
		    (progn (previous-line 1)
			   (beginning-of-line)
			   (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")))
	  (setq start (point)))

	;; - try to extend the comment block forward

	(goto-char end)
	(while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")
	  (forward-line 1)
	  (beginning-of-line)
	  (setq end (point)))

	;; - narrow to the whole block of comments

	(narrow-to-region start end))

      ;; Second, remove all the comment marks, and move all the text
      ;; rigidly to the left to insure the left margin stays at the
      ;; same place.  At the same time, recognize and save the box
      ;; style in BOX-STYLE.

      (let ((previous-margin (buffer-left-margin))
	    actual-margin)

	;; - remove all comment marks

	(goto-char (point-min))
	(replace-regexp "^\\([ \t]*\\)/\\*" "\\1  ")
	(goto-char (point-min))
	(replace-regexp "^\\([ \t]*\\)|" "\\1 ")
	(goto-char (point-min))
	(replace-regexp "\\(\\*/\\||\\)[ \t]*" "")
	(goto-char (point-min))
	(replace-regexp "\\*/[ \t]*/\\*" " ")

	;; - remove the first and last dashed lines

	(setq box-style 'plain)
	(goto-char (point-min))
	(if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n")
	    (progn
	      (setq box-style 'single)
	      (replace-match ""))
	  (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n")
	      (progn
		(setq box-style 'double)
		(replace-match ""))))
	(goto-char (point-max))
	(previous-line 1)
	(beginning-of-line)
	(if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n")
	    (progn
	      (if (eq box-style 'plain)
		  (setq box-style 'taarna))
	      (replace-match "")))

	;; - remove all spurious whitespace

	(goto-char (point-min))
	(replace-regexp "[ \t]+$" "")
	(goto-char (point-min))
	(if (looking-at "\n+")
	    (replace-match ""))
	(goto-char (point-max))
	(skip-chars-backward "\n")
	(if (looking-at "\n\n+")
	    (replace-match "\n"))
	(goto-char (point-min))
	(replace-regexp "\n\n\n+" "\n\n")

	;; - move the text left is adequate

	(setq actual-margin (buffer-left-margin))
	(if (not (= previous-margin actual-margin))
	    (indent-rigidly (point-min) (point-max)
			    (- previous-margin actual-margin))))

      ;; Third, select the new box style from the old box style and
      ;; the argument, choose the margins for this style and refill
      ;; each paragraph.

      ;; - modify box-style only if flag is defined

      (if flag
	  (setq box-style
		(cond ((eq flag 0) 'plain)
		      ((eq flag 1) 'single)
		      ((eq flag 2) 'double)
		      ((eq flag 3) 'taarna)
		      ((eq flag '-) (setq c-box-default-style 'plain) 'plain)
		      ((eq flag -1) (setq c-box-default-style 'single) 'single)
		      ((eq flag -2) (setq c-box-default-style 'double) 'double)
		      ((eq flag -3) (setq c-box-default-style 'taarna) 'taarna)
		      (t c-box-default-style))))

      ;; - compute the left margin

      (setq left-margin (buffer-left-margin))

      ;; - temporarily set the fill prefix and column, then refill

      (untabify (point-min) (point-max))

      (if refill
	  (let ((fill-prefix (make-string left-margin ? ))
		(fill-column (- fill-column
				(if (memq box-style '(single double)) 4 6))))
	    (fill-region (point-min) (point-max))))

      ;; - compute the right margin after refill

      (setq right-margin (buffer-right-margin))

      ;; Fourth, put the narrowed buffer back into a comment box,
      ;; according to the value of box-style.  Values may be:
      ;;    plain: insert between a single pair of comment delimiters
      ;;    single: complete box, overline and underline with dashes
      ;;    double: complete box, overline and underline with equal signs
      ;;    taarna: comment delimiters on each line, underline with dashes

      ;; - move the right margin to account for left inserts

      (setq right-margin (+ right-margin
			    (if (memq box-style '(single double))
				2
			      3)))

      ;; - construct the box comment, from top to bottom

      (goto-char (point-min))
      (cond ((eq box-style 'plain)

	     ;; - construct a plain style comment

	     (skip-chars-forward " " (+ (point) left-margin))
	     (insert (make-string (- left-margin (current-column)) ? )
		     "/* ")
	     (end-of-line)
	     (forward-char 1)
	     (while (not (eobp))
	       (skip-chars-forward " " (+ (point) left-margin))
	       (insert (make-string (- left-margin (current-column)) ? )
		       "   ")
	       (end-of-line)
	       (forward-char 1))
	     (backward-char 1)
	     (insert "  */"))
	    ((eq box-style 'single)

	     ;; - construct a single line style comment

	     (indent-to left-margin)
	     (insert "/*")
	     (insert (make-string (- right-margin (current-column)) ?-)
		     "-.\n")
	     (while (not (eobp))
	       (skip-chars-forward " " (+ (point) left-margin))
	       (insert (make-string (- left-margin (current-column)) ? )
		       "| ")
	       (end-of-line)
	       (indent-to right-margin)
	       (insert " |")
	       (forward-char 1))
	     (indent-to left-margin)
	     (insert "`")
	     (insert (make-string (- right-margin (current-column)) ?-)
		     "*/\n"))
	    ((eq box-style 'double)

	     ;; - construct a double line style comment

	     (indent-to left-margin)
	     (insert "/*")
	     (insert (make-string (- right-margin (current-column)) ?=)
		     "=\\\n")
	     (while (not (eobp))
	       (skip-chars-forward " " (+ (point) left-margin))
	       (insert (make-string (- left-margin (current-column)) ? )
		       "| ")
	       (end-of-line)
	       (indent-to right-margin)
	       (insert " |")
	       (forward-char 1))
	     (indent-to left-margin)
	     (insert "\\")
	     (insert (make-string (- right-margin (current-column)) ?=)
		     "*/\n"))
	    ((eq box-style 'taarna)

	     ;; - construct a Taarna style comment

	     (while (not (eobp))
	       (skip-chars-forward " " (+ (point) left-margin))
	       (insert (make-string (- left-margin (current-column)) ? )
		       "/* ")
	       (end-of-line)
	       (indent-to right-margin)
	       (insert " */")
	       (forward-char 1))
	     (indent-to left-margin)
	     (insert "/* ")
	     (insert (make-string (- right-margin (current-column)) ?-)
		     " */\n"))
	    (t (error "unknown box style")))

      ;; Fifth, retabify, restore the point position, then cleanup the
      ;; undo list of any boundary since we started.

      ;; - retabify before left margin only (adapted from tabify.el)

      (goto-char (point-min))
      (while (re-search-forward "^[ \t][ \t][ \t]*" nil t)
	(let ((column (current-column))
	      (indent-tabs-mode t))
	  (delete-region (match-beginning 0) (point))
	  (indent-to column)))

      ;; - restore the point position

      (goto-char (marker-position marked-point))

      ;; - remove all intermediate boundaries from the undo list

      (if (not (eq buffer-undo-list undo-list))
	  (let ((cursor buffer-undo-list))
	    (while (not (eq (cdr cursor) undo-list))
	      (if (car (cdr cursor))
		  (setq cursor (cdr cursor))
		(rplacd cursor (cdr (cdr cursor))))))))))

;;; Rebox a C comment without refilling it.

(defun rebox-c-comment (flag)
  (interactive "P")
  (rebox-c-comment-engine flag nil))

;;; Rebox a C comment after refilling.

(defun reindent-c-comment (flag)
  (interactive "P")
  (rebox-c-comment-engine flag t))