[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

highlight-tail v1.3.3

From: Rafal Jedruszek
Subject: highlight-tail v1.3.3
Date: Mon, 30 Oct 2006 21:53:55 +0100


New version (1.3.3) of highlight-tail-mode is out.

Previous versions were using `setf' function but did not
"(require 'cl)".  So if you had errors about "void-function setf"
this version should fix them.


highlight-tail is a eyecandy minor-mode for (X)Emacs.  It changes
the background color of some last typed characters and smoothly
fade them out to the background color.  This creates the illusion
of drawing a "tail" in real time, when you write.  I know I'm
hopeless at explaining :) so you can see highlight-tail in action
here: or/and try

Here are the changes since last time I posted highlight-tail here:

* 1.3.3 (30 Oct 2006)
     + Added (require 'cl).  Thanks to Arnaldo Mandel and Kevin
       Rodgers for reporting.
     + Many less warnings on compilation.  Thanks to
       Kevin Rodgers.
And here is the code:
;;; highlight-tail.el --- draw a "tail" while writing, by smoothly changing 
background color

;; Author: Rafal Jedruszek <address@hidden>
;; Keywords: highlight tail eye-candy visual-effect light color burn
;; Web page:

(defconst highlight-tail-version "1.3.3" "The current version of 

;; This file is not part of GNU Emacs.

;; 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 2, 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
;; 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; === WHAT IS IT?
;; This minor-mode draws a tail in real time, when you write.  It
;; changes the background color of some last typed characters and
;; smoothly fade them out to the background color.
;; So from now on, your Emacs will be even more sexy! ;o )
;; Place this file in your load-path and add
;; (require 'highlight-tail)
;; (message "Highlight-tail loaded - now your Emacs will be even more sexy!")
;; ; [ here some setq of variables ]
;; (highlight-tail-reload)
;; to your ~/.emacs
;; The default configuration is quite good, but you could and should
;; customize it to your own needs.  Here are some examples.  It's hard
;; for me to explain what you will see when use them, so just give
;; them a try.  Place these setq in your .emacs.el file *before* the
;; (highlight-tail-reload) function call.
;; 1. -----
;; (setq highlight-tail-colors '(("black" . 0)
;;                               ("#bc2525" . 25)
;;                               ("black" . 66)))
;; 2. -----
;; (setq highlight-tail-steps 14
;;       highlight-tail-timer 1)
;; 3. -----
;; (setq highlight-tail-posterior-type 'const)
;; These are all customizable variables.  I think you get the idea
;; how to customize this mode for best fit.
;; You will often need to run (highlight-tail-reload) to make changes
;; work.
;; === SPEED
;; From version 0.8 this mode doesn't use much CPU power.  There were
;; problems with this in earlier versions.  Now it takes about 2-8% of
;; my Athlon XP 2000+ power in normal speed typing (maybe it is still
;; too much? - if you have suggestions how to make it eat less - mail
;; me).  When I press a key and hold it down it eats approximately 15%
;; (in comparison to prior version (100%) it is a very good result).
;; The CPU eaten depends mainly on two variables:
;; `highlight-tail-steps' and `highlight-tail-timer'.  So combine with
;; these two to achieve satisfactory performance.
;; === X11
;; You should run highlight-tail-mode under X11, not in console nor terminal
;; emulator, because results will be miserable.

;;; History:

;; * 1.3.3 (30 Oct 2006)
;;      + Added (require 'cl).  Thanks to Arnaldo Mandel and Kevin
;;        Rodgers for reporting.
;;      + Many less warnings on compilation.  Thanks to Kevin Rodgers.
;; * 1.3.2 (29 Oct 2006)
;;      + Fixed the way the number of steps between every two colors
;;        are computed.
;;      + Added a test on `highlight-tail-colors' to enforce its
;;        correctness.
;; * 1.3.1 (28 Oct 2006)
;;      + Minor documentation corrections.
;; * 1.3 (28 Oct 2006)
;;      + Fading out to the *current* background color.  You no longer
;;        need to specify background color (the one at 100%) in
;;        `highlight-tail-colors' variable.  highlight-tail-mode will
;;        discover it on its own and is vigilant about future changes:
;;        3sec. timer holds an eye on it.
;;      + What's more: if there is some overlay or text property that
;;        change background color, highlight-tail will discover it and
;;        fade out to this color.
;;      + Some corrections in the documentation and comments.
;; * 1.2 (25 Aug 2006)
;;      + Now works with org-mode and orgtbl-mode.  Thanks to William
;;        Xu for reporting.
;;      + You can now choose a color by name in XEmacs.
;;      + XEmacs related bug with itimer fixed.
;;      + Fixed some typos and errors in the documentation.
;; * 1.1.1
;;      + Updated information about web page (up; new address (the old
;;        one works though)).
;; * 1.1
;;      + Fixed serious bug in the documentation (in installation section).
;;        Thanks to Mathias Dahl for reporting.
;; * 1.0
;;      + Nothing new, I just think 0.9.3 is so stable to honor it with
;;        round version number.
;; * 0.9.3
;;      + Added information about highlight-tail.el web page.
;;      + Front highlighting removed completely... It wasn't nice and
;;        there were too many troubles with it.
;;      + highlight-tail.el taken under subversion control
;; * 0.9.2
;;      + Colors can be passed with uppercase letters in.
;;      + If you choose a color, that doesn't exist in `color-name-rgb-alist',
;;        mode will call out an error instead of running "illegible" debugger 
;;      + The variable (i)timer-list is now cleaned from old timers on
;;        `highlight-tail-reload' call.
;;      + All overlays are deleted on `highlight-tail-reload' call.
;;      + Several minor bugs fixed.
;; * 0.9.1
;;      + Region kept alive in XEmacs, when going to the end of line.
;;        Thanks to Nate Drake for reporting this bug.
;;      + Functions broken into smaller parts.
;; * 0.9
;;      + Now under GPL.
;;      + Changed start, middle and end colors to a list of indefinable length
;;      + Added front and constant highlighting options.
;;      + Changed lists to hashes and vectors for speed (I don't really know
;;        did this help.)
;; * 0.8
;;      + Eats a lot less of CPU cycles than before.  Thanks to
;;        Phillip Lord for some advices how to achieve it.
;;      + Works good under XEmacs.
;;      + Added middle color option
;; * 0.7
;;      + First public version.

;;; TODO:

;; * Maybe some optimizations for speed.
;; * Make some way for highlight-tail to perfectly work with modes
;;   that rebind "normal" keys (like c-electric-mode).  Unfortunately
;;   this could be very hard or impossible.  Right now there is no
;;   highlighting on rebinded keys (like: colons, parens etc. in
;;   c-electric-mode).
;; You are free to mail me, what would you like to see in this
;; mode, or maybe you have idea for new emacs eye-candy minor-mode.
;; address@hidden

;;; Variables:

(defvar highlight-tail-colors '(("#bc2525" . 0))
  "*List of colors through which the fading will last.
The argument for every color is a percent at which this color
will have greatest intensity.

For instance:
'((\"#c1e156\" . 0)
  (\"#b8ff07\" . 25)
  (\"#00c377\" . 60)))

Verbal color names are possible.  These names are case independent.

For instance:
'((\"Black\" . 0)
  (\"white\" . 100))")

(defvar highlight-tail-steps 80
  "*Number of fading out steps.  The color will be changed that many
times.  One change (step) every `highlight-tail-timer'.")

(defvar highlight-tail-timer 0.04
  "*Number of seconds between fade out steps.
It can be sth like this: 0.2 or maybe better 0.02")

(defvar highlight-tail-const-width 10
  "*Number of chars to highlight when constant highlighting.
Makes sense only when `highlight-tail-posterior-type' is 'const.")

(defvar highlight-tail-posterior-type t
  "*Type of highlighting.
t      - normal highlighting
const  - highlight constant width of characters
         (see `highlight-tail-const-width')")

(defvar highlight-tail-stepsperfade-vector nil
  "Vector of fading steps number between `highlight-tail-colors-with-100' 

Please do not change this variable.")

(defvar highlight-tail-colors-with-100 nil
  "`highlight-tail-colors' that always end on 100%.

If `highlight-tail-colors' ends at 100% then this variable is
identical.  If not, then this variable is `highlight-tail-colors' +
'(null . 100).

Please do not change this variable.")

(defvar highlight-tail-colors-fade-list nil
  "This variable is a association list, which means it contains lists like (key 
. value).

Key could be: 
- 'start
- 'default
- hex value

And value is a list of colors for fading out in hex format.

- 'start list

This list of colors is used to build the others. It contains fade
table from the first color to the last one (from `highlight-tail-colors'

- 'default list

This list is used to fade out to the default background color. By
default background color I mean that there are no overlays nor text
properties that change the background color at the point of fading
out. This list is a join of start list and a fade table from the last
color to the background one.

- hex value list

Such list is always generated on runtime when highlight-tail discovers
a new background color. This list is a join of start list and a fade
table from the last color to the discovered one.

This list is automatically computed.
Please do not change this variable.")

(defvar highlight-tail-overlays-hash nil
  "Hash of actually being displayed highlight-tail's overlays.

Hash is indexed by overlays.  Values contains:
 - background color hex or 'default
 - face number (the step of fading out)

This hash is changed on every `highlight-tail-fade-out-step'.

Please do not change this variable.")

(defvar highlight-tail-const-overlays-list nil
  "Vector of lists containing overlays and their step at fading out.

Only when 'const highlighting is on.

The vector consists of lists like this one: (overlay . step).  Step is
a number from which parser will build a face name.  For example color
number 5 will amount to \"highlight-tail-face-default-5\".  The list is
changed on every `highlight-tail-fade-out-step' call.

Please do not change this variable.")

(defvar highlight-tail-update-const-overlays-to-this-list nil
  "A vector of numbers that const highlighting cannot exceed.

Every number int this vector is in correlation with element at the
same position in `highlight-tail-const-overlays-list'.  Such number
means that related element fading intensity cannot be larger than this

Both this and `highlight-tail-const-overlays-list' variables are
somewhat in reverse order.  The element at 0 index is the element that
stands right next to the cursor on inserting.

Please do not change this variable.")

(defvar highlight-tail-default-background-color nil
  "The actual background color computed at every
`highlight-tail-reload' and checked for being up-to-date at every 3

Please do not change this variable.")

(defvar highlight-tail-nonhtfaces-bgcolors nil
  "List with car=face-name and cadr=background-color-hex
It is computed on runtime for every not known face.

Please do not change this variable.")

(defvar highlight-tail-face-max nil
  "Number of \"max face\" (equal to `highlight-tail-steps').
Max face means the color completely faded out.

Please do not change this variable.")

(defvar highlight-tail-fading-timer nil
  "Timer that executes color changing.
Every tick of this timers will change colors of overlays.
This variable is attributed in the program.

Please do not change this variable.")

(defvar highlight-tail-defaultbgcolor-timer nil
  "Timer that executes `highlight-tail-check-if-defaultbgcolor-changed'

One tick every 3 seconds.")

(defvar highlight-tail-mode nil
  "*The highlight-tail-mode state.")

;;; Code:

(require 'cl)

(if (featurep 'xemacs)
      (defalias 'highlight-tail-make-overlay 'make-extent)
      (defalias 'highlight-tail-overlays-at 'extents-at)
      (defalias 'highlight-tail-overlay-put 'set-extent-property)
      (defalias 'highlight-tail-overlay-get 'extent-property)
      (defalias 'highlight-tail-delete-overlay 'delete-extent)
      (defalias 'highlight-tail-move-overlay 'set-extent-endpoints)
      (defalias 'highlight-tail-overlay-end 'extent-end-position)
      (defalias 'highlight-tail-overlay-start 'extent-start-position)
      (defalias 'highlight-tail-overlayp 'extent-live-p))
    (defalias 'highlight-tail-make-overlay 'make-overlay)
    (defalias 'highlight-tail-overlays-at 'overlays-at)
    (defalias 'highlight-tail-overlay-put 'overlay-put)
    (defalias 'highlight-tail-overlay-get 'overlay-get)
    (defalias 'highlight-tail-delete-overlay 'delete-overlay)
    (defalias 'highlight-tail-move-overlay 'move-overlay)
    (defalias 'highlight-tail-overlay-end 'overlay-end)
    (defalias 'highlight-tail-overlay-start 'overlay-start)
    (defalias 'highlight-tail-overlayp 'overlayp)))

(defsubst highlight-tail-make-new-overlays ()
  "Create or update overlays.
This is called by `highlight-tail-post-command'."
  (when highlight-tail-posterior-type
    (if (eq highlight-tail-posterior-type 'const)
          ;; first run - make overlays
          (unless highlight-tail-const-overlays-list
          ;; done
      ;; not const highlighting - make new overlay in the current place
      ;; with face-value of 1 (brightest)

(defun highlight-tail-post-command ()
  "Check for the last command and decide to refresh highlighting or not."
  (when (and highlight-tail-mode
             (or (equal this-command 'self-insert-command)
                 (equal this-command 'org-self-insert-command)
                 (equal this-command 'orgtbl-self-insert-command)))

(defun highlight-tail-check-if-defaultbgcolor-changed ()
  "Check if default background color changed.

Check the background color, compare it with the last remembered and
eventually change the last remembered to the current one."
  (let ((background-color-name (if (featurep 'xemacs)
                                    (face-background-name 'default)
                                  (cdr (assoc 'background-color 
    (when (not (eq background-color-name 
      (setq highlight-tail-default-background-color background-color-name)
      (highlight-tail-add-colors-fade-table 'default)
       (highlight-tail-get-colors-fade-table-with-key 'default)))))

(defsubst highlight-tail-get-face-background (face)
  "Get FACE's background"
  (if (featurep 'xemacs)
      (face-background-name face)
    (face-attribute face :background)))

(defsubst highlight-tail-hex-from-RGB (red green blue)
  "Build a color like #00FF00 from given RED, GREEN and BLUE.
For example: 0 255 0 will result in #00FF00."
  (format "#%02X%02X%02X" (round red) (round green) (round blue)))

(defsubst highlight-tail-color-in-hex-format (color)
  "Find out if COLOR is in hex format or not."
  (string-equal (if (featurep 'xemacs)
                    (replace-in-string color
                  (replace-regexp-in-string "#[0-9a-fA-F]\\{6\\}"

(defsubst highlight-tail-hex-from-colorname (color)
  "Build a color like #00FF00 from \"green\" or return COLOR if already 
  (let ((return-color
         (if (highlight-tail-color-in-hex-format color)
           (let ((highlight-tail-color-from-system-list
                  (highlight-tail-get-RGB-from-systemlist color)))
              (nth 1 highlight-tail-color-from-system-list)
              (nth 2 highlight-tail-color-from-system-list)
              (nth 3 highlight-tail-color-from-system-list))))))

(defun highlight-tail-get-bgcolor-hex (point)
  "Get the background color of point.

Do not take highlight-tail's overlays into consideration.  This means
that if there is ht's overlay at at the top then return 'default"
  (let ((point-face (get-char-property point 'face))
    (if point-face
          (when (listp point-face) (setq point-face (car point-face)))
          ;; This is weird because for howm-reminder-today-face, the
          ;; (get-char-property) function returns a list:
          ;; (howm-reminder-today-face), so it's needed to get car of
          ;; it...
          (when (stringp point-face) (setq point-face (intern point-face)))
          ;; This is weird because for faces used by ediff, the
          ;; (get-char-property) function returns a string:
          ;; "xxx-face", so it's needed to intern it...
          (setq point-face-from-cache (assoc point-face 
          (if point-face-from-cache
              (setq point-face-bgcolor-hex (cdr point-face-from-cache))
            (setq point-face-bgcolor (highlight-tail-get-face-background 
            (when (or (eq point-face-bgcolor nil)
                      (eq point-face-bgcolor 'unspecified))
              (setq point-face-bgcolor 'default))))
      (setq point-face-bgcolor 'default))
    (when (not point-face-bgcolor-hex)  ; not read from cache
      (if (eq point-face-bgcolor 'default)
          (setq point-face-bgcolor-hex 'default)
        ;; else
        (setq point-face-bgcolor-hex (highlight-tail-hex-from-colorname 
        (setq highlight-tail-nonhtfaces-bgcolors
              (cons (cons point-face point-face-bgcolor-hex)
        (highlight-tail-add-colors-fade-table point-face-bgcolor-hex)
    ;; return value

(defun highlight-tail-make-new-overlay ()
  "Make new highlight in the current point."
  (let* ((end-point (point))
         (start-point (1- end-point))
         (point-face-bgcolor-hex nil))
    ;; remove any highlight-tail's overlays at point
    (let ((overlays-at-start-point (highlight-tail-overlays-at start-point))
      (mapcar '(lambda (overlay)
                 (when (highlight-tail-overlay-get overlay 'highlight-tail)
                   (setq highlight-tail-overlay overlay)))
      (when highlight-tail-overlay
        (remhash highlight-tail-overlay highlight-tail-overlays-hash)
        (highlight-tail-delete-overlay highlight-tail-overlay)))
    ;; do we need to fade out to default color or any other
    (setq point-face-bgcolor-hex (highlight-tail-get-bgcolor-hex start-point))
    ;; add the overlay with good ending color
    (let ((highlight-tail-overlay (highlight-tail-make-overlay start-point 
      (puthash highlight-tail-overlay
               (list point-face-bgcolor-hex
                     1)                ; first step in fading-out
      (highlight-tail-overlay-put highlight-tail-overlay 'evaporate t)
      (highlight-tail-overlay-put highlight-tail-overlay 'highlight-tail t)
      (highlight-tail-overlay-put highlight-tail-overlay 'face
                                   (concat "highlight-tail-face-"
                                           (format "%s" point-face-bgcolor-hex)
                                           "-1")))))) ; first step in fading out

(defun highlight-tail-make-const-overlays-list ()
  "Make constant overlays list, that will be later operated on.
\(by `highlight-tail-fade-out-step')

It is executed only when `highlight-tail-posterior-type' is 'const."
  ;; we are going from end
  (let ((iterator (1- highlight-tail-const-width))
        ;; difference between neighbouring elements of
        ;; `highlight-tail-update-const-overlays-to-this-list'
        (fading-intensity-step (/ highlight-tail-face-max
                                  (float highlight-tail-const-width)))
        (fading-intensity highlight-tail-face-max))
    (setq highlight-tail-const-overlays-list
          (make-vector highlight-tail-const-width nil))
    (setq highlight-tail-update-const-overlays-to-this-list
          (make-vector highlight-tail-const-width nil))
    (while (>= iterator 0)
      ;; make overlay in array of const overlays
      (aset highlight-tail-const-overlays-list
            (cons (highlight-tail-make-overlay (point) (point))
                  highlight-tail-face-max)) ; last step in fading out

      ;; decrease the fading intensity by constant factor
      (setq fading-intensity (- fading-intensity fading-intensity-step))
      (aset highlight-tail-update-const-overlays-to-this-list
            (round fading-intensity))
      (let ((highlight-tail-overlay (car (elt 
highlight-tail-const-overlays-list iterator))))
        (highlight-tail-overlay-put highlight-tail-overlay 'highlight-tail t)
          (concat "highlight-tail-face-default-" ;detecting bgcolor will be 
done later
                  (number-to-string highlight-tail-face-max))))) ; last step in 
fading out
      (setq iterator (1- iterator)))))

(defun highlight-tail-update-const-overlays-list ()
  "Update constant overlays list (colors, positions etc.)

It only occurs when `highlight-tail-posterior-type' is 'const."
  (let ((iterator 0))
    ;; iterate through `highlight-tail-const-overlays-list'
    (while (< iterator (length highlight-tail-const-overlays-list))
      (let ((overlay-point (- (point) iterator)))
        (if (< (- (point) overlay-point) (current-column))
            (highlight-tail-move-overlay (car (elt 
highlight-tail-const-overlays-list iterator))
                                         overlay-point (1- overlay-point)
          ;; move to current-buffer to not blink in other buffer
          ;; it is good for minibuffer
          (highlight-tail-move-overlay (car (elt 
highlight-tail-const-overlays-list iterator))
                                       1 1
      ;; change the intesity of fading
      (let ((new-value (round (- (cdr (elt highlight-tail-const-overlays-list 
                                 (* (- highlight-tail-face-max
highlight-tail-update-const-overlays-to-this-list iterator))
        ;; new-value = (curface)-(0.15*(maxface-updateto))
        (when (< new-value (elt 
highlight-tail-update-const-overlays-to-this-list iterator))
          (setq new-value (elt 
highlight-tail-update-const-overlays-to-this-list iterator)))
        (setcdr (elt highlight-tail-const-overlays-list iterator) new-value))
      (setq iterator (1+ iterator)))))

(defun highlight-tail-fade-out-step ()
  "Go through all overlays and make sth with them.
Such as compute new faces, purge old overlays etc.

This is called every `highlight-tail-timer' amount of time."
  (sit-for 0)
  ;; if mode had been just disabled - delete all overlays
  ;; and cancel timers
  (if (not highlight-tail-mode)

  ;; if there are some overlays
  (when highlight-tail-posterior-type
    (if (eq highlight-tail-posterior-type 'const)
        ;; if const highlighting
        (when highlight-tail-const-overlays-list
          (let ((iterator 0))
            ;; iteratate through elements of 
            (while (< iterator highlight-tail-const-width)
              (let ((cur-face-number (cdr (elt 
highlight-tail-const-overlays-list iterator))))
                ;; number < `highlight-tail-face-max'
                (if (not (= cur-face-number
                      (setq cur-face-number (1+ cur-face-number))
                      (setcdr (elt highlight-tail-const-overlays-list iterator)
                      (highlight-tail-overlay-put (car (elt 
highlight-tail-const-overlays-list iterator))
                  (highlight-tail-move-overlay (car (elt 
highlight-tail-const-overlays-list iterator))
                                               1 1

                (setq iterator (1+ iterator))))))
      ;; if not const-highlighting
      (when (> (hash-table-count highlight-tail-overlays-hash) 0)
        (maphash 'highlight-tail-fade-out-step-process-overlay
(defun highlight-tail-fade-out-step-process-overlay (key value)
  "Process every KEY in `highlight-tail-overlays-hash'."
  (let ((cur-face-number (car (last value))))
    (if (< cur-face-number highlight-tail-face-max)
          (setq cur-face-number (1+ cur-face-number))
          (setcar (last value) cur-face-number)
          ;; fade out to the background color
            (concat "highlight-tail-face-" (format "%s" (car value)) "-"
                    (number-to-string cur-face-number)))))
      ;; end of highlighting here
      (highlight-tail-delete-overlay key)
      (remhash key highlight-tail-overlays-hash))))

(defmacro highlight-tail-get-colors-fade-table-with-key (for-what)
  (list 'assoc for-what 'highlight-tail-colors-fade-list))

(defun highlight-tail-add-colors-fade-table (for-what)
  "Compute list of colors that will smoothly change from one to another.
The list is stored in variable `highlight-tail-colors-fade-list'.

If FOR-WHAT is 'start then the list is computed for all colors from
`highlight-tail-colors'.  If FOR-WHAT is a hex color or 'default then
the list is a join of 'start fade-table and a fade-table computed from
the last color in `highlight-tail-colors' to the given one.

Where 'default is `highlight-tail-default-background-color'"
  (let ((colors-fade-elem (highlight-tail-get-colors-fade-table-with-key 
    ;; preper colors-fade-elem
    (if colors-fade-elem
        (setf (cadr colors-fade-elem) nil)
      ;; else (no colors-fade-elem in list)
      (add-to-list 'highlight-tail-colors-fade-list
                   (list for-what nil))
      (setq colors-fade-elem (highlight-tail-get-colors-fade-table-with-key 
    ;; compute the list
    (let* ((iter 0)
           (for-what-is-start (equal for-what 'start))
           (for-what (if (eq for-what 'default)
                         ;; 'default is not a color, so we need to
                         ;; replace it with default's hex
            (let ((temp (mapcar ; *copy* elements of 
                         '(lambda (elem) elem) ; to temporary variable
              (setcar (last temp) (cons for-what 100))
           (spfv-length (length highlight-tail-stepsperfade-vector))
      (if for-what-is-start
          (while (< iter (1- spfv-length))
            (setq result
                  (append result
                           (car (nth iter for-what-colors-list))
                           (car (nth (1+ iter) for-what-colors-list))
                           (elt highlight-tail-stepsperfade-vector iter))))
            (setq iter (1+ iter)))
        ;; if (not for-what-is-start) copy starting elements from
        ;; 'start list
        (setq result
              (cadr (highlight-tail-get-colors-fade-table-with-key 'start)))
        (setq result
              (append result
                       (car (nth (1- spfv-length) for-what-colors-list))
                       (car (nth spfv-length for-what-colors-list))
                       (elt highlight-tail-stepsperfade-vector (1- 
      (setf (cadr colors-fade-elem) result))))

(defun highlight-tail-find-colors-fade-table-part (color-from color-to 
  "Create a list of smoothly changed colors.
>From COLOR-FROM to COLOR-TO             ; STEPS-COUNT length."
  (let (color-from-red color-from-green color-from-blue  
                       color-to-red color-to-green color-to-blue    
                       color-temp-red color-temp-green color-temp-blue       
                       color-step-red ; the color is smoothly changing; we'll 
calculate a value
                       color-step-green ; that will be added to COLOR-FROM at 
every single step,
                       color-step-blue ; multiplied by current step number of 
                       ;; will values be positive or negative
                       color-step-red-positive color-step-green-positive 
                       ;; differences between FROM and TO values
                       color-red-difference color-green-difference 
                       (step 1))
    ;; Get red, green and blue intensities from give colors.
    (if (highlight-tail-color-in-hex-format color-from)
        (setq color-from-red (string-to-number (substring color-from 1 3) 16)
              color-from-green (string-to-number (substring color-from 3 5) 16)
              color-from-blue (string-to-number (substring color-from 5 7) 16 ))
      (let ((temp-color (highlight-tail-get-RGB-from-systemlist color-from)))
        (setq color-from-red (nth 1 temp-color))
        (setq color-from-green (nth 2 temp-color))
        (setq color-from-blue (nth 3 temp-color))))
    (if (highlight-tail-color-in-hex-format color-to)
        (setq color-to-red (string-to-number (substring color-to 1 3) 16)
              color-to-green (string-to-number (substring color-to 3 5) 16)
              color-to-blue (string-to-number (substring color-to 5 7) 16))
      (let ((temp-color (highlight-tail-get-RGB-from-systemlist color-to)))
        (setq color-to-red (nth 1 temp-color))
        (setq color-to-green (nth 2 temp-color))
        (setq color-to-blue (nth 3 temp-color))))

    (setq ;; compute difference of COLOR-FROM and COLOR-TO
     color-red-difference (abs (- color-from-red color-to-red))
     color-green-difference (abs (- color-from-green color-to-green))
     color-blue-difference (abs (- color-from-blue color-to-blue))
     ;; compute what every single step of fading will change
     color-step-red (/ (float color-red-difference) steps-count)
     color-step-green (/ (float color-green-difference) steps-count)
     color-step-blue (/ (float color-blue-difference) steps-count)
     ;; check if step values should be positive or negative
     color-step-red-positive (>= color-to-red color-from-red)
     color-step-green-positive (>= color-to-green color-from-green)
     color-step-blue-positive (>= color-to-blue color-from-blue)
    ;; if desirable - make values negative
    (if (not color-step-red-positive) (setq color-step-red (* color-step-red 
    (if (not color-step-green-positive) (setq color-step-green (* 
color-step-green -1)))
    (if (not color-step-blue-positive) (setq color-step-blue (* color-step-blue 

    ;; now compute the list ;;
    ;; we have colors in red, green and blue values;
    (setq color-temp-red color-to-red
          color-temp-green color-to-green
          color-temp-blue color-to-blue)
    (while (<= step steps-count)
      (setq color-temp-red (- color-temp-red color-step-red)
            color-temp-green (- color-temp-green color-step-green)
            color-temp-blue (- color-temp-blue color-step-blue)
            (cons (highlight-tail-hex-from-RGB color-temp-red color-temp-green 
            step (1+ step)))

(defun highlight-tail-get-RGB-from-systemlist (color-name)
  "Find a COLOR-NAME in list `color-name-rgb-alist' (Emacs) or
`color-rgb-components' (Xemacs)."
  (let ((color-name (downcase color-name)))
    (if (featurep 'xemacs)
        (let ((colors-list-to-return
               (color-rgb-components (make-color-specifier color-name))))
          (setq colors-list-to-return (mapcar '(lambda (elem) (round (* (/ elem 
65535.0) 255)))
          (add-to-list 'colors-list-to-return color-name)
      ;; Emacs
      (let (;; throw out spaces, because there are no in `color-name-rgb-alist'.
            (color-name (replace-regexp-in-string " " "" color-name)))
        ;; single element found in emacs list of colors `color-name-rgb-alist'
        ;; it'll be like: ("ghostwhite" 248 248 255))
        (assoc color-name color-name-rgb-alist)))))

(defun highlight-tail-make-faces (colors-fade-table-with-key)
  "Make faces from list of colors.

Faces will be named: highlight-tail-face-X-Y, where X is a color name
from highlight-tail-colors-fade-list and Y is a number from 1 to
length of colors-fade-table from COLORS-FADE-TABLE-WITH-KEY"
  (let ((face-name-color-part (format "%s" (car colors-fade-table-with-key)))
        (colors-list (cadr colors-fade-table-with-key))
        (count 1)
    (while (<= count (length colors-list))
      (setq face-name
            (intern (concat "highlight-tail-face-"
                            (number-to-string count))))
      (make-face face-name)
      (set-face-background face-name (nth (1- count) colors-list))
      (setq count (1+ count)))))

(defun highlight-tail-tide-up ()
  "Delete all overlays, cancel timers, and so on (clean up)..."
  (let ((count 0))
    (when (hash-table-p highlight-tail-overlays-hash)
      (maphash 'highlight-tail-overlays-hash-delete-overlay-map
      (clrhash highlight-tail-overlays-hash))
    (setq count 0)
    (while (< count (length highlight-tail-const-overlays-list))
      (highlight-tail-delete-overlay (car (elt 
highlight-tail-const-overlays-list count)))
      (setq count (1+ count)))
    (setq highlight-tail-colors-fade-list nil
          highlight-tail-stepsperfade-vector nil
          highlight-tail-overlays-hash nil
          highlight-tail-default-background-color nil
          highlight-tail-nonhtfaces-bgcolors nil
          highlight-tail-const-overlays-list nil
          highlight-tail-update-const-overlays-to-this-list nil
          highlight-tail-face-max nil)

(defun highlight-tail-cancel-timers ()
  "Cancel timers"
  (if (featurep 'xemacs)
      (when (itimerp highlight-tail-fading-timer)
        (delete-itimer highlight-tail-fading-timer)
        (delete-itimer highlight-tail-defaultbgcolor-timer))
    (when (timerp highlight-tail-fading-timer)
      (cancel-timer highlight-tail-fading-timer)
      (cancel-timer highlight-tail-defaultbgcolor-timer))))

(defsubst highlight-tail-overlays-hash-delete-overlay-map (key value)
  "Deletes the overlay from VALUE."
  (if (highlight-tail-overlayp key)
      (highlight-tail-delete-overlay key)))

(defun highlight-tail-reload ()
  "Recreate color-fade-tables, faces, hook, turn on `highlight-tail-mode', and 
so on...
Run it, when you've made changes to some highlight-tail-mode variables."
  ;; check that `highlight-tail-colors' variable has been defined
  ;; correctly by the user
  (let ((previous-elem-value -1)   ;first elem should be 0 and 0>-1 :)
         '(lambda (elem explanation)
            (error (format "%s element in `highlight-tail-colors' is wrong! %s"
                           elem explanation)))))
    ;; Check that first element is at 0%.
    (when (not (= (cdar highlight-tail-colors) 0))
      (apply httmp-signal-error-function
             (format "First (%s)" (car highlight-tail-colors))
             (list "Value should be zero.")))
    ;; Check that every element is greater than previous one.
    (mapcar '(lambda (elem)
               (if (<= (cdr elem) previous-elem-value)
                   (apply httmp-signal-error-function
                          (list "Value should be greater than previous 
                 (setq previous-elem-value (cdr elem))))
    ;; Check that last element is <= 100%.
    (when (not (<= (cdar (last highlight-tail-colors)) 100))
      (apply httmp-signal-error-function
             (format "Last (%s)" (car (last highlight-tail-colors)))
             (list "Value should be less than or equal to 100."))))
  ;; if there is a color name in `highlight-tail-colors', that doesn't
  ;; exist in systemlists - call out an error
  (when (member
         ;; create a list of "t"s, color lists '(red 255 0 0) and nils
         ;; in place of colors that doesn't exist
          '(lambda (elem)
             (let ((color-name (car elem)))
               (if (highlight-tail-color-in-hex-format color-name)
                   ;; does not need to be on system list
                 ;; try to get from system list
                 (if (featurep 'xemacs)
                     (color-rgb-components (make-color-specifier color-name))
                   (assoc color-name color-name-rgb-alist))))) 
    (error "Some color doesn't exist"))

  (highlight-tail-mode 1)               ; add to minor-modes list

  (setq highlight-tail-overlays-hash (make-hash-table))

  (let* ((background-color-name (if (featurep 'xemacs)
                                    (face-background-name 'default)
                                  (cdr (assoc 'background-color 
         (background-color-hex (highlight-tail-hex-from-colorname 
    (setq highlight-tail-default-background-color background-color-name))
  (setq highlight-tail-colors-with-100
        (if (= (cdr (nth (1- (length highlight-tail-colors)) 
          (append highlight-tail-colors (list '(null . 100)))))

  ;; compute the `highlight-tail-stepsperfade-vector'
  (let* (iter
         (colors-with-100-length (length highlight-tail-colors-with-100))
         (percents-vector (make-vector colors-with-100-length nil))
         ;; below: scaled to `highlight-tail-steps'
         (percents-vector-scaled (make-vector colors-with-100-length nil)))
    (setq percents-vector (mapcar '(lambda (elem)
                                     (cdr elem))
    (setq highlight-tail-stepsperfade-vector
          (make-vector (1- colors-with-100-length) nil))
    (setq iter 0)
    (while (< iter colors-with-100-length)
      (setf (elt percents-vector-scaled iter)
            ;; (elem%)*steps
            (round (* (/ (float (nth iter percents-vector))
      (setq iter (1+ iter)))
    (setq iter 1)
    (while (< iter colors-with-100-length)
      (setf (elt highlight-tail-stepsperfade-vector (1- iter))
            (- (elt percents-vector-scaled iter)
               (elt percents-vector-scaled (1- iter))))
      (setq iter (1+ iter))))

  (highlight-tail-add-colors-fade-table 'start)
  (highlight-tail-add-colors-fade-table 'default)
  (setq highlight-tail-face-max highlight-tail-steps)
  (highlight-tail-make-faces (highlight-tail-get-colors-fade-table-with-key 
  (setq highlight-tail-fading-timer
        (if (featurep 'xemacs)
            (start-itimer "highlight-tail-fade-out-step"
          (run-at-time nil highlight-tail-timer
  (setq highlight-tail-defaultbgcolor-timer
        (if (featurep 'xemacs)
            (start-itimer "highlight-tail-check-if-defaultbgcolor-changed"
          (run-at-time nil 3
  (add-hook 'post-command-hook 'highlight-tail-post-command))

(defun highlight-tail-mode (arg)
  "Draw a \"tail\" while you're typing.

This minor-mode draws a tail in real time, when you write.  It
changes the background color of some last typed characters and
smoothly fade them out.

If ARG is 0 or less than zero then the mode will be disabled.
If ARG is nil then the mode will be switched.
If ARG is greater than zero then this mode will be turned on."
  (interactive "P")
  (setq highlight-tail-mode
        (if (null arg) (not highlight-tail-mode)
          (> (prefix-numeric-value arg) 0)))
  (add-to-list 'minor-mode-alist '(highlight-tail-mode " ht"))
  (if (interactive-p)
      (if highlight-tail-mode
            (add-hook 'post-command-hook 'highlight-tail-post-command)
            (message "Highlight tail mode enabled"))
          (message "Highlight tail mode disabled")))))

(provide 'highlight-tail)

;;; highlight-tail.el ends here

######<tonious> "I2P: Because noone wants to see what you browse.  Ugh."######

reply via email to

[Prev in Thread] Current Thread [Next in Thread]