summaryrefslogtreecommitdiff
path: root/misc/rdoc-mode.el
blob: 1bfd34bf2d68c411f2897c33952e3997210b74db (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
;;
;; rdoc-mode.el
;; Major mode for RDoc editing
;;

;; Created: Fri Sep 18 09:04:49 JST 2009

;; License: Ruby's

(require 'derived)

;;;###autoload
(define-derived-mode rdoc-mode text-mode "RDoc"
  "Major mode for RD editing.
\\{rdoc-mode-map}"
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate "^\\(=+\\|\\*+\\)[ \t\v\f]*\\|^\\s *$")
  (make-local-variable 'paragraph-start)
  (setq paragraph-start paragraph-separate)
  (make-local-variable 'require-final-newline)
  (setq require-final-newline t)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '((rdoc-font-lock-keywords) t nil))
  (make-local-variable 'font-lock-keywords)
  (setq font-lock-keywords rdoc-font-lock-keywords)
  (make-local-variable 'outline-regexp)
  (setq outline-regexp "^\\(=+\\)[ \t\v\f]*")
  (outline-minor-mode t)
  (setq show-trailing-whitespace t)
  (rdoc-setup-keys)
  (setq indent-tabs-mode nil)
  (run-hooks 'rdoc-mode-hook)
  )

(defun rdoc-fill-paragraph (&rest args)
  "Fills paragraph, except for cited region"
  (interactive (progn
		 (barf-if-buffer-read-only)
		 (list (if current-prefix-arg 'full))))
  (save-excursion
    (beginning-of-line)
    (unless (looking-at "^ +")
      (apply 'fill-paragraph args))))

(defun rdoc-setup-keys ()
  (interactive)
  (define-key rdoc-mode-map "\M-q" 'rdoc-fill-paragraph)
  )

(defvar rdoc-heading1-face 'font-lock-keywordoc-face)
(defvar rdoc-heading2-face 'font-lock-type-face)
(defvar rdoc-heading3-face 'font-lock-variable-name-face)
(defvar rdoc-heading4-face 'font-lock-comment-face)
(defvar rdoc-bold-face 'font-lock-function-name-face)
(defvar rdoc-emphasis-face 'font-lock-function-name-face)
(defvar rdoc-code-face 'font-lock-keyword-face)
(defvar rdoc-description-face 'font-lock-constant-face)

(defvar rdoc-font-lock-keywords
  (list
   (list "^=([^=\r\n].*)?$"
	 0 rdoc-heading1-face)
   (list "^==([^=\r\n].*)?$"
	 0 rdoc-heading2-face)
   (list "^===([^=\r\n].*)?$"
	 0 rdoc-heading3-face)
   (list "^====+.*$"
	 0 rdoc-heading4-face)
   (list "\\(^\\|[ \t\v\f]\\)\\(\\*\\(\\sw\\|[-_:]\\)+\\*\\)\\($\\|[ \t\v\f]\\)"
	 2 rdoc-bold-face)		; *bold*
   (list "\\(^\\|[ \t\v\f]\\)\\(_\\(\\sw\\|[-_:]\\)+_\\)\\($\\|[ \t\v\f]\\)"
	 2 rdoc-emphasis-face)		; _emphasis_
   (list "\\(^\\|[ \t\v\f]\\)\\(\\+\\(\\sw\\|[-_:]\\)+\\+\\)\\($\\|[ \t\v\f]\\)"
	 2 rdoc-code-face)		; +code+
   (list "<em>[^<>]*</em>" 0 rdoc-emphasis-face)
   (list "<i>[^<>]*</i>" 0 rdoc-emphasis-face)
   (list "<b>[^<>]*</b>" 0 rdoc-bold-face)
   (list "<tt>[^<>]*</tt>" 0 rdoc-code-face)
   (list "<code>[^<>]*</code>" 0 rdoc-code-face)
   (list "^\\([-*]\\|[0-9]+\\.\\|[A-Za-z]\\.\\)\\s "
	 1 rdoc-description-face) ; bullet | numbered | alphabetically numbered
   (list "^\\[[^\]]*\\]\\|\\S .*::\\)\\([ \t\v\f]\\|$\\)"
	 1 rdoc-description-face)	; labeled | node
   ;(list "^[ \t\v\f]+\\(.*\\)" 1 rdoc-verbatim-face)
   ))

(defun rdoc-imenu-create-index ()
  (let ((root '(nil . nil))
        cur-alist
        (cur-level 0)
        (pattern (concat outline-regexp "\\(.*?\\)[ \t\v\f]*$"))
        (empty-heading "-")
        (self-heading ".")
        pos level heading alist)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward pattern (point-max) t)
        (setq heading (match-string-no-properties 2)
              level (min 6 (length (match-string-no-properties 1)))
              pos (match-beginning 1))
        (if (= (length heading) 0)
            (setq heading empty-heading))
        (setq alist (list (cons heading pos)))
        (cond
         ((= cur-level level)		; new sibling
          (setcdr cur-alist alist)
          (setq cur-alist alist))
         ((< cur-level level)		; first child
          (dotimes (i (- level cur-level 1))
            (setq alist (list (cons empty-heading alist))))
          (if cur-alist
              (let* ((parent (car cur-alist))
                     (self-pos (cdr parent)))
                (setcdr parent (cons (cons self-heading self-pos) alist)))
            (setcdr root alist))	; primogenitor
          (setq cur-alist alist
                cur-level level))
         (t				; new sibling of an ancestor
          (let ((sibling-alist (last (cdr root))))
            (dotimes (i (1- level))
              (setq sibling-alist (last (cdar sibling-alist))))
            (setcdr sibling-alist alist)
            (setq cur-alist alist
                  cur-level level))))))
    (cdr root)))

(defun rdoc-set-imenu-create-index-function ()
  (setq imenu-create-index-function 'rdoc-imenu-create-index))

(add-hook 'rdoc-mode-hook 'rdoc-set-imenu-create-index-function)

(provide 'rdoc-mode)