lisp/net/newst-ticker.el

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