code.delx.au - gnu-emacs/blob - lisp/net/newst-ticker.el

   1 ;; newst-ticker.el --- modeline ticker for newsticker.
   2
   3 ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author:      Ulf Jasper <ulf.jasper@web.de>
   7 ;; Filename:    newst-ticker.el
   8 ;; URL:         http://www.nongnu.org/newsticker
   9 ;; Keywords:    News, RSS, Atom
  10 ;; Time-stamp:  "6. Dezember 2009, 19:16:00 (ulf)"
  11 ;; Package:     newsticker
  12
  13 ;; ======================================================================
  14
  15 ;; This file is part of GNU Emacs.
  16
  17 ;; GNU Emacs is free software: you can redistribute it and/or modify
  18 ;; it under the terms of the GNU General Public License as published by
  19 ;; the Free Software Foundation, either version 3 of the License, or
  20 ;; (at your option) any later version.
  21
  22 ;; GNU Emacs is distributed in the hope that it will be useful,
  23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25 ;; GNU General Public License for more details.
  26
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  29
  30 ;; ======================================================================
  31
  32 ;;; Commentary:
  33
  34 ;; See newsticker.el
  35
  36 ;; ======================================================================
  37 ;;; Code:
  38
  39 (require 'newst-backend)
  40
  41 (defvar newsticker--ticker-timer nil
  42   "Timer for newsticker ticker.")
  43
  44 ;;;###autoload
  45 (defun newsticker-ticker-running-p ()
  46   "Check whether newsticker's actual ticker is running.
  47 Return t if ticker is running, nil otherwise.  Newsticker is
  48 considered to be running if the newsticker timer list is not
  49 empty."
  50   (timerp newsticker--ticker-timer))
  51
  52 ;; customization group ticker
  53 (defgroup newsticker-ticker nil
  54   "Settings for the headline ticker."
  55   :group 'newsticker)
  56
  57 (defun newsticker--set-customvar-ticker (symbol value)
  58   "Set newsticker-variable SYMBOL value to VALUE.
  59 Calls all actions which are necessary in order to make the new
  60 value effective."
  61   (if (or (not (boundp symbol))
  62           (equal (symbol-value symbol) value))
  63       (set symbol value)
  64     ;; something must have changed -- restart ticker
  65     (when (newsticker-running-p)
  66       (message "Restarting ticker")
  67       (newsticker-stop-ticker)
  68       (newsticker--ticker-text-setup)
  69       (newsticker-start-ticker)
  70       (message ""))))
  71
  72 (defcustom newsticker-ticker-interval
  73   0.3
  74   "Time interval for displaying news items in the echo area (seconds).
  75 If equal or less than 0 no messages are shown in the echo area.  For
  76 smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems
  77 reasonable.  For non-smooth display a value of 10 is a good starting
  78 point."
  79   :type 'number
  80   :set 'newsticker--set-customvar-ticker
  81   :group 'newsticker-ticker)
  82
  83 (defcustom newsticker-scroll-smoothly
  84   t
  85   "Decides whether to flash or scroll news items.
  86 If t the news headlines are scrolled (more-or-less) smoothly in the echo
  87 area.  If nil one headline after another is displayed in the echo area.
  88 The variable `newsticker-ticker-interval' determines how fast this
  89 display moves/changes and whether headlines are shown in the echo area
  90 at all.  If you change `newsticker-scroll-smoothly' you should also change
  91 `newsticker-ticker-interval'."
  92   :type 'boolean
  93   :group 'newsticker-ticker)
  94
  95 (defcustom newsticker-hide-immortal-items-in-echo-area
  96   t
  97   "Decides whether to show immortal/non-expiring news items in the ticker.
  98 If t the echo area will not show immortal items.  See also
  99 `newsticker-hide-old-items-in-echo-area'."
 100   :type 'boolean
 101   :set 'newsticker--set-customvar-ticker
 102   :group 'newsticker-ticker)
 103
 104 (defcustom newsticker-hide-old-items-in-echo-area
 105   t
 106   "Decides whether to show only the newest news items in the ticker.
 107 If t the echo area will show only new items, i.e. only items which have
 108 been added between the last two retrievals."
 109   :type 'boolean
 110   :set 'newsticker--set-customvar-ticker
 111   :group 'newsticker-ticker)
 112
 113 (defcustom newsticker-hide-obsolete-items-in-echo-area
 114   t
 115   "Decides whether to show obsolete items items in the ticker.
 116 If t the echo area will not show obsolete items.  See also
 117 `newsticker-hide-old-items-in-echo-area'."
 118   :type 'boolean
 119   :set 'newsticker--set-customvar-ticker
 120   :group 'newsticker-ticker)
 121
 122 (defun newsticker--display-tick ()
 123   "Called from the display timer.
 124 This function calls a display function, according to the variable
 125 `newsticker-scroll-smoothly'."
 126   (if newsticker-scroll-smoothly
 127       (newsticker--display-scroll)
 128     (newsticker--display-jump)))
 129
 130 (defsubst newsticker--echo-area-clean-p ()
 131   "Check whether somebody is using the echo area / minibuffer.
 132 Return t if echo area and minibuffer are unused."
 133   (not (or (active-minibuffer-window)
 134            (and (current-message)
 135                 (not (string= (current-message)
 136                               newsticker--prev-message))))))
 137
 138 (defun newsticker--display-jump ()
 139   "Called from the display timer.
 140 This function displays the next ticker item in the echo area, unless
 141 there is another message displayed or the minibuffer is active."
 142   (let ((message-log-max nil));; prevents message text from being logged
 143     (when (newsticker--echo-area-clean-p)
 144       (setq newsticker--item-position (1+ newsticker--item-position))
 145       (when (>= newsticker--item-position (length newsticker--item-list))
 146         (setq newsticker--item-position 0))
 147       (setq newsticker--prev-message
 148             (nth newsticker--item-position newsticker--item-list))
 149       (message "%s" newsticker--prev-message))))
 150
 151 (defun newsticker--display-scroll ()
 152   "Called from the display timer.
 153 This function scrolls the ticker items in the echo area, unless
 154 there is another message displayed or the minibuffer is active."
 155   (when (newsticker--echo-area-clean-p)
 156     (let* ((width (- (frame-width) 1))
 157            (message-log-max nil);; prevents message text from being logged
 158            (i newsticker--item-position)
 159            subtext
 160            (s-text newsticker--scrollable-text)
 161            (l (length s-text)))
 162       ;; don't show anything if there is nothing to show
 163       (unless (< (length s-text) 1)
 164         ;; repeat the ticker string if it is shorter than frame width
 165         (while (< (length s-text) width)
 166           (setq s-text (concat s-text s-text)))
 167         ;; get the width of the printed string
 168         (setq l (length s-text))
 169         (cond ((< i (- l width))
 170                (setq subtext (substring s-text i (+ i width))))
 171               (t
 172                (setq subtext (concat
 173                               (substring s-text i l)
 174                               (substring s-text 0 (- width (- l i)))))))
 175         ;; Take care of multibyte strings, for which (string-width) is
 176         ;; larger than (length).
 177         ;; Actually, such strings may be smaller than (frame-width)
 178         ;; because return values of (string-width) are too large:
 179         ;; (string-width "<japanese character>") => 2
 180         (let ((t-width (1- (length subtext))))
 181           (while (> (string-width subtext) width)
 182             (setq subtext (substring subtext 0 t-width))
 183             (setq t-width (1- t-width))))
 184         ;; show the ticker text and save current position
 185         (message "%s" subtext)
 186         (setq newsticker--prev-message subtext)
 187         (setq newsticker--item-position (1+ i))
 188         (when (>= newsticker--item-position l)
 189           (setq newsticker--item-position 0))))))
 190
 191 ;;;###autoload
 192 (defun newsticker-start-ticker ()
 193   "Start newsticker's ticker (but not the news retrieval).
 194 Start display timer for the actual ticker if wanted and not
 195 running already."
 196   (interactive)
 197   (if (and (> newsticker-ticker-interval 0)
 198            (not newsticker--ticker-timer))
 199       (setq newsticker--ticker-timer
 200             (run-at-time newsticker-ticker-interval
 201                          newsticker-ticker-interval
 202                          'newsticker--display-tick))))
 203
 204 (defun newsticker-stop-ticker ()
 205   "Stop newsticker's ticker (but not the news retrieval)."
 206   (interactive)
 207   (when newsticker--ticker-timer
 208     (cancel-timer newsticker--ticker-timer)
 209     (setq newsticker--ticker-timer nil)))
 210
 211 ;; ======================================================================
 212 ;;; Manipulation of ticker text
 213 ;; ======================================================================
 214 (defun newsticker--ticker-text-setup ()
 215   "Build the ticker text which is scrolled or flashed in the echo area."
 216   ;; reset scrollable text
 217   (setq newsticker--scrollable-text "")
 218   (setq newsticker--item-list nil)
 219   (setq newsticker--item-position 0)
 220   ;; build scrollable text from cache data
 221   (let ((have-something nil))
 222     (mapc
 223      (lambda (feed)
 224        (let ((feed-name (symbol-name (car feed))))
 225          (let ((num-new (newsticker--stat-num-items (car feed) 'new))
 226                (num-old (newsticker--stat-num-items (car feed) 'old))
 227                (num-imm (newsticker--stat-num-items (car feed) 'immortal))
 228                (num-obs (newsticker--stat-num-items (car feed) 'obsolete)))
 229            (when (or (> num-new 0)
 230                      (and (> num-old 0)
 231                           (not newsticker-hide-old-items-in-echo-area))
 232                      (and (> num-imm 0)
 233                           (not newsticker-hide-immortal-items-in-echo-area))
 234                      (and (> num-obs 0)
 235                           (not newsticker-hide-obsolete-items-in-echo-area)))
 236              (setq have-something t)
 237              (mapc
 238               (lambda (item)
 239                 (let ((title (replace-regexp-in-string
 240                               "[\r\n]+" " "
 241                               (newsticker--title item)))
 242                       (age (newsticker--age item)))
 243                   (unless (string= title newsticker--error-headline)
 244                     (when
 245                         (or (eq age 'new)
 246                             (and (eq age 'old)
 247                                  (not newsticker-hide-old-items-in-echo-area))
 248                             (and (eq age 'obsolete)
 249                                  (not
 250                                   newsticker-hide-obsolete-items-in-echo-area))
 251                             (and (eq age 'immortal)
 252                                  (not
 253                                   newsticker-hide-immortal-items-in-echo-area)))
 254                       (setq title (newsticker--remove-whitespace title))
 255                       ;; add to flash list
 256                       (add-to-list 'newsticker--item-list
 257                                    (concat feed-name ": " title) t)
 258                       ;; and to the scrollable text
 259                       (setq newsticker--scrollable-text
 260                             (concat newsticker--scrollable-text
 261                                     " " feed-name ": " title " +++"))))))
 262                 (cdr feed))))))
 263      newsticker--cache)
 264     (when have-something
 265       (setq newsticker--scrollable-text
 266             (concat "+++ "
 267                     (format-time-string "%A, %H:%M"
 268                                         newsticker--latest-update-time)
 269                     " ++++++" newsticker--scrollable-text)))))
 270
 271 (defun newsticker--ticker-text-remove (feed title)
 272   "Remove the item of FEED with TITLE from the ticker text."
 273   ;; reset scrollable text
 274   (setq newsticker--item-position 0)
 275   (let ((feed-name (symbol-name feed))
 276         (t-title (replace-regexp-in-string "[\r\n]+" " " title)))
 277     ;; remove from flash list
 278     (setq newsticker--item-list (remove (concat feed-name ": " t-title)
 279                                         newsticker--item-list))
 280     ;; and from the scrollable text
 281     (setq newsticker--scrollable-text
 282           (replace-regexp-in-string
 283            (regexp-quote (concat " " feed-name ": " t-title " +++"))
 284            ""
 285            newsticker--scrollable-text))
 286     (if (string-match (concat "^\\+\\+\\+ [A-Z][a-z]+, "
 287                               "[012]?[0-9]:[0-9][0-9] \\+\\+\\+\\+\\+\\+$")
 288                               newsticker--scrollable-text)
 289         (setq newsticker--scrollable-text ""))))
 290
 291 (provide 'newst-ticker)
 292
 293 ;; arch-tag: faee3ebb-749b-4935-9835-7f36d4b700f0
 294 ;;; newst-ticker.el ends here