ruby-block.el

;;; ruby-block.el --- highlight matching block

;; Copyright (C) 2007-2013 khiker, shishi, juszczakn

;; Author: khiker <khiker.mail+elisp@gmail.com>
;; Keywords: languages, faces, ruby

;; This file 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, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING.        If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Usage:

;; Add this line to your .emacs
;;
;; (require 'ruby-block)
;; (ruby-block-mode t)
;;
;; In addition, you can also add this line too.
;;
;; ;; do overlay
;; (setq ruby-block-highlight-toggle 'overlay)
;; ;; display to minibuffer
;; (setq ruby-block-highlight-toggle 'minibuffer)
;; ;; display to minibuffer and do overlay
;; (setq ruby-block-highlight-toggle t)
;;
;; Default is minibuffer.
;;
;; Tested on Emacs 24.3

;;; Note:

;; A ruby-mode.el or enh-ruby-mode is necessary to use this package.

;;; Code:

(require 'ruby-mode)

;; Variables:

(defconst ruby-block-version "0.0.11"
  "Ruby block package version.")

(defconst ruby-block-keyword-list
  (list "end" "for" "while" "until" "if" "class" "module"
    "case" "unless" "def" "begin" "do")
  "Keywords for highlighting.")

(defconst ruby-block-keyword-regex
  "\\(end\\|for\\|while\\|until\\|if\\|class\\|module\\|case\\|unless\\|def\\|begin\\|do\\)"
  "Regular expression to look for correspondence.")

(defgroup ruby-block nil
  "Ruby block"
  :tag "Ruby block"
  :group 'ruby-block)

(defcustom ruby-block-delay 0.50
  "*Time in seconds to delay before showing a matching paren."
  :type         'number
  :group 'ruby-block)

(defcustom ruby-block-highlight-face 'highlight
  "*Face for block highlighting."
  :type         'face
  :group 'ruby-block)

(defcustom ruby-block-highlight-toggle 'minibuffer
  "*How to display corresponding line.
Default is minibuffer. display to minibuffer.

The choices are as follows.

nil         => nothing
minibuffer => minibuffer
overlay         => overlay
t         => minibuffer and overlay"
  :type '(choice (const :tag "nothing" nil)
         (const :tag "minibuffer" minibuffer)
         (const :tag "overlay" overlay)
         (const :tag "minibuffer and overlay" t))
  :group 'ruby-block)

(defvar ruby-block-timer nil)

(defvar ruby-block-highlight-overlay nil)


;; Functions:

(define-minor-mode ruby-block-mode
  "In ruby-mode, Displays the line where there is a keyword corresponding
to END keyword.
This is a minor-mode for ruby-mode and enh-ruby-mode only."
  :init-value t
  :global nil
  :keymap nil
  :lighter " RBlock"
  (if ruby-block-mode
      (ruby-block-start-timer)
    (ruby-block-stop-timer)))

(defun ruby-block-start-timer ()
  "start timer."
  (when ruby-block-timer
    (cancel-timer ruby-block-timer))
  (setq ruby-block-timer
    (run-with-idle-timer ruby-block-delay t 'ruby-block-hook)))

(defun ruby-block-stop-timer ()
  "Stop timer."
  (when ruby-block-timer
    (cancel-timer ruby-block-timer)
    (setq ruby-block-timer nil)))

(defun ruby-block-hook ()
  "When Major-mode is ruby-mode or enh-ruby-mode, this package is running."
  (if (or (eq major-mode 'ruby-mode) (eq major-mode 'enh-ruby-mode))
      (condition-case err
      (ruby-block-function)
    (error
     (setq ruby-block-mode nil)
     (message "Error: %S; ruby-block-mode now disabled." err)))
    (setq ruby-block-mode nil)))

(defun ruby-block-line-beginning-position (pos)
  (when pos
    (save-excursion
      (goto-char pos)
      (let ((xor '(lambda (a b) (and (or a b) (not (and a b)))))
      (pos (point))
      (count 0))
    (while (and (not (funcall xor (bobp) (eolp)))
          (> pos (point-min)))
      (setq pos (1- pos))
      (goto-char (1- (point))))
    ;; delete linefeed of start point.
    (when (and (eolp) (>= (point-max) (1+ pos)))
      (setq pos (1+ pos)))
    pos))))

(defun ruby-block-line-end-position (pos)
  (when pos
    (save-excursion
      (goto-char pos)
      (let ((xor '(lambda (a b) (and (or a b) (not (and a b)))))
      (pos (point)))
    (while (and (not (funcall xor (eobp) (eolp)))
          (>= (point-max) pos))
      (setq pos (1+ pos))
      (goto-char (1+ (point))))
    pos))))

(defun ruby-block-function ()
  "Point position's word decides behavior."
  (let* ((cur (current-word))
     ;; if point after END, dec point and get face
     (p (point))
     (face (get-text-property p 'face))
     (p (if (and (eq nil face) (> p 3))
        (1- p)
        p)))
    (when (and (member cur '("else" "elsif" "end"))
         (eq face 'font-lock-keyword-face))
      (let* ((pos (ruby-block-corresponding-position p))
       (sp (ruby-block-line-beginning-position pos))
       (ep (ruby-block-line-end-position pos)))
    (when pos
      ;; display line contents to minibuffer
      (when (memq ruby-block-highlight-toggle '(t minibuffer))
      (message "%d: %s"
           (1+ (count-lines (point-min) sp)) (buffer-substring sp ep)))
      ;; do overlay
      (when (memq ruby-block-highlight-toggle '(t overlay))
      (ruby-block-do-highlight sp ep)))))))

(defun ruby-block-stmt-if (pos)
  (save-excursion
    (goto-char pos)
    (let ((status 'skip))
      (while (and (not (bolp))
          (eq status 'skip))
    (forward-char -1)
    (let ((ch (char-after)))
      (cond
       ((memq ch '(?\n ?\r ?\())
      (setq status t))
       ((memq ch '(32 \t))
      (setq status 'skip))
       (t
      (setq status nil)))))
      (when (eq status 'skip)
    (setq status t))
      status)))

(defun ruby-block-corresponding-position (pos)
  "Get point of corresponding line."
  (save-excursion
    (goto-char pos)
    (let ((key 1) pos face cur)
      (while (and (> key 0)
          (re-search-backward ruby-block-keyword-regex nil t))
    (setq pos (match-beginning 1)
        face (get-text-property pos 'face)
        cur (current-word))
    (when (and (eq face 'font-lock-keyword-face)
           (not (string= cur "elsif"))
           (member cur ruby-block-keyword-list)
           ;; case: STMT if (or unless, while, until) EXPR
           (cond
          ((member cur '("if" "unless" "while" "until"))
           (ruby-block-stmt-if pos))
          (t t)))
      (cond
       ((and (string= cur "end"))
      (setq key (1+ key)))
       (t
      (setq key (1- key))))))
      (when (= key 0)
    pos))))

(defun ruby-block-do-highlight (beg end)
  "Do overlay corresponding line."
  (if ruby-block-highlight-overlay
      (move-overlay ruby-block-highlight-overlay beg end)
    (setq ruby-block-highlight-overlay (make-overlay beg end)))
  (overlay-put ruby-block-highlight-overlay
         'face ruby-block-highlight-face)
  (add-hook 'pre-command-hook 'ruby-block-highlight-done))

(defun ruby-block-highlight-done ()
  "After do overlay, restore the line to original color."
  (remove-hook 'pre-command-hook 'ruby-block-highlight-done)
  (if ruby-block-highlight-overlay
      (delete-overlay ruby-block-highlight-overlay)))

(defun ruby-block-highlight-toggle ()
  "Switch on/off for ruby-block-mode."
  (interactive)
  (if ruby-block-highlight-toggle
      (setq ruby-block-highlight-toggle nil)
    (setq ruby-block-highlight-toggle t)))

(provide 'ruby-block)

;; Local Variables:
;; Coding: utf-8
;; End:

;;; ruby-block.el ends here