view lisp/cedet/pulse.el @ 110410:f2e111723c3a

Merge changes made in Gnus trunk. Reimplement nnimap, and do tweaks to the rest of the code to support that. * gnus-int.el (gnus-finish-retrieve-group-infos) (gnus-retrieve-group-data-early): New functions. * gnus-range.el (gnus-range-nconcat): New function. * gnus-start.el (gnus-get-unread-articles): Support early retrieval of data. (gnus-read-active-for-groups): Support finishing the early retrieval of data. * gnus-sum.el (gnus-summary-move-article): Pass the move-to group name if the move is internal, so that nnimap can do fast internal moves. * gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for nnimap usage. * nnimap.el: Rewritten. * nnmail.el (nnmail-inhibit-default-split-group): New internal variable to allow the mail splitting to not return a default group. This is useful for nnimap, which will leave unmatched mail in the inbox. * utf7.el (utf7-encode): Autoload. Implement shell connection. * nnimap.el (nnimap-open-shell-stream): New function. (nnimap-open-connection): Use it. Get the number of lines by using BODYSTRUCTURE. (nnimap-transform-headers): Get the number of lines in each message. (nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the number of lines. Not all servers return UIDNEXT. Work past this problem. Remove junk from end of file. Fix typo in "bogus" section. Make capabilties be case-insensitive. Require cl when compiling. Don't bug out if the LIST command doesn't have any parameters. 2010-09-17 Knut Anders Hatlen <[e-mail]> (tiny change) * nnimap.el (nnimap-get-groups): Don't bug out if the LIST command doesn't have any parameters. (mm-text-html-renderer): Document gnus-article-html. 2010-09-17 Julien Danjou <[e-mail]> (tiny fix) * mm-decode.el (mm-text-html-renderer): Document gnus-article-html. * dgnushack.el: Define netrc-credentials. If the user doesn't have a /etc/services, supply some sensible port defaults. Have `unseen-or-unread' select an unread unseen article first. (nntp-open-server): Return whether the open was successful or not. Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ). Save result so that it doesn't say "failed" all the time. Add ~/.authinfo to the default, since that's probably most useful for users. Don't use the "finish" method when we're reading from the agent. Add some more nnimap-relevant agent stuff to nnagent.el. * nnimap.el (nnimap-with-process-buffer): Removed. Revert one line that was changed by mistake in the last checkin. (nnimap-open-connection): Don't error out when we can't make a connection nnimap-related changes to avoid bugging out if we can't contact a server. * gnus-start.el (gnus-get-unread-articles): Don't try to scan groups from methods that are denied. * nnimap.el (nnimap-possibly-change-group): Return nil if we can't log in. (nnimap-finish-retrieve-group-infos): Make sure we're not waiting for nothing. * gnus-sum.el (gnus-select-newsgroup): Indent.

;;; pulse.el --- Pulsing Overlays

;;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <[e-mail]>

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Manage temporary pulsing of faces and overlays.
;;
;; This is a temporal decoration technique where something is to be
;; highlighted briefly.  This adds a gentle pulsing style to the text
;; decorated this way.
;;
;; The following are useful entry points:
;;
;; `pulse' - Cause `pulse-highlight-face' to shift toward background color.
;;      Assumes you are using a version of Emacs that supports pulsing.
;;
;;
;; `pulse-momentary-highlight-one-line' - Pulse a single line at POINT.
;; `pulse-momentary-highlight-region' - Pulse a region.
;; `pulse-momentary-highlight-overlay' - Pulse an overlay
;;      These three functions will just blink the specified area if
;;      the version of Emacs you are using doesn't support pulsing.
;;
;; `pulse-line-hook-function' - A simple function that can be used in a
;;      hook that will pulse whatever line the cursor is on.
;;
;;; History:
;;
;; The original pulse code was written for semantic tag highlighting.
;; It has been extracted, and adapted for general purpose pulsing.
;;
;; Pulse is a part of CEDET.  http://cedet.sf.net

(defun  pulse-available-p ()
  "Return non-nil if pulsing is available on the current frame."
  (condition-case nil
      (let ((v (color-values (face-background 'default))))
	(numberp (car-safe v)))
    (error nil)))

(defcustom pulse-flag (pulse-available-p)
  "*Non-nil means to pulse the overlay face for momentary highlighting.
Pulsing involves a bright highlight that slowly shifts to the background
color.  Non-nil just means to highlight with an unchanging color for a short
time.

If `pulse-flag' is non-nil, but `pulse-available-p' is nil, then
this flag is ignored."
  :group 'pulse
  :type 'boolean)

(defface pulse-highlight-start-face
  '((((class color) (background dark))
     (:background "#AAAA33"))
    (((class color) (background light))
     (:background "#FFFFAA")))
  "*Face used at beginning of a highight."
  :group 'pulse)

(defface pulse-highlight-face
  '((((class color) (background dark))
     (:background "#AAAA33"))
    (((class color) (background light))
     (:background "#FFFFAA")))
  "*Face used during a pulse for display.  *DO NOT CUSTOMIZE*
Face used for temporary highlighting of tags for effect."
  :group 'pulse)

;;; Code:
;;
(defun pulse-int-to-hex (int &optional nb-digits)
  "Convert integer argument INT to a #XXXXXXXXXXXX format hex string.
Each X in the output string is a hexadecimal digit.
NB-DIGITS is the number of hex digits.  If INT is too large to be
represented with NB-DIGITS, then the result is truncated from the
left.  So, for example, INT=256 and NB-DIGITS=2 returns \"00\", since
the hex equivalent of 256 decimal is 100, which is more than 2 digits.

This function was blindly copied from hexrgb.el by Drew Adams.
http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el"
  (setq nb-digits (or nb-digits 4))
  (substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits)))

(defun pulse-color-values-to-hex (values)
  "Convert list of rgb color VALUES to a hex string, #XXXXXXXXXXXX.
Each X in the string is a hexadecimal digit.
Input VALUES is as for the output of `x-color-values'.

This function was blindly copied from hexrgb.el by Drew Adams.
http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el"
  (concat "#"
          (pulse-int-to-hex (nth 0 values) 4) ; red
          (pulse-int-to-hex (nth 1 values) 4) ; green
          (pulse-int-to-hex (nth 2 values) 4))) ; blue

(defcustom pulse-iterations 10
  "Number of iterations in a pulse operation."
  :group 'pulse
  :type 'number)
(defcustom pulse-delay .03
  "Delay between face lightening iterations, as used by `sit-for'."
  :group 'pulse
  :type 'number)

(defun pulse-lighten-highlight ()
  "Lighten the face by 1/`pulse-iterations' toward the background color.
Return t if there is more drift to do, nil if completed."
  (if (>= (get 'pulse-highlight-face :iteration) pulse-iterations)
      nil
    (let* ((frame (color-values (face-background 'default)))
	   (start (color-values (face-background
				 (get 'pulse-highlight-face
				      :startface))))
	   (frac  (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations)
			(/ (- (nth 1 frame) (nth 1 start)) pulse-iterations)
			(/ (- (nth 2 frame) (nth 2 start)) pulse-iterations)))
	   (it (get 'pulse-highlight-face :iteration))
	   )
      (set-face-background 'pulse-highlight-face
			   (pulse-color-values-to-hex
			    (list
			     (+ (nth 0 start) (* (nth 0 frac) it))
			     (+ (nth 1 start) (* (nth 1 frac) it))
			     (+ (nth 2 start) (* (nth 2 frac) it)))))
      (put 'pulse-highlight-face :iteration (1+ it))
      (if (>= (1+ it) pulse-iterations)
	  nil
	t))))

(defun pulse-reset-face (&optional face)
  "Reset the pulse highlighting FACE."
  (set-face-background 'pulse-highlight-face
		       (if face
			   (face-background face)
			 (face-background 'pulse-highlight-start-face)
			 ))
  (put 'pulse-highlight-face :startface (or face
					    'pulse-highlight-start-face))
  (put 'pulse-highlight-face :iteration 0))

(defun pulse (&optional face)
  "Pulse the colors on our highlight face.
If optional FACE is provide, reset the face to FACE color,
instead of `pulse-highlight-start-face'.
Be sure to call `pulse-reset-face' after calling pulse."
  (unwind-protect
      (progn
	(pulse-reset-face face)
	(while (and (pulse-lighten-highlight)
		    (sit-for pulse-delay))
	  nil))))

;;; Convenience Functions
;;
(defvar pulse-momentary-overlay nil
  "The current pulsing overlay.")

(defun pulse-momentary-highlight-overlay (o &optional face)
  "Pulse the overlay O, unhighlighting before next command.
Optional argument FACE specifies the fact to do the highlighting."
  (overlay-put o 'original-face (overlay-get o 'face))
  (add-to-list 'pulse-momentary-overlay o)
  (if (or (not pulse-flag) (not (pulse-available-p)))
      ;; Provide a face... clear on next command
      (progn
	(overlay-put o 'face (or face 'pulse-highlight-start-face))
	(add-hook 'pre-command-hook
		  'pulse-momentary-unhighlight)
	)
    ;; pulse it.
    (unwind-protect
	(progn
	  (overlay-put o 'face 'pulse-highlight-face)
	  ;; The pulse function puts FACE onto 'pulse-highlight-face.
	  ;; Thus above we put our face on the overlay, but pulse
	  ;; with a reference face needed for the color.
	  (pulse face))
      (pulse-momentary-unhighlight))))

(defun pulse-momentary-unhighlight ()
  "Unhighlight a line recently highlighted."
  ;; If someone passes in an overlay, then pulse-momentary-overlay
  ;; will still be nil, and won't need modifying.
  (when pulse-momentary-overlay
    ;; clear the starting face
    (mapc
     (lambda (ol)
       (overlay-put ol 'face (overlay-get ol 'original-face))
       (overlay-put ol 'original-face nil)
       ;; Clear the overlay if it needs deleting.
       (when (overlay-get ol 'pulse-delete) (delete-overlay ol)))
     pulse-momentary-overlay)

    ;; Clear the variable.
    (setq pulse-momentary-overlay nil))

  ;; Reset the pulsing face.
  (pulse-reset-face)

  ;; Remove this hook.
  (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight))

(defun pulse-momentary-highlight-one-line (point &optional face)
  "Highlight the line around POINT, unhighlighting before next command.
Optional argument FACE specifies the face to do the highlighting."
  (let ((start (point-at-bol))
	(end (save-excursion
	       (end-of-line)
	       (when (not (eobp))
		 (forward-char 1))
	       (point))))
    (pulse-momentary-highlight-region start end face)))

(defun pulse-momentary-highlight-region (start end &optional face)
  "Highlight between START and END, unhighlighting before next command.
Optional argument FACE specifies the fact to do the highlighting."
  (let ((o (make-overlay start end)))
    ;; Mark it for deletion
    (overlay-put o 'pulse-delete t)
    (pulse-momentary-highlight-overlay o face)))

;;; Random integration with other tools

(defvar pulse-command-advice-flag nil)

(defun pulse-line-hook-function ()
  "Function used in hooks to pulse the current line.
Only pulses the line if `pulse-command-advice-flag' is non-nil."
  (when pulse-command-advice-flag
    (pulse-momentary-highlight-one-line (point))))

(provide 'pulse)

;; arch-tag: 6e2f78c1-65b3-4164-a141-872cb1552959
;;; pulse.el ends here