ruby/misc/rdoc-mode.el

167 строки
5.7 KiB
EmacsLisp
Исходник Обычный вид История

;;
;; 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 (&optional justify region)
"Fills paragraph, except for cited region"
(interactive (progn
(barf-if-buffer-read-only)
(list (if current-prefix-arg 'full))))
(save-excursion
(beginning-of-line)
(save-restriction
(let ((pos (point)) beg end indent hanging)
(cond
((looking-at "^ +\\(\\*\\s *\\)")
(setq indent (- (match-end 0) (match-beginning 0))
hanging (- (match-end 1) (match-beginning 1))))
((looking-at "^ +")
(setq indent (- (match-end 0) (match-beginning 0)))
(when (and (re-search-backward "^[^ ]\\|^\\( *\\(\\* *\\)\\)" nil t)
(match-beginning 1)
(= indent (- (match-end 1) (match-beginning 1))))
(setq hanging (- (match-end 2) (match-beginning 2)))
(setq beg (match-beginning 1))))
((setq beg t)))
(when beg
(when indent
(goto-char pos)
(while (progn (beginning-of-line 2)
(and (looking-at "^\\( +\\)\\S ")
(= indent (- (match-end 1) (match-beginning 1))))))
(setq end (point))
(when (and beg (not region))
(setq region (list beg end))
(narrow-to-region beg end)
))
(goto-char pos)
(fill-paragraph justify region)
(when (and indent
(or (goto-char beg) t)
(or (beginning-of-line 2) t)
(looking-at "^\\( +\\)")
(= (- indent hanging) (- (match-end 0) (match-beginning 0))))
(insert-char ?\s hanging)
(beginning-of-line)
(narrow-to-region (point) end)
(fill-paragraph justify (list (point) end))))))))
(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)