ansit.el

   1 ;;; ansit.el --- ansi it. Make fotified region into ansi color format.
   2
   3 ;; Copyleft (C) crazycool@SMTH
   4
   5 ;; Author: crazycool <crazycool@SMTH>
   6 ;; Maintainer: crazycool <crazycool@SMTH>
   7 ;; Location: http://emacs.mysmth.org
   8 ;; Version: 1.0
   9 ;; Keywords: extensions ansi color
  10
  11 ;; This file is NOT part of GNU Emacs.
  12 ;;
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17 ;;
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22 ;;
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;; Modifiedy by: William Xu <william.xwl@gmail.com>
  29 ;;
  30 ;; - Double original `\e' (only with this can qterm work)
  31 ;; - Add `ansit-kill-ring-save'
  32 ;; - Redefine `ansit-ansify-this'
  33 ;; - Add `ansit-color-close'
  34
  35 ;;; Commentary:
  36 ;; M-x load-library <RET> ansit <RET>
  37 ;; M-x ansit <RET> OR M-x ansit-buffer <RET>
  38 ;;
  39 ;; command `ansit' will make region between mark and point into
  40 ;; an ansi-colored string and copy it (add it to kill ring).
  41 ;;
  42 ;; command `ansit-buffer' will make region between mark and point
  43 ;; into an ansi-colored string and preview it in a new buffer. Preview
  44 ;; is done by ansi-color.el, so if you don't have ansi-color installed,
  45 ;; no preview appears. `C-x k' or `C-f4' will kill the preview buffer and
  46 ;; copy the result into the kill ring.
  47 ;;
  48 ;; to specify your own colors (take ansit-builtin-color for example)
  49 ;; add this to your .emacs:
  50 ;; (require 'ansit)
  51 ;; (setq ansit-builtin-color ansit-color-magenta)
  52 ;;
  53 ;; all colors are listed below
  54 ;; font-lock color                ansit-color                 default
  55 ;; ------------------------------------------------------------------
  56 ;; font-lock-builtin-face         ansit-builtin-color         magenta
  57 ;; font-lock-comment-face         ansit-comment-color         yellow
  58 ;; font-lock-constant-face        ansit-constant-color        red
  59 ;; font-lock-doc-face             ansit-doc-color             magenta
  60 ;; font-lock-function-name-face   ansit-function-name-color   blue
  61 ;; font-lock-keyword-face         ansit-keyword-color         cyan
  62 ;; font-lock-preprocessor-face    ansit-preprocessor-color    magenta
  63 ;; font-lock-string-face          ansit-string-color          magenta
  64 ;; font-lock-type-face            ansit-type-color            green
  65 ;; font-lock-variable-name-face   ansit-variable-name-color   green
  66 ;; font-lock-warning-face         ansit-warning-color         red
  67
  68 ;;; Code:
  69
  70 (require 'ansi-color nil t)
  71
  72 (defvar ansit-color-black         "\e\e[1;30m")
  73 (defvar ansit-color-red           "\e\e[1;31m")
  74 (defvar ansit-color-green         "\e\e[1;32m")
  75 (defvar ansit-color-yellow        "\e\e[1;33m")
  76 (defvar ansit-color-blue          "\e\e[1;34m")
  77 (defvar ansit-color-magenta       "\e\e[1;35m")
  78 (defvar ansit-color-cyan          "\e\e[1;36m")
  79 (defvar ansit-color-white         "\e\e[1;37m")
  80 (defvar ansit-color-close         "\e\e[m")
  81
  82 (defvar ansit-builtin-color       "\e\e[1;35m")
  83 (defvar ansit-comment-color       "\e\e[1;33m")
  84 (defvar ansit-constant-color      "\e\e[1;31m")
  85 (defvar ansit-doc-color           "\e\e[1;35m")
  86 (defvar ansit-function-name-color "\e\e[1;34m")
  87 (defvar ansit-keyword-color       "\e\e[1;36m")
  88 (defvar ansit-preprocessor-color  "\e\e[1;35m")
  89 (defvar ansit-string-color        "\e\e[1;35m")
  90 (defvar ansit-type-color          "\e\e[1;32m")
  91 (defvar ansit-variable-name-color "\e\e[1;32m")
  92 (defvar ansit-warning-color       "\e\e[1;31m")
  93
  94 (defvar ansit-result-string ""
  95   "Do not set this variable.")
  96
  97 (defalias 'ansit 'ansit-ansify-this)
  98 (defalias 'ansit-kill-ring-save 'ansit-ansify-this)
  99 (defun ansit-ansify-this (beg end)
 100   "Fontify region between mark and point, add the result to kill ring."
 101   (interactive "r")
 102   (let ((s (ansit-ansify-region beg end)))
 103     (kill-new s)
 104     (deactivate-mark)
 105     s))
 106
 107 (defalias 'ansit-buffer 'ansit-ansify-this-in-new-buffer)
 108 (defun ansit-ansify-this-in-new-buffer ()
 109   "Fontify region between mark and point, view result in new buffer."
 110   (interactive)
 111   (unless (= (mark) (point))
 112     (setq ansit-result-string (ansit-ansify-region (mark) (point)))
 113     (with-current-buffer (get-buffer-create "*Ansit*")
 114       (insert ansit-result-string)
 115       (when (locate-library "ansi-color")
 116         (insert "\n\n!!---------------- [preview] ----------------!!\n\n")
 117         (insert  (ansi-color-apply ansit-result-string)))
 118       (local-set-key "\C-xk" 'ansit-copy-and-kill-buffer)
 119       (local-set-key [C-f4]  'ansit-copy-and-kill-buffer)
 120       (switch-to-buffer (current-buffer)))))
 121
 122 (defun ansit-copy-and-kill-buffer ()
 123   "Copy result and kill the preview buffer."
 124   (interactive)
 125   (kill-new ansit-result-string)
 126   (kill-buffer (current-buffer))
 127   (message "Buffer killed. result copied."))
 128
 129 (defun ansit-ansify-region (begin-point end-point)
 130   "Fontify region between BEGIN-POINT and END-POINT
 131 with ANSI color. Return the result in string."
 132   (let ((beg (min begin-point end-point))
 133         (end (max begin-point end-point))
 134         (tmp nil)
 135         (str "")
 136         (result nil)
 137         (tface nil)
 138         (color "")
 139         )
 140     (unless (= beg end)
 141       (save-excursion
 142         (goto-char beg)
 143         (while (< (point) end)
 144           (setq tmp (next-single-property-change (point) 'face))
 145           ;; buffer-end
 146           (unless tmp
 147             (setq tmp end))
 148           ;; no cross-line properties
 149           (when (> tmp (line-end-position))
 150             (setq tmp (+ 1 (line-end-position))))
 151           ;; skip spaces and tabs
 152           (save-excursion
 153             (goto-char tmp)
 154             (when (looking-at "[ \t]+")
 155               (re-search-forward "[ \t]+" (line-end-position) t)
 156               (setq tmp (point))))
 157           (when (> tmp end)
 158             (setq tmp end))
 159           (setq str (buffer-substring-no-properties (point) tmp))
 160           ;; filter ansi controls
 161           (while (string-match "\e\e" str)
 162             (setq str (replace-match "^[" t nil str)))
 163           (setq tface (get-text-property (point) 'face))
 164           (when (listp tface)
 165             (setq tface (car tface)))
 166           (cond
 167            ((eq tface font-lock-builtin-face)
 168             (setq color ansit-builtin-color))
 169            ((eq tface font-lock-comment-face)
 170             (setq color ansit-comment-color))
 171            ((eq tface font-lock-constant-face)
 172             (setq color ansit-constant-color))
 173            ((eq tface font-lock-doc-face)
 174             (setq color ansit-doc-color))
 175            ((eq tface font-lock-function-name-face)
 176             (setq color ansit-function-name-color))
 177            ((eq tface font-lock-keyword-face)
 178             (setq color ansit-keyword-color))
 179            ((eq tface font-lock-preprocessor-face)
 180             (setq color ansit-preprocessor-color))
 181            ((eq tface font-lock-string-face)
 182             (setq color ansit-string-color))
 183            ((eq tface font-lock-type-face)
 184             (setq color ansit-type-color))
 185            ((eq tface font-lock-variable-name-face)
 186             (setq color ansit-variable-name-color))
 187            ((eq tface font-lock-warning-face)
 188             (setq color ansit-warning-color))
 189            (t (setq color "\e\e[1;37m")))
 190           ;;(setq result (concat result color str "\e\e[m"))
 191           (setq result (concat result color str))
 192           (goto-char tmp))
 193         (concat result "\e\e[m")
 194         result))))
 195
 196 (provide 'ansit)
 197
 198 ;;; ansit.el ends here