summary refs log tree commit diff stats
path: root/emacs/elisp/xrdb-mode.el
blob: 712f0cbf5c5f7a8fc99daf44acb5425bdf286734 (plain)
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
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
;;; xrdb-mode.el --- mode for editing X resource database files

;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.

;; Author:        1994-2003 Barry A. Warsaw
;; Maintainer:    barry@python.org
;; Created:       May 1994
;; Keywords:      data languages

(defconst xrdb-version "2.31"
  "`xrdb-mode' version number.")

;; This program 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 2
;; of the License, or (at your option) any later version.
;;
;; This program 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 should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

;;; Commentary:
;;
;; This file provides a major mode for editing X resource database
;; files.  It includes font-lock definitions and commands for
;; controlling indentation, re-indenting by subdivisions, and loading
;; and merging into the the resource database.
;;
;; To use, put the following in your .emacs:
;;
;; (autoload 'xrdb-mode "xrdb-mode" "Mode for editing X resource files" t)
;;
;; You may also want something like:
;;
;; (setq auto-mode-alist
;;       (append '(("\\.Xdefaults$"    . xrdb-mode)
;;                 ("\\.Xenvironment$" . xrdb-mode)
;;                 ("\\.Xresources$"   . xrdb-mode)
;;                 ("*.\\.ad$"         . xrdb-mode)
;;                 )
;;               auto-mode-alist))

;;; Credits:
;;
;; The database merge feature was inspired by Joel N. Weber II.
;;
;; The canonical Web site for xrdb-mode is
;; <http://www.python.org/emacs/>

;;; Code:
(require 'custom)



(defgroup xrdb nil
  "Support for editing X resource database files"
  :group 'languages)

(defcustom xrdb-mode-hook nil
  "*Hook to be run when `xrdb-mode' is entered."
  :type 'hook
  :group 'xrdb)

(defcustom xrdb-subdivide-by 'paragraph
  "*Default alignment subdivision when re-indenting a region or buffer.
This variable controls how much of the buffer is searched to find a
goal column on which to align.  Every non-comment line in the region
defined by this variable is scanned for the first `:' character on the
line, and this character's column is the line's goal column.  The
rightmost line goal column in the region is taken as the region's goal
column.

This variable can take one of the following symbol values:

 `buffer'    - All lines in the buffer are scanned.  This is the
               slowest option.

 `paragraph' - All lines in the paragraph are scanned.  Paragraphs
               are delimited by blank lines, comment lines, and page
               delimiters.

 `page'      - All lines in the page are scanned.  Pages are delimited
               with `page-delimiter', usually ^L (control-L).

 `line'      - Only the previous non-comment line is scanned.  This is
               the fastest method.

This variable is used by the various indentation commands, and can be
overridden in those commands by using \\[universal-argument]."
  :type '(radio (const :tag "Do not subdivide buffer" buffer)
                (const :tag "Subdivide by paragraphs" paragraph)
                (const :tag "Subdivide by pages" page)
                (const :tag "Each line is independent" line))
  :group 'xrdb)

(defcustom xrdb-compress-whitespace nil
  "*Collapse all whitespace to a single space after insertion of `:'."
  :type 'boolean
  :group 'xrdb)

(defcustom xrdb-program "xrdb"
  "*Program to run to load or merge resources in the X resource database."
  :type 'string
  :group 'xrdb)

(defcustom xrdb-program-args '("-merge")
  "*List of string arguments to pass to `xrdb-program'."
  :type '(repeat string)
  :group 'xrdb)

(defvar xrdb-master-file nil
  "If non-nil, merge in the named file instead of the buffer's file.
The intent is to allow you to set this variable in the file's local
variable section, e.g.:

    ! Local Variables:
    ! xrdb-master-file: \"Xdefaults\"
    ! End:

so that typing \\[xrdb-database-merge-buffer-or-region] in that buffer
merges the named master file instead of the buffer's file.  Note that
if the file name has a relative path, the `default-directory' for the
buffer is prepended to come up with a file name.

You may also want to set `xrdb-program-args' in the local variables
section as well.")
(make-variable-buffer-local 'xrdb-master-file)


;; Non-user customizable
(defconst xrdb-comment-re "^[ \t]*[!]"
  "Regular expression describing the beginning of a comment line.")



;; utilities
(defun xrdb-point (position)
  ;; Returns the value of point at certain commonly referenced POSITIONs.
  ;; POSITION can be one of the following symbols:
  ;;
  ;; bol  -- beginning of line
  ;; eol  -- end of line
  ;; bod  -- beginning of defun
  ;; boi  -- back to indentation
  ;; ionl -- indentation of next line
  ;; iopl -- indentation of previous line
  ;; bonl -- beginning of next line
  ;; bopl -- beginning of previous line
  ;; bop  -- beginning of paragraph
  ;; eop  -- end of paragraph
  ;; bopg -- beginning of page
  ;; eopg -- end of page
  ;;
  ;; This function does not modify point or mark.
  (let ((here (point)))
    (cond
     ((eq position 'bod)  (beginning-of-defun))
     ((eq position 'bol)  (beginning-of-line))
     ((eq position 'eol)  (end-of-line))
     ((eq position 'boi)  (back-to-indentation))
     ((eq position 'bonl) (forward-line 1))
     ((eq position 'bopl) (forward-line -1))
     ((eq position 'bop)  (forward-paragraph -1))
     ((eq position 'eop)  (forward-paragraph 1))
     ((eq position 'bopg)  (forward-page -1))
     ((eq position 'eopg)  (forward-page 1))
     (t
      (error "unknown buffer position requested: %s" position)))
    (prog1
        (point)
      (goto-char here))
    ))

(defmacro xrdb-safe (&rest body)
  ;; safely execute BODY, return nil if an error occurred
  `( (condition-case nil
         (progn (,@ body))
       (error nil))))

(defsubst xrdb-skip-to-separator ()
  ;; skip forward from the beginning of the line to the separator
  ;; character as given by xrdb-separator-char. Returns t if the
  ;; char was found, otherwise, nil.
  (beginning-of-line)
  (skip-chars-forward "^:" (xrdb-point 'eol))
  (and (eq (char-after) ?:)
       (current-column)))

(defsubst xrdb-in-comment-p (&optional lim)
  (let* ((lim (or lim (xrdb-point 'bod)))
         (state (parse-partial-sexp lim (point))))
    (nth 4 state)))

(defsubst xrdb-boi-col ()
  (let ((here (point)))
    (goto-char (xrdb-point 'boi))
    (prog1
        (current-column)
      (goto-char here))))

(defvar xrdb-prompt-history nil)

(defun xrdb-prompt-for-subdivision ()
  (let ((options '(("buffer" . buffer)
                   ("paragraphs" . paragraph)
                   ("pages" . page)
                   ("lines" . line)))
        (completion-ignore-case t))
    (cdr (assoc
          (completing-read "Subdivide alignment by? " options nil t
                           (cons (format "%s" xrdb-subdivide-by) 0)
                           'xrdb-prompt-history)
          options))))


;; commands
(defun xrdb-electric-separator (arg)
  "Insert a colon, and possibly indent line.
Numeric argument inserts that many separators.  If the numeric
argument is not given, or is 1, and the separator is not inserted in a
comment, then the line is indented according to `xrdb-subdivide-by'."
  (interactive "P")
  (self-insert-command (prefix-numeric-value arg))
  ;; only do electric behavior if arg is not given
  (or arg
      (xrdb-in-comment-p)
      (xrdb-indent-line))
  ;; compress whitespace
  (and xrdb-compress-whitespace
       (just-one-space)))

(defun xrdb-electric-bang (arg)
  "Insert an exclamation point to start a comment.
Numeric argument inserts that many exclamation characters.  If the
numeric argument is not given, or is 1, and the bang character is the
first character on a line, the line is indented to column zero."
  (interactive "P")
  (let ((how-many (prefix-numeric-value arg)))
    (self-insert-command how-many)
    (save-excursion
      (if (and (= how-many 1)
               (xrdb-in-comment-p)
               (memq (char-before (xrdb-point 'boi)) '(?\n nil)))
          (indent-line-to 0)))
    ))


(defun xrdb-indent-line (&optional arg)
  "Align the current line according to `xrdb-subdivide-by'.
With optional \\[universal-argument], prompt for subdivision."
  (interactive "P")
  (xrdb-align-to-column
   (xrdb-guess-goal-column (if arg
                               (xrdb-prompt-for-subdivision)
                             xrdb-subdivide-by))
   (xrdb-point 'bol)
   (xrdb-point 'bonl)))

(defun xrdb-indent-region (start end &optional arg)
  "Indent all lines in the region according to `xrdb-subdivide-by'.
With optional \\[universal-argument], prompt for subdivision."
  (interactive "r\nP")
  (xrdb-align-to-column
   (xrdb-guess-goal-column (if arg
                               (xrdb-prompt-for-subdivision)
                             xrdb-subdivide-by))
   start end))

(defun xrdb-indent-page (&optional arg)
  "Indent all lines in the page according to `xrdb-subdivide-by'.
With optional \\[universal-argument], prompt for subdivision."
  (interactive "P")
  (xrdb-align-to-column
   (xrdb-guess-goal-column (if arg
                               (xrdb-prompt-for-subdivision)
                             xrdb-subdivide-by))
   (xrdb-point 'bopg)
   (xrdb-point 'eopg)))

(defun xrdb-indent-paragraph (&optional arg)
  "Indent all lines in the paragraph according to `xrdb-subdivide-by'.
With optional \\[universal-argument], prompt for subdivision."
  (interactive "P")
  (xrdb-align-to-column
   (xrdb-guess-goal-column (if arg
                               (xrdb-prompt-for-subdivision)
                             xrdb-subdivide-by))
   (xrdb-point 'bop)
   (xrdb-point 'eop)))

(defun xrdb-indent-buffer (&optional arg)
  "Indent all lines in the buffer according to `xrdb-subdivide-by'.
With optional \\[universal-argument], prompt for subdivision."
  (interactive "P")
  (let ((subdivide-by (if arg
                          (xrdb-prompt-for-subdivision)
                        xrdb-subdivide-by)))
    (save-excursion
      (beginning-of-buffer)
      (if (eq subdivide-by 'buffer)
          (xrdb-align-to-column (xrdb-guess-goal-column 'buffer)
                                (point-min) (point-max))
        (let (mvfwdfunc indentfunc)
          (cond
           ((eq subdivide-by 'paragraph)
            (setq mvfwdfunc 'forward-paragraph
                  indentfunc 'xrdb-indent-paragraph))
           ((eq subdivide-by 'page)
            (setq mvfwdfunc 'forward-page
                  indentfunc 'xrdb-indent-page))
           ((eq subdivide-by 'line)
            (setq mvfwdfunc 'forward-line
                  indentfunc 'xrdb-indent-page))
           (t (error "Illegal alignment subdivision: %s" subdivide-by))
           )
          (while (< (point) (point-max))
            (funcall indentfunc)
            (funcall mvfwdfunc 1))
          )))))


;; internal alignment functions
(defun xrdb-align-to-column (goalcol &optional start end)
  (let ((start (or start (xrdb-point 'bol)))
        (end (or end (xrdb-point 'bonl))))
    (save-excursion
      (save-restriction
        (narrow-to-region start end)
        (beginning-of-buffer)
        (while (< (point) (point-max))
          (if (and (not (looking-at xrdb-comment-re))
                   (xrdb-skip-to-separator))
              (indent-line-to (max 0 (+ goalcol
                                        (- (current-column))
                                        (xrdb-boi-col))
                                   )))
          (forward-line 1))
        ))))

(defun xrdb-guess-goal-column (subdivide-by)
  ;; Returns the goal column of the current line based on SUBDIVIDE-BY,
  ;; which can be any value allowed by `xrdb-subdivide-by'.
  (let ((here (point))
        (goalcol 0))
    (save-restriction
      (cond
       ((eq subdivide-by 'line)
        (while (and (zerop (forward-line -1))
                    (or (looking-at xrdb-comment-re)
                        (not (xrdb-skip-to-separator)))))
        ;; maybe we didn't find one
        (if (not (xrdb-skip-to-separator))
            (goto-char here))
        (narrow-to-region (xrdb-point 'bol) (xrdb-point 'bonl)))
       ((eq subdivide-by 'page)
        (narrow-to-page))
       ((eq subdivide-by 'paragraph)
        (narrow-to-region (xrdb-point 'bop) (xrdb-point 'eop)))
       ((eq subdivide-by 'buffer))
       (t (error "Illegal alignment subdivision: %s" subdivide-by)))
      (goto-char (point-min))
      (while (< (point) (point-max))
        (if (and (not (looking-at xrdb-comment-re))
                 (xrdb-skip-to-separator))
            (setq goalcol (max goalcol (- (current-column) (xrdb-boi-col)))))
        (forward-line 1)))
    (goto-char here)
    goalcol))



;; major-mode stuff
(defvar xrdb-mode-abbrev-table nil
  "Abbreviation table used in `xrdb-mode' buffers.")
(define-abbrev-table 'xrdb-mode-abbrev-table ())


(defvar xrdb-mode-syntax-table nil
  "Syntax table used in `xrdb-mode' buffers.")
(if xrdb-mode-syntax-table
    nil
  (setq xrdb-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry ?!  "<"    xrdb-mode-syntax-table)
  (modify-syntax-entry ?\\ "\\"   xrdb-mode-syntax-table)
  (modify-syntax-entry ?\n ">"    xrdb-mode-syntax-table)
  (modify-syntax-entry ?/  ". 14" xrdb-mode-syntax-table)
  (modify-syntax-entry ?*  "_ 23" xrdb-mode-syntax-table)
  (modify-syntax-entry ?.  "_"    xrdb-mode-syntax-table)
  (modify-syntax-entry ?#  "_"    xrdb-mode-syntax-table)
  (modify-syntax-entry ??  "_"    xrdb-mode-syntax-table)
  (modify-syntax-entry ?<  "("    xrdb-mode-syntax-table)
  (modify-syntax-entry ?>  ")"    xrdb-mode-syntax-table)
  )


(defvar xrdb-mode-map ()
  "Keymap used in `xrdb-mode' buffers.")
(if xrdb-mode-map
    ()
  (setq xrdb-mode-map (make-sparse-keymap))
  ;; make the separator key electric
  (define-key xrdb-mode-map ":"        'xrdb-electric-separator)
  (define-key xrdb-mode-map "!"        'xrdb-electric-bang)
  (define-key xrdb-mode-map "\t"       'xrdb-indent-line)
  (define-key xrdb-mode-map "\C-c\C-a" 'xrdb-indent-buffer)
  (define-key xrdb-mode-map "\C-c\C-b" 'xrdb-submit-bug-report)
  (define-key xrdb-mode-map "\C-c\C-c" 'xrdb-database-merge-buffer-or-region)
  (define-key xrdb-mode-map "\C-c\C-p" 'xrdb-indent-paragraph)
  (define-key xrdb-mode-map "\C-c\["   'xrdb-indent-page)
  (define-key xrdb-mode-map "\C-c\C-r" 'xrdb-indent-region)
  )

;;;###autoload
(defun xrdb-mode ()
  "Major mode for editing xrdb config files"
  (interactive)
  (kill-all-local-variables)
  (set-syntax-table xrdb-mode-syntax-table)
  (setq major-mode 'xrdb-mode
        mode-name "xrdb"
        local-abbrev-table xrdb-mode-abbrev-table)
  (use-local-map xrdb-mode-map)
  (setq font-lock-defaults '(xrdb-font-lock-keywords))
  ;; local variables
  (make-local-variable 'parse-sexp-ignore-comments)
  (make-local-variable 'comment-start-skip)
  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'paragraph-start)
  (make-local-variable 'paragraph-separate)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (make-local-variable 'indent-region-function)
  ;; now set their values
  (setq parse-sexp-ignore-comments t
        comment-start-skip "![ \t]*"
        comment-start "! "
        comment-end "")
  (setq indent-region-function 'xrdb-indent-region
        paragraph-ignore-fill-prefix t
        paragraph-start (concat "^[ \t]*$\\|^[ \t]*[!]\\|" page-delimiter)
        paragraph-separate paragraph-start)
  (run-hooks 'xrdb-mode-hook))



;; faces and font-locking
(defvar xrdb-option-name-face 'xrdb-option-name-face
  "Face for option name on a line in an X resource db file")

(defvar xrdb-option-value-face 'xrdb-option-value-face
  "Face for option value on a line in an X resource db file")

(make-face 'xrdb-option-name-face)
(make-face 'xrdb-option-value-face)

(defun xrdb-font-lock-mode-hook ()
  (or (face-differs-from-default-p 'xrdb-option-name-face)
      (copy-face 'font-lock-keyword-face 'xrdb-option-name-face))
  (or (face-differs-from-default-p 'xrdb-option-value-face)
      (copy-face 'font-lock-string-face 'xrdb-option-value-face))
  (remove-hook 'font-lock-mode-hook 'xrdb-font-lock-mode-hook))
(add-hook 'font-lock-mode-hook 'xrdb-font-lock-mode-hook)

(defvar xrdb-font-lock-keywords
  (list '("^[ \t]*\\([^\n:]*:\\)[ \t]*\\(.*\\)$"
          (1 xrdb-option-name-face)
          (2 xrdb-option-value-face)))
  "Additional expressions to highlight in X resource db mode.")
(put 'xrdb-mode 'font-lock-defaults '(xrdb-font-lock-keywords))



;; merging and manipulating the X resource database
(defun xrdb-database-merge-buffer-or-region (start end)
  "Merge the current buffer's resources into the X resource database.

`xrdb-program' is the program to actually call, with the arguments
specified in `xrdb-program-args'.  This latter can be set to do either
a merge or a load, etc.  Also, if the file local variable
`xrdb-master-file' is non-nil, then it is merged instead of the
buffer's file.

If the current region is active, it is merged instead of the buffer,
and this overrides any use of `xrdb-master-file'."
  (interactive
   ;; the idea here is that if the region is inactive, start and end
   ;; will be nil, if not passed in programmatically
   (list (xrdb-safe (and (mark) (region-beginning)))
         (xrdb-safe (and (mark) (region-end)))))
  (message "Merging with args: %s..." xrdb-program-args)
  (let ((outbuf (get-buffer-create "*Shell Command Output*")))
    ;; I prefer the XEmacs way of doing this, but this is the easiest
    ;; way to work in both XEmacs and Emacs.
    (with-current-buffer outbuf (erase-buffer))
    (cond
     ((and start end)
      (apply 'call-process-region start end xrdb-program nil outbuf t
             xrdb-program-args))
     (xrdb-master-file
      (apply 'call-process xrdb-program xrdb-master-file outbuf t
             xrdb-program-args))
     (t
      (apply 'call-process-region (point-min) (point-max) xrdb-program
             nil outbuf t xrdb-program-args)))
    (if (not (zerop (with-current-buffer outbuf (buffer-size))))
        (pop-to-buffer outbuf)))
  (message "Merging... done"))



;; submitting bug reports

(defconst xrdb-mode-help-address "tools-help@python.org"
  "Address for xrdb-mode bug reports.")

(defun xrdb-submit-bug-report ()
  "Submit via mail a bug report on xrdb-mode."
  (interactive)
  ;; load in reporter
  (require 'reporter)
  (let ((reporter-prompt-for-summary-p t)
        (varlist '(xrdb-subdivide-by
                   xrdb-mode-hook
                   xrdb-compress-whitespace
                   )))
    (and (if (y-or-n-p "Do you want to submit a report on xrdb-mode? ")
             t
           (message "")
           nil)
         (require 'reporter)
         (reporter-submit-bug-report
          xrdb-mode-help-address
          (format "xrdb-mode %s" xrdb-version)
          varlist nil nil "Dear Barry,")
         )))


(provide 'xrdb-mode)
;;; xrdb-mode.el ends here