lisp/net/newst-ticker.el

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