gihyo-inao-mode.el

;;; inao-mode.el --- major mode for writing inao manuscripts

;; Copyright (C) 2010  SAKURAI Masashi

;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
;; Keywords: outlines, convenience

;; 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 3 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, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; 

;;; Code:

(require 'cl)
(require 'imenu)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ### Macro / Utilities

(defun inao:define-keymap (keymap-list)
  (let ((map (make-sparse-keymap)))
    (mapc 
     (lambda (i)
       (define-key map
         (if (stringp (car i))
             (read-kbd-macro (car i)) (car i))
         (cdr i)))
     keymap-list)
    map))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ### Imenu

(defun inao:outline-imenu-prev-index-position ()
  (re-search-backward "^\\(■\\|●\\|□\\)+.+$" (point-min) t))

(defun inao:outline-imenu-extract-index-name ()
  (if (looking-at "^\\(\\(■\\|●\\|□\\)+.+\\)$")
      (let ((bg (background-color-at-point)) (s "_"))
        (put-text-property 0 (length s) 'face `(foreground-color . ,bg) s)
        (replace-regexp-in-string "\\(■\\|●\\|□\\)" s (match-string 1) t)
      )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ### Font-lock

(loop for i in '(inao:face-title-3 inao:face-title-2 inao:face-title-1 inao:face-title-0) do (plist-put (symbol-plist i) 'face-defface-spec nil))

(defface inao:face-title-3
  '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
    (t :foreground "Slateblue4" :height 1.05 :underline "Gray50" :inherit variable-pitch))
  "節：level 3.")

(defface inao:face-title-2
  '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
    (t :foreground "Royalblue4" :height 1.1 :underline "Gray50" :inherit variable-pitch))
  "節：level 2.")

(defface inao:face-title-1 
  '((((type tty pc) (class color) (background light))
     :foreground "green" :weight bold)
    (((type tty pc) (class color) (background dark))
     :foreground "yellow" :weight bold)
    (t :foreground "DarkBlue" :height 1.1 :underline nil :inherit inao:face-title-2))
  "節：level 1.")

(defface inao:face-title-0 
  '((((type tty pc) (class color) (background light))
     :foreground "green" :weight bold)
    (((type tty pc) (class color) (background dark))
     :foreground "yellow" :weight bold)
    (t :foreground "black" :height 1.2 :inherit inao:face-title-1))
  "章のタイトル：level 0.")

(defconst inao:font-lock-keywords-1
  '(
    ("^□.+$" . 'inao:face-title-0)
    ("^■[^■\n\r]+$" . 'inao:face-title-1)
    ("^■■[^■\n\r]+$" . 'inao:face-title-2)
    ("^■■■[^■\n\r]+$" . 'inao:face-title-3)
    ("^■■■■[^■\n\r]+$" . font-lock-comment-face)
    ("◆[^◆\n\r]+◆" . font-lock-keyword-face)
    ("^●.+$" . font-lock-variable-name-face)
    ("^[(（][0-9０-９]+[)）].+$" . 'bold)
    ("^・.+$" . 'bold)
    ("^\\(注|※\\).+$" . font-lock-function-name-face)
    ))

(defconst inao:font-lock-keywords-2 inao:font-lock-keywords-1)
(defconst inao:font-lock-keywords-3 inao:font-lock-keywords-1)
(defconst inao:font-lock-keywords 
  '(inao:font-lock-keywords-3 inao:font-lock-keywords-1 inao:font-lock-keywords-2
                             inao:font-lock-keywords-3)
  "See `font-lock-keywords'.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ### Major Mode

(setq inao-mode-hook nil)

(setq inao-mode-map 
      (inao:define-keymap
       '(
         )))

(define-derived-mode inao-mode
  text-mode 
  "Inao"
  "Major mode for inao manuscripts.
  \\{inao-mode-map}"
  (setq case-fold-search nil)
  (setq imenu-create-index-function 'imenu-default-create-index-function
        imenu-prev-index-position-function 'inao:outline-imenu-prev-index-position
        imenu-extract-index-name-function 'inao:outline-imenu-extract-index-name)
  (set (make-local-variable 'font-lock-defaults) (list inao:font-lock-keywords))
  )

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