PageRenderTime 166ms CodeModel.GetById 8ms app.highlight 114ms RepoModel.GetById 6ms app.codeStats 1ms

/nyan-mode.el

http://github.com/TeMPOraL/nyan-mode
Emacs Lisp | 300 lines | 201 code | 55 blank | 44 comment | 5 complexity | 738efd4bae34f9c9d71802c73a1d6b19 MD5 | raw file
  1;;; nyan-mode.el --- Nyan Cat shows position in current buffer in mode-line.
  2
  3;; Nyanyanyanyanyanyanya!
  4
  5;; Author: Jacek "TeMPOraL" Zlydach <temporal.pl@gmail.com>
  6;; URL: https://github.com/TeMPOraL/nyan-mode/
  7;; Version: 1.1.1
  8;; Keywords: nyan, cat, lulz, scrolling, pop tart cat, build something amazing
  9
 10;; This file is not part of GNU Emacs.
 11
 12;; ...yet. ;).
 13
 14;; This program is free software; you can redistribute it and/or
 15;; modify it under the terms of the GNU General Public License as
 16;; published by the Free Software Foundation; either version 3, or
 17;; (at your option) any later version.
 18;;
 19;; This program is distributed in the hope that it will be useful,
 20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 22;; General Public License for more details.
 23;;
 24;; You should have received a copy of the GNU General Public License
 25;; along with this program; see the file COPYING.  If not, write to
 26;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
 27;; Floor, Boston, MA 02110-1301, USA.
 28
 29;;; Commentary:
 30
 31;; NEW! You can now click on the rainbow (or the empty space)
 32;; to scroll your buffer!
 33
 34;; NEW! You can now customize the minimum window width
 35;; below which the nyan-mode will be disabled, so that more important
 36;; information can be shown in the modeline.
 37
 38;; To activate, just load and put `(nyan-mode 1)' in your init file.
 39
 40;; Contributions and feature requests welcome!
 41
 42;; Inspired by (and in few places copied from) sml-modeline.el written by Lennart Borgman.
 43;; See: http://bazaar.launchpad.net/~nxhtml/nxhtml/main/annotate/head%3A/util/sml-modeline.el
 44
 45;;; History:
 46
 47;; 2016-04-26 - introduced click-to-scroll feature.
 48
 49;; Started as a totally random idea back in August 2011.
 50
 51;; The homepage at http://nyan-mode.buildsomethingamazing.com died somewhen in 2014/2015 because reasons.
 52;; I might get the domain back one day.
 53
 54;;; Code:
 55
 56(eval-when-compile (require 'cl))
 57
 58(defconst +nyan-directory+ (file-name-directory (or load-file-name buffer-file-name)))
 59
 60(defconst +nyan-cat-size+ 3)
 61
 62(defconst +nyan-cat-image+ (concat +nyan-directory+ "img/nyan.xpm"))
 63(defconst +nyan-rainbow-image+ (concat +nyan-directory+ "img/rainbow.xpm"))
 64(defconst +nyan-outerspace-image+ (concat +nyan-directory+ "img/outerspace.xpm"))
 65
 66(defconst +nyan-music+ (concat +nyan-directory+ "mus/nyanlooped.mp3"))
 67
 68(defconst +nyan-modeline-help-string+ "Nyanyanya!\nmouse-1: Scroll buffer position")
 69
 70(defvar nyan-old-car-mode-line-position nil)
 71
 72(defgroup nyan nil
 73  "Customization group for `nyan-mode'."
 74  :group 'frames)
 75
 76(defun nyan-refresh ()
 77  "Refresh after option changes if loaded."
 78  (when (featurep 'nyan-mode)
 79    (when (and (boundp 'nyan-mode)
 80               nyan-mode)
 81      (nyan-mode -1)
 82      (nyan-mode 1))))
 83
 84(defcustom nyan-animation-frame-interval 0.2
 85  "Number of seconds between animation frames."
 86  :type 'float
 87  :set (lambda (sym val)
 88         (set-default sym val)
 89         (nyan-refresh))
 90  :group 'nyan)
 91
 92(defvar nyan-animation-timer nil)
 93
 94(defun nyan-start-animation ()
 95  (interactive)
 96  (when (not (and nyan-animate-nyancat
 97		  nyan-animation-timer))
 98    (setq nyan-animation-timer (run-at-time "1 sec"
 99                                            nyan-animation-frame-interval
100                                            'nyan-swich-anim-frame))
101    (setq nyan-animate-nyancat t)))
102
103(defun nyan-stop-animation ()
104  (interactive)
105  (when (and nyan-animate-nyancat
106	     nyan-animation-timer)
107    (cancel-timer nyan-animation-timer)
108    (setq nyan-animation-timer nil)
109    (setq nyan-animate-nyancat nil)))
110
111;; mplayer needs to be installed for that
112(defvar nyan-music-process nil)
113
114(defun nyan-start-music ()
115  (interactive)
116  (unless nyan-music-process
117    (setq nyan-music-process (start-process-shell-command "nyan-music" "nyan-music" (concat "mplayer " +nyan-music+ " -loop 0")))))
118
119(defun nyan-stop-music ()
120  (interactive)
121  (when nyan-music-process
122    (delete-process nyan-music-process)
123    (setq nyan-music-process nil)))
124
125(defcustom nyan-minimum-window-width 64
126  "Determines the minimum width of the window, below which nyan-mode will not be displayed.
127This is important because nyan-mode will push out all informations from small windows."
128  :type 'integer
129  :set (lambda (sym val)
130         (set-default sym val)
131         (nyan-refresh))
132  :group 'nyan)
133
134;;; FIXME bug, doesn't work for antoszka.
135(defcustom nyan-wavy-trail nil
136  "If enabled, Nyan Cat's rainbow trail will be wavy."
137  :type '(choice (const :tag "Enabled" t)
138                 (const :tag "Disabled" nil))
139  :set (lambda (sym val)
140         (set-default sym val)
141         (nyan-refresh))
142  :group 'nyan)
143
144(defcustom nyan-bar-length 32
145  "Length of Nyan Cat bar in units; each unit is equal to an 8px
146  image. Minimum of 3 units are required for Nyan Cat."
147  :type 'integer
148  :set (lambda (sym val)
149         (set-default sym val)
150         (nyan-refresh))
151  :group 'nyan)
152
153(defcustom nyan-animate-nyancat nil
154  "Enable animation for Nyan Cat.
155This can be t or nil."
156  :type '(choice (const :tag "Enabled" t)
157                 (const :tag "Disabled" nil))
158  :set (lambda (sym val)
159         (set-default sym val)
160         (if val
161             (nyan-start-animation)
162           (nyan-stop-animation))
163         (nyan-refresh))
164  :group 'nyan)
165
166(defcustom nyan-cat-face-number 1
167  "Select cat face number for console."
168  :type 'integer
169  :group 'nyan
170  )
171
172;;; Load images of Nyan Cat an it's rainbow.
173(defvar nyan-cat-image (if (image-type-available-p 'xpm)
174                           (create-image +nyan-cat-image+ 'xpm nil :ascent 'center)))
175
176(defvar nyan-animation-frames (if (image-type-available-p 'xpm)
177                                  (mapcar (lambda (id)
178                                            (create-image (concat +nyan-directory+ (format "img/nyan-frame-%d.xpm" id))
179                                                          'xpm nil :ascent 95))
180                                          '(1 2 3 4 5 6))))
181(defvar nyan-current-frame 0)
182
183(defconst +nyan-catface+ [
184                          ["[]*" "[]#"]
185                          ["(*^ー゚)" "( ^ー^)" "(^ー^ )" "(゚ー^*)"]
186                          ["(´ω`三 )" "( ´ω三` )" "( ´三ω` )" "( 三´ω`)"
187                           "( 三´ω`)" "( ´三ω` )" "( ´ω三` )" "(´ω`三 )"]
188                          ["(´д`;)" "( ´д`;)" "( ;´д`)" "(;´д` )"]
189                          ["(」・ω・)」" "(/・ω・)/" "(」・ω・)」" "(/・ω・)/"
190                           "(」・ω・)」" "(/・ω・)/" "(」・ω・)」" "\(・ω・)/"]
191                          ["(>ワ<三   )" "( >ワ三<  )"
192                           "(  >三ワ< )" "(   三>ワ<)"
193                           "(  >三ワ< )" "( >ワ三<  )"]])
194
195(defun nyan-toggle-wavy-trail ()
196  "Toggle the trail to look more like the original Nyan Cat animation."
197  (interactive)
198  (setq nyan-wavy-trail (not nyan-wavy-trail)))
199
200(defun nyan-swich-anim-frame ()
201  (setq nyan-current-frame (% (+ 1 nyan-current-frame) 6))
202  (redraw-modeline))
203
204(defun nyan-get-anim-frame ()
205  (if nyan-animate-nyancat
206      (nth nyan-current-frame nyan-animation-frames)
207    nyan-cat-image))
208
209(defun nyan-wavy-rainbow-ascent (number)
210  (if nyan-animate-nyancat
211      (min 100 (+ 90
212                  (* 3 (abs (- (/ 6 2)
213                               (% (+ number nyan-current-frame)
214                                  6))))))
215    (if (zerop (% number 2)) 80 'center)))
216
217(defun nyan-number-of-rainbows ()
218  (round (/ (* (round (* 100
219                         (/ (- (float (point))
220                               (float (point-min)))
221                            (float (point-max)))))
222               (- nyan-bar-length +nyan-cat-size+))
223            100)))
224
225(defun nyan-catface () (aref +nyan-catface+ nyan-cat-face-number))
226
227(defun nyan-catface-index ()
228  (min (round (/ (* (round (* 100
229                              (/ (- (float (point))
230                                    (float (point-min)))
231                                 (float (point-max)))))
232                    (length (nyan-catface)))
233                 100)) (- (length (nyan-catface)) 1)))
234
235(defun nyan-scroll-buffer (percentage buffer)
236  (interactive)
237  (with-current-buffer buffer
238    (goto-char (floor (* percentage (point-max))))))
239
240(defun nyan-add-scroll-handler (string percentage buffer)
241  (lexical-let ((percentage percentage)
242                (buffer buffer))
243    (propertize string 'keymap `(keymap (mode-line keymap (down-mouse-1 . ,(lambda () (interactive) (nyan-scroll-buffer percentage buffer))))))))
244
245(defun nyan-create ()
246  (if (< (window-width) nyan-minimum-window-width)
247      ""                                ; disabled for too small windows
248    (let* ((rainbows (nyan-number-of-rainbows))
249           (outerspaces (- nyan-bar-length rainbows +nyan-cat-size+))
250           (rainbow-string "")
251           (xpm-support (image-type-available-p 'xpm))
252           (nyancat-string (propertize
253                            (aref (nyan-catface) (nyan-catface-index))
254                            'display (nyan-get-anim-frame)))
255           (outerspace-string "")
256           (buffer (current-buffer)))
257      (dotimes (number rainbows)
258        (setq rainbow-string (concat rainbow-string
259                                     (nyan-add-scroll-handler
260                                      (if xpm-support
261                                          (propertize "|"
262                                                      'display (create-image +nyan-rainbow-image+ 'xpm nil :ascent (or (and nyan-wavy-trail
263                                                                                                                            (nyan-wavy-rainbow-ascent number))
264                                                                                                                       (if nyan-animate-nyancat 95 'center))))
265                                        "|")
266                                      (/ (float number) nyan-bar-length) buffer))))
267      (dotimes (number outerspaces)
268        (setq outerspace-string (concat outerspace-string
269                                        (nyan-add-scroll-handler
270                                         (if xpm-support
271                                             (propertize "-"
272                                                         'display (create-image +nyan-outerspace-image+ 'xpm nil :ascent (if nyan-animate-nyancat 95 'center)))
273                                           "-")
274                                         (/ (float (+ rainbows +nyan-cat-size+ number)) nyan-bar-length) buffer))))
275      ;; Compute Nyan Cat string.
276      (propertize (concat rainbow-string
277                          nyancat-string
278                          outerspace-string)
279                  'help-echo +nyan-modeline-help-string+))))
280
281;;;###autoload
282(define-minor-mode nyan-mode
283  "Use NyanCat to show buffer size and position in mode-line.
284You can customize this minor mode, see option `nyan-mode'.
285
286Note: If you turn this mode on then you probably want to turn off
287option `scroll-bar-mode'."
288  :global t
289  :group 'nyan
290  (if nyan-mode
291      (progn
292        (unless nyan-old-car-mode-line-position
293          (setq nyan-old-car-mode-line-position (car mode-line-position)))
294        (setcar mode-line-position '(:eval (list (nyan-create)))))
295    (setcar mode-line-position nyan-old-car-mode-line-position)))
296
297
298(provide 'nyan-mode)
299
300;;; nyan-mode.el ends here