aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaroly Lorentey2005-09-17 19:00:49 +0000
committerKaroly Lorentey2005-09-17 19:00:49 +0000
commit567c887847144d9609ccfe550fd7ef178120297a (patch)
treea322ad214ee43847fcd5293f30c7cdac373baf9a
parent262b162ac70eb07d3b9a591acc9d5a6c8ff90177 (diff)
parent115f219da4851988a9eca58bae20257a752a7db3 (diff)
downloademacs-567c887847144d9609ccfe550fd7ef178120297a.tar.gz
emacs-567c887847144d9609ccfe550fd7ef178120297a.zip
Merged from miles@gnu.org--gnu-2005 (patch 543)
Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-543 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-420
Diffstat
-rw-r--r--etc/ChangeLog2
-rw-r--r--lisp/ChangeLog129
-rw-r--r--lisp/calendar/calendar.el68
-rw-r--r--lisp/calendar/diary-lib.el434
-rw-r--r--lisp/custom.el21
-rw-r--r--lisp/faces.el21
-rw-r--r--lisp/files.el6
-rw-r--r--lisp/font-lock.el1
-rw-r--r--lisp/help-fns.el133
-rw-r--r--lisp/mail/sendmail.el18
-rw-r--r--lisp/net/newsticker.el4919
-rw-r--r--lisp/progmodes/compile.el92
-rw-r--r--lisp/time-stamp.el52
-rw-r--r--src/ChangeLog37
-rw-r--r--src/composite.c13
-rw-r--r--src/editfns.c15
-rw-r--r--src/fileio.c8
-rw-r--r--src/keymap.c5
-rw-r--r--src/minibuf.c3
-rw-r--r--src/print.c4
-rw-r--r--src/w32.c4
-rw-r--r--src/xdisp.c12
-rw-r--r--src/xfns.c21
-rw-r--r--src/xterm.h2
24 files changed, 5538 insertions, 482 deletions
diff --git a/etc/ChangeLog b/etc/ChangeLog
index fb751b8ac22..70c90e122c7 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,4 +1,4 @@
12005-09-00 Kevin Ryde <user42@zip.com.au> 12005-09-09 Kevin Ryde <user42@zip.com.au>
2 2
3 * MORE.STUFF: Update url for calculator.el. 3 * MORE.STUFF: Update url for calculator.el.
4 4
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 92b5fc68bfd..2074b5d3f02 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,74 @@
12005-09-13 Chong Yidong <cyd@stupidchicken.com>
2
3 * custom.el (custom-push-theme): Handle the case where a symbol is
4 bound but face properties have not yet been assigned.
5
6 * mail/sendmail.el (mail): Use new buffer if `noerase' argument is
7 `new'.
8
92005-09-12 Richard M. Stallman <rms@gnu.org>
10
11 * font-lock.el (font-lock-keywords): Add autoload.
12
13 * help-fns.el (describe-variable): Rearrange to put source link
14 in a predictable place.
15
16 * net/newsticker.el: New file.
17
182005-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
19
20 * calendar/calendar.el (calendar-for-loop): Add edebug info.
21 (calendar-basic-setup): Use the new nil arg.
22 (number-of-diary-entries): Move to diary-lib.el.
23
24 * calendar/diary-lib.el: Use with-current-buffer, match-string.
25 (diary-list-entries): Use with-syntax-table and dolist.
26 Rename from list-diary-entries.
27 Use number-of-diary-entries if `number' is nil.
28 (diary, diary-view-entries): Use this new name and new nil arg value.
29 (number-of-diary-entries): Move from calendar.el.
30 (diary-unhide-everything): New function.
31 (include-other-diary-files, fancy-diary-display)
32 (diary-show-all-entries, make-diary-entry): Use it.
33 (diary-mail-entries): Use buffer-string.
34 (mark-diary-entries): Fix long standing paren typo.
35 (diary-sexp-entry): Use count-lines.
36 (make-diary-entry): Avoid `previous-line'.
37 (diary-mode-map): New var.
38 (diary-mode): Redraw cal after saving. Setup header-line.
39 (fancy-diary-display-mode): Use local-set-key.
40
41 * startup.el (command-line): Try calling various terminal-init-foo-bar
42 functions by stripping hyphenated suffixes from $TERM.
43
44 * files.el (normal-mode): Check boundness of font-lock-keywords.
45
462005-09-12 Richard M. Stallman <rms@gnu.org>
47
48 * progmodes/compile.el: Don't decide a file's directory
49 until the user actually tries to go there.
50 (compilation-next-error-function):
51 Pass compilation-find-file the directory from the file-struct.
52 (compilation-internal-error-properties): Separate local FILE-STRUCT
53 from FILE. Doc the args better. Rename arg FMT to FMTS.
54 (compilation-find-file): Arg DIR renamed to DIRECTORY.
55 Expand it, and if nil, use default-directory.
56 (compilation-get-file-structure): Don't mix specified directory
57 with default directory. Put specified directory into
58 file-struct. Don't make the file name absolute.
59
60 * progmodes/compile.el (compilation-error-regexp-alist): Doc fix.
61 (compile-command): Add autoload.
62 (compilation-disable-input): Add autoload.
63
642005-09-11 Stephen Gildea <gildea@stop.mail-abuse.org>
65
66 * time-stamp.el: Mention variable `time-stamp-pattern' in doc
67 strings of the variables it can override.
68
69 (time-stamp): New (as yet undocumented) time-stamp-format escapes
70 %Q and %q, for fully-qualified domain name and unqualified host name.
71
12005-09-11 Kim F. Storm <storm@cua.dk> 722005-09-11 Kim F. Storm <storm@cua.dk>
2 73
3 * emacs-lisp/authors.el (authors-aliases): Update list. 74 * emacs-lisp/authors.el (authors-aliases): Update list.
@@ -15,14 +86,14 @@
15 86
162005-09-10 Pascal Dupuis <Pascal.Dupuis@esat.kuleuven.be> (tiny change) 872005-09-10 Pascal Dupuis <Pascal.Dupuis@esat.kuleuven.be> (tiny change)
17 88
18 * progmodes/octave-inf.el (inferior-octave-startup): Resync 89 * progmodes/octave-inf.el (inferior-octave-startup):
19 current dir at the end. 90 Resync current dir at the end.
20 91
212005-09-10 Emilio C. Lopes <eclig@gmx.net> 922005-09-10 Emilio C. Lopes <eclig@gmx.net>
22 93
23 * woman.el (woman-topic-at-point-default): Renamed to 94 * woman.el (woman-topic-at-point-default):
24 woman-use-topic-at-point-default. 95 Rename to woman-use-topic-at-point-default.
25 (woman-topic-at-point): Renamed to woman-use-topic-at-point. 96 (woman-topic-at-point): Rename to woman-use-topic-at-point.
26 (woman-file-name): Reflect renames above. Automatically use the 97 (woman-file-name): Reflect renames above. Automatically use the
27 word at point as topic if woman-use-topic-at-point is non-nil. 98 word at point as topic if woman-use-topic-at-point is non-nil.
28 Otherwise offer it as default but don't insert it in the 99 Otherwise offer it as default but don't insert it in the
@@ -40,28 +111,26 @@
40 (menu-bar-non-minibuffer-window-p): New functions. 111 (menu-bar-non-minibuffer-window-p): New functions.
41 ("Split Window", "Save As..."): Use them. 112 ("Split Window", "Save As..."): Use them.
42 ("Postscript Print Buffer (B+W)", "Postscript Print Buffer") 113 ("Postscript Print Buffer (B+W)", "Postscript Print Buffer")
43 ("Print Buffer", "Truncate Long Lines in this Buffer"): Use 114 ("Print Buffer", "Truncate Long Lines in this Buffer"):
44 menu-bar-menu-frame-live-and-visible-p. 115 Use menu-bar-menu-frame-live-and-visible-p.
45 ("Save Buffer", "Insert File", "Open Directory...") 116 ("Save Buffer", "Insert File", "Open Directory...")
46 ("Open File...", "Visit New File..."): Use 117 ("Open File...", "Visit New File..."):
47 menu-bar-non-minibuffer-window-p. 118 Use menu-bar-non-minibuffer-window-p.
48 (kill-this-buffer-enabled-p, dired <menu-enable>): Use 119 (kill-this-buffer-enabled-p, dired <menu-enable>):
49 menu-bar-non-minibuffer-window-p. 120 Use menu-bar-non-minibuffer-window-p.
50 121
512005-09-09 Eli Zaretskii <eliz@gnu.org> 1222005-09-09 Eli Zaretskii <eliz@gnu.org>
52 123
53 * cus-start.el (all): Don't complain about fringe-related 124 * cus-start.el (all): Don't complain about fringe-related
54 built-ins if fringes are not supported. Ditto about 125 built-ins if fringes are not supported. Ditto about
55 selection-related built-ins. Fix the test for GTK-related 126 selection-related built-ins. Fix the test for GTK-related built-ins.
56 built-ins.
57 127
58 * menu-bar.el ("Split Window", "Postscript Print Buffer (B+W)") 128 * menu-bar.el ("Split Window", "Postscript Print Buffer (B+W)")
59 ("Postscript Print Buffer", "Print Region", "Save As...") 129 ("Postscript Print Buffer", "Print Region", "Save As...")
60 ("Save", "Insert File...", "Open Directory...") 130 ("Save", "Insert File...", "Open Directory...")
61 ("Open File...", "Visit New File..."") 131 ("Open File...", "Visit New File..."")
62 ("Truncate Long Lines in this Buffer"): Don't look at 132 ("Truncate Long Lines in this Buffer"): Don't look at
63 menu-updating-frame if this display does not support multiple 133 menu-updating-frame if this display does not support multiple frames.
64 frames.
65 134
662005-09-09 Frederik Fouvry <fouvry@CoLi.Uni-SB.DE> 1352005-09-09 Frederik Fouvry <fouvry@CoLi.Uni-SB.DE>
67 136
@@ -94,15 +163,6 @@
94 163
95 * descr-text.el (describe-property-list): Handle non-symbol prop names. 164 * descr-text.el (describe-property-list): Handle non-symbol prop names.
96 165
972005-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
98
99 * net/ange-ftp.el (ange-ftp-process-filter): Revert to ^#+$.
100 Use with-current-buffer.
101 (ange-ftp-gwp-start): Remove unused var `gw-user'.
102 (ange-ftp-guess-hash-mark-size): Remove unused var `result'.
103 (ange-ftp-insert-directory): Remove unused var `short'.
104 (ange-ftp-file-name-sans-versions): Remove unused var `host-type'.
105
1062005-08-30 Richard M. Stallman <rms@gnu.org> 1662005-08-30 Richard M. Stallman <rms@gnu.org>
107 167
108 * simple.el (blink-matching-open): Get rid of text props from 168 * simple.el (blink-matching-open): Get rid of text props from
@@ -138,6 +198,13 @@
138 (recentf-open-files): Use it. 198 (recentf-open-files): Use it.
139 (recentf-open-file-with-key): New command. 199 (recentf-open-file-with-key): New command.
140 200
2012005-09-08 Chong Yidong <cyd@stupidchicken.com>
202
203 * buff-menu.el (Buffer-menu-sort-by-column): New function.
204 Suggested by Kim F. Storm.
205 (Buffer-menu-sort-button-map): Global keymap for sort buttons.
206 (Buffer-menu-make-sort-button): Use global keymap.
207
1412005-09-07 Michael Albinus <michael.albinus@gmx.de> 2082005-09-07 Michael Albinus <michael.albinus@gmx.de>
142 209
143 * woman.el (top): Remap `man' command by `woman' in `woman-mode-map'. 210 * woman.el (top): Remap `man' command by `woman' in `woman-mode-map'.
@@ -163,15 +230,15 @@
163 * calc/calc-poly.el (math-expand-term): Multiply out any powers 230 * calc/calc-poly.el (math-expand-term): Multiply out any powers
164 when in matrix mode. 231 when in matrix mode.
165 232
1662005-09-08 Chong Yidong <cyd@stupidchicken.com>
167
168 * buff-menu.el (Buffer-menu-sort-by-column): New function.
169 Suggested by Kim F. Storm.
170 (Buffer-menu-sort-button-map): Global keymap for sort buttons.
171 (Buffer-menu-make-sort-button): Use global keymap.
172
1732005-09-06 Stefan Monnier <monnier@iro.umontreal.ca> 2332005-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
174 234
235 * net/ange-ftp.el (ange-ftp-process-filter): Revert to ^#+$.
236 Use with-current-buffer.
237 (ange-ftp-gwp-start): Remove unused var `gw-user'.
238 (ange-ftp-guess-hash-mark-size): Remove unused var `result'.
239 (ange-ftp-insert-directory): Remove unused var `short'.
240 (ange-ftp-file-name-sans-versions): Remove unused var `host-type'.
241
175 * buff-menu.el (Buffer-menu-make-sort-button): Add docstrings, use 242 * buff-menu.el (Buffer-menu-make-sort-button): Add docstrings, use
176 non-anonymous functions. 243 non-anonymous functions.
177 244
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 3e075b9d6bd..2d2e5256977 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -164,35 +164,6 @@ be overridden by the value of `calendar-setup'."
164 :group 'diary) 164 :group 'diary)
165 165
166;;;###autoload 166;;;###autoload
167(defcustom number-of-diary-entries 1
168 "*Specifies how many days of diary entries are to be displayed initially.
169This variable affects the diary display when the command \\[diary] is used,
170or if the value of the variable `view-diary-entries-initially' is t. For
171example, if the default value 1 is used, then only the current day's diary
172entries will be displayed. If the value 2 is used, then both the current
173day's and the next day's entries will be displayed.
174
175The value can also be a vector such as [0 2 2 2 2 4 1]; this value
176says to display no diary entries on Sunday, the display the entries
177for the current date and the day after on Monday through Thursday,
178display Friday through Monday's entries on Friday, and display only
179Saturday's entries on Saturday.
180
181This variable does not affect the diary display with the `d' command
182from the calendar; in that case, the prefix argument controls the
183number of days of diary entries displayed."
184 :type '(choice (integer :tag "Entries")
185 (vector :value [0 0 0 0 0 0 0]
186 (integer :tag "Sunday")
187 (integer :tag "Monday")
188 (integer :tag "Tuesday")
189 (integer :tag "Wednesday")
190 (integer :tag "Thursday")
191 (integer :tag "Friday")
192 (integer :tag "Saturday")))
193 :group 'diary)
194
195;;;###autoload
196(defcustom mark-diary-entries-in-calendar nil 167(defcustom mark-diary-entries-in-calendar nil
197 "*Non-nil means mark dates with diary entries, in the calendar window. 168 "*Non-nil means mark dates with diary entries, in the calendar window.
198The marking symbol is specified by the variable `diary-entry-marker'." 169The marking symbol is specified by the variable `diary-entry-marker'."
@@ -393,7 +364,7 @@ functions that move by days and weeks."
393 364
394For example, 365For example,
395 366
396 (add-hook 'calendar-move-hook (lambda () (view-diary-entries 1))) 367 (add-hook 'calendar-move-hook (lambda () (diary-view-entries 1)))
397 368
398redisplays the diary for whatever date the cursor is moved to." 369redisplays the diary for whatever date the cursor is moved to."
399 :type 'hook 370 :type 'hook
@@ -1335,6 +1306,7 @@ A negative YR is interpreted as BC; -1 being 1 BC, and so on."
1335 1306
1336(defmacro calendar-for-loop (var from init to final do &rest body) 1307(defmacro calendar-for-loop (var from init to final do &rest body)
1337 "Execute a for loop." 1308 "Execute a for loop."
1309 (declare (debug (symbolp "from" form "to" form "do" body)))
1338 `(let ((,var (1- ,init))) 1310 `(let ((,var (1- ,init)))
1339 (while (>= ,final (setq ,var (1+ ,var))) 1311 (while (>= ,final (setq ,var (1+ ,var)))
1340 ,@body))) 1312 ,@body)))
@@ -1651,10 +1623,7 @@ to be replaced by asterisks to highlight it whenever it is in the window."
1651 (increment-calendar-month month year (- calendar-offset)) 1623 (increment-calendar-month month year (- calendar-offset))
1652 (generate-calendar-window month year) 1624 (generate-calendar-window month year)
1653 (if (and view-diary-entries-initially (calendar-date-is-visible-p date)) 1625 (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
1654 (view-diary-entries 1626 (diary-view-entries)))
1655 (if (vectorp number-of-diary-entries)
1656 (aref number-of-diary-entries (calendar-day-of-week date))
1657 number-of-diary-entries))))
1658 (let* ((diary-buffer (get-file-buffer diary-file)) 1627 (let* ((diary-buffer (get-file-buffer diary-file))
1659 (diary-window (if diary-buffer (get-buffer-window diary-buffer))) 1628 (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
1660 (split-height-threshold (if diary-window 2 1000))) 1629 (split-height-threshold (if diary-window 2 1000)))
@@ -1662,7 +1631,7 @@ to be replaced by asterisks to highlight it whenever it is in the window."
1662 (list-calendar-holidays))) 1631 (list-calendar-holidays)))
1663 (run-hooks 'initial-calendar-window-hook)) 1632 (run-hooks 'initial-calendar-window-hook))
1664 1633
1665(autoload 'view-diary-entries "diary-lib" 1634(autoload 'diary-view-entries "diary-lib"
1666 "Prepare and display a buffer with diary entries. 1635 "Prepare and display a buffer with diary entries.
1667Searches your diary file for entries that match ARG days starting with 1636Searches your diary file for entries that match ARG days starting with
1668the date indicated by the cursor position in the displayed three-month 1637the date indicated by the cursor position in the displayed three-month
@@ -2272,7 +2241,7 @@ movement commands will not work correctly."
2272 (define-key calendar-mode-map "x" 'mark-calendar-holidays) 2241 (define-key calendar-mode-map "x" 'mark-calendar-holidays)
2273 (define-key calendar-mode-map "u" 'calendar-unmark) 2242 (define-key calendar-mode-map "u" 'calendar-unmark)
2274 (define-key calendar-mode-map "m" 'mark-diary-entries) 2243 (define-key calendar-mode-map "m" 'mark-diary-entries)
2275 (define-key calendar-mode-map "d" 'view-diary-entries) 2244 (define-key calendar-mode-map "d" 'diary-view-entries)
2276 (define-key calendar-mode-map "D" 'view-other-diary-entries) 2245 (define-key calendar-mode-map "D" 'view-other-diary-entries)
2277 (define-key calendar-mode-map "s" 'show-all-diary-entries) 2246 (define-key calendar-mode-map "s" 'show-all-diary-entries)
2278 (define-key calendar-mode-map "pd" 'calendar-print-day-of-year) 2247 (define-key calendar-mode-map "pd" 'calendar-print-day-of-year)
@@ -2493,8 +2462,7 @@ the STRINGS are just concatenated and the result truncated."
2493(defun update-calendar-mode-line () 2462(defun update-calendar-mode-line ()
2494 "Update the calendar mode line with the current date and date style." 2463 "Update the calendar mode line with the current date and date style."
2495 (if (bufferp (get-buffer calendar-buffer)) 2464 (if (bufferp (get-buffer calendar-buffer))
2496 (save-excursion 2465 (with-current-buffer calendar-buffer
2497 (set-buffer calendar-buffer)
2498 (setq mode-line-format 2466 (setq mode-line-format
2499 (calendar-string-spread 2467 (calendar-string-spread
2500 (let ((date (condition-case nil 2468 (let ((date (condition-case nil
@@ -2589,14 +2557,15 @@ ERROR is t, otherwise just returns nil."
2589 (list month 2557 (list month
2590 (string-to-number (buffer-substring (1+ (point)) (+ 4 (point)))) 2558 (string-to-number (buffer-substring (1+ (point)) (+ 4 (point))))
2591 year)) 2559 year))
2592 (if (looking-at "\\*") 2560 (if (and (looking-at "\\*")
2593 (save-excursion 2561 (save-excursion
2594 (re-search-backward "[^*]") 2562 (re-search-backward "[^*]")
2595 (if (looking-at ".\\*\\*") 2563 (looking-at ".\\*\\*")))
2596 (list month calendar-starred-day year) 2564 (list month calendar-starred-day year)
2597 (if error (error "Not on a date!"))))
2598 (if error (error "Not on a date!")))))) 2565 (if error (error "Not on a date!"))))))
2599 2566
2567(add-to-list 'debug-ignored-errors "Not on a date!")
2568
2600;; The following version of calendar-gregorian-from-absolute is preferred for 2569;; The following version of calendar-gregorian-from-absolute is preferred for
2601;; reasons of clarity, BUT it's much slower than the version that follows it. 2570;; reasons of clarity, BUT it's much slower than the version that follows it.
2602 2571
@@ -3071,8 +3040,7 @@ Defaults to today's date if DATE is not given."
3071 "Show dates on other calendars for date under the cursor." 3040 "Show dates on other calendars for date under the cursor."
3072 (interactive) 3041 (interactive)
3073 (let* ((date (calendar-cursor-to-date t))) 3042 (let* ((date (calendar-cursor-to-date t)))
3074 (save-excursion 3043 (with-current-buffer (get-buffer-create other-calendars-buffer)
3075 (set-buffer (get-buffer-create other-calendars-buffer))
3076 (setq buffer-read-only nil) 3044 (setq buffer-read-only nil)
3077 (calendar-set-mode-line 3045 (calendar-set-mode-line
3078 (concat (calendar-date-string date) " (Gregorian)")) 3046 (concat (calendar-date-string date) " (Gregorian)"))
@@ -3138,9 +3106,9 @@ Defaults to today's date if DATE is not given."
3138 3106
3139(provide 'calendar) 3107(provide 'calendar)
3140 3108
3141;;; Local variables: 3109;; Local variables:
3142;;; byte-compile-dynamic: t 3110;; byte-compile-dynamic: t
3143;;; End: 3111;; End:
3144 3112
3145;;; arch-tag: 19c61596-c8fb-4c69-bcf1-7dd739919cd8 3113;; arch-tag: 19c61596-c8fb-4c69-bcf1-7dd739919cd8
3146;;; calendar.el ends here 3114;;; calendar.el ends here
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 1501131c2ae..b35b7287a44 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -58,21 +58,17 @@ does nothing. This function is suitable for execution in a `.emacs' file."
58 (interactive "P") 58 (interactive "P")
59 (diary-check-diary-file) 59 (diary-check-diary-file)
60 (let ((date (calendar-current-date))) 60 (let ((date (calendar-current-date)))
61 (list-diary-entries 61 (diary-list-entries date (if arg (prefix-numeric-value arg)))))
62 date 62
63 (cond (arg (prefix-numeric-value arg)) 63(define-obsolete-function-alias 'view-diary-entries 'diary-view-entries)
64 ((vectorp number-of-diary-entries) 64(defun diary-view-entries (&optional arg)
65 (aref number-of-diary-entries (calendar-day-of-week date)))
66 (t number-of-diary-entries)))))
67
68(defun view-diary-entries (arg)
69 "Prepare and display a buffer with diary entries. 65 "Prepare and display a buffer with diary entries.
70Searches the file named in `diary-file' for entries that 66Searches the file named in `diary-file' for entries that
71match ARG days starting with the date indicated by the cursor position 67match ARG days starting with the date indicated by the cursor position
72in the displayed three-month calendar." 68in the displayed three-month calendar."
73 (interactive "p") 69 (interactive "p")
74 (diary-check-diary-file) 70 (diary-check-diary-file)
75 (list-diary-entries (calendar-cursor-to-date t) arg)) 71 (diary-list-entries (calendar-cursor-to-date t) arg))
76 72
77(defun view-other-diary-entries (arg d-file) 73(defun view-other-diary-entries (arg d-file)
78 "Prepare and display buffer of diary entries from an alternative diary file. 74 "Prepare and display buffer of diary entries from an alternative diary file.
@@ -182,14 +178,15 @@ The holidays are those in the list `calendar-holidays'.")
182 "Local time of candle lighting diary entry--applies if date is a Friday. 178 "Local time of candle lighting diary entry--applies if date is a Friday.
183No diary entry if there is no sunset on that date.") 179No diary entry if there is no sunset on that date.")
184 180
185(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table)) 181(defvar diary-syntax-table
182 (let ((st (copy-syntax-table (standard-syntax-table))))
183 (modify-syntax-entry ?* "w" st)
184 (modify-syntax-entry ?: "w" st)
185 st)
186 "The syntax table used when parsing dates in the diary file. 186 "The syntax table used when parsing dates in the diary file.
187It is the standard syntax table used in Fundamental mode, but with the 187It is the standard syntax table used in Fundamental mode, but with the
188syntax of `*' and `:' changed to be word constituents.") 188syntax of `*' and `:' changed to be word constituents.")
189 189
190(modify-syntax-entry ?* "w" diary-syntax-table)
191(modify-syntax-entry ?: "w" diary-syntax-table)
192
193(defvar diary-entries-list) 190(defvar diary-entries-list)
194(defvar displayed-year) 191(defvar displayed-year)
195(defvar displayed-month) 192(defvar displayed-month)
@@ -243,9 +240,7 @@ search."
243 regexp (concat diary-glob-file-regexp-prefix regexp)) 240 regexp (concat diary-glob-file-regexp-prefix regexp))
244 (setq attrvalue nil) 241 (setq attrvalue nil)
245 (if (re-search-forward regexp (point-max) t) 242 (if (re-search-forward regexp (point-max) t)
246 (setq attrvalue (buffer-substring-no-properties 243 (setq attrvalue (match-string-no-properties regnum)))
247 (match-beginning regnum)
248 (match-end regnum))))
249 (if (and attrvalue 244 (if (and attrvalue
250 (setq attrvalue (diary-attrtype-convert attrvalue type))) 245 (setq attrvalue (diary-attrtype-convert attrvalue type)))
251 (setq ret-attr (append ret-attr (list attrname attrvalue)))) 246 (setq ret-attr (append ret-attr (list attrname attrvalue))))
@@ -264,9 +259,7 @@ search."
264 (setq attrvalue nil) 259 (setq attrvalue nil)
265 (if (string-match regexp entry) 260 (if (string-match regexp entry)
266 (progn 261 (progn
267 (setq attrvalue (substring-no-properties entry 262 (setq attrvalue (match-string-no-properties regnum entry))
268 (match-beginning regnum)
269 (match-end regnum)))
270 (setq entry (replace-match "" t t entry)))) 263 (setq entry (replace-match "" t t entry))))
271 (if (and attrvalue 264 (if (and attrvalue
272 (setq attrvalue (diary-attrtype-convert attrvalue type))) 265 (setq attrvalue (diary-attrtype-convert attrvalue type)))
@@ -299,8 +292,38 @@ Only used if `diary-header-line-flag' is non-nil."
299 292
300(defvar diary-saved-point) ; internal 293(defvar diary-saved-point) ; internal
301 294
302(defun list-diary-entries (date number) 295
303 "Create and display a buffer containing the relevant lines in diary-file. 296(defcustom number-of-diary-entries 1
297 "Specifies how many days of diary entries are to be displayed initially.
298This variable affects the diary display when the command \\[diary] is used,
299or if the value of the variable `view-diary-entries-initially' is t. For
300example, if the default value 1 is used, then only the current day's diary
301entries will be displayed. If the value 2 is used, then both the current
302day's and the next day's entries will be displayed.
303
304The value can also be a vector such as [0 2 2 2 2 4 1]; this value
305says to display no diary entries on Sunday, the display the entries
306for the current date and the day after on Monday through Thursday,
307display Friday through Monday's entries on Friday, and display only
308Saturday's entries on Saturday.
309
310This variable does not affect the diary display with the `d' command
311from the calendar; in that case, the prefix argument controls the
312number of days of diary entries displayed."
313 :type '(choice (integer :tag "Entries")
314 (vector :value [0 0 0 0 0 0 0]
315 (integer :tag "Sunday")
316 (integer :tag "Monday")
317 (integer :tag "Tuesday")
318 (integer :tag "Wednesday")
319 (integer :tag "Thursday")
320 (integer :tag "Friday")
321 (integer :tag "Saturday")))
322 :group 'diary)
323
324(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries)
325(defun diary-list-entries (date number)
326 "Create and display a buffer containing the relevant lines in `diary-file'.
304The arguments are DATE and NUMBER; the entries selected are those 327The arguments are DATE and NUMBER; the entries selected are those
305for NUMBER days starting with date DATE. The other entries are hidden 328for NUMBER days starting with date DATE. The other entries are hidden
306using selective display. If NUMBER is less than 1, this function does nothing. 329using selective display. If NUMBER is less than 1, this function does nothing.
@@ -332,10 +355,12 @@ These hooks have the following distinct roles:
332 355
333 `diary-hook' is run last. This can be used for an appointment 356 `diary-hook' is run last. This can be used for an appointment
334 notification function." 357 notification function."
335 358 (unless number
359 (setq number (if (vectorp number-of-diary-entries)
360 (aref number-of-diary-entries (calendar-day-of-week date))
361 number-of-diary-entries)))
336 (when (> number 0) 362 (when (> number 0)
337 (let ((original-date date);; save for possible use in the hooks 363 (let ((original-date date);; save for possible use in the hooks
338 old-diary-syntax-table
339 diary-entries-list 364 diary-entries-list
340 file-glob-attrs 365 file-glob-attrs
341 (date-string (calendar-date-string date)) 366 (date-string (calendar-date-string date))
@@ -356,100 +381,94 @@ These hooks have the following distinct roles:
356 (setq selective-display-ellipses nil) 381 (setq selective-display-ellipses nil)
357 (if diary-header-line-flag 382 (if diary-header-line-flag
358 (setq header-line-format diary-header-line-format)) 383 (setq header-line-format diary-header-line-format))
359 (setq old-diary-syntax-table (syntax-table)) 384 (with-syntax-table diary-syntax-table
360 (set-syntax-table diary-syntax-table) 385 (let ((buffer-read-only nil)
361 (unwind-protect 386 (diary-modified (buffer-modified-p))
362 (let ((buffer-read-only nil) 387 (mark (regexp-quote diary-nonmarking-symbol)))
363 (diary-modified (buffer-modified-p)) 388 ;; First and last characters must be ^M or \n for
364 (mark (regexp-quote diary-nonmarking-symbol))) 389 ;; selective display to work properly
365 ;; First and last characters must be ^M or \n for 390 (goto-char (1- (point-max)))
366 ;; selective display to work properly 391 (if (not (looking-at "\^M\\|\n"))
367 (goto-char (1- (point-max))) 392 (progn
368 (if (not (looking-at "\^M\\|\n")) 393 (goto-char (point-max))
369 (progn 394 (insert "\^M")))
370 (goto-char (point-max)) 395 (goto-char (point-min))
371 (insert "\^M"))) 396 (if (not (looking-at "\^M\\|\n"))
372 (goto-char (point-min)) 397 (insert "\^M"))
373 (if (not (looking-at "\^M\\|\n")) 398 (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
374 (insert "\^M")) 399 (calendar-for-loop
375 (subst-char-in-region (point-min) (point-max) ?\n ?\^M t) 400 i from 1 to number do
376 (calendar-for-loop 401 (let ((month (extract-calendar-month date))
377 i from 1 to number do 402 (day (extract-calendar-day date))
378 (let ((d diary-date-forms) 403 (year (extract-calendar-year date))
379 (month (extract-calendar-month date)) 404 (entry-found (list-sexp-diary-entries date)))
380 (day (extract-calendar-day date)) 405 (dolist (date-form diary-date-forms)
381 (year (extract-calendar-year date)) 406 (let*
382 (entry-found (list-sexp-diary-entries date))) 407 ((backup (when (eq (car date-form) 'backup)
383 (while d 408 (setq date-form (cdr date-form))
384 (let* 409 t))
385 ((date-form (if (equal (car (car d)) 'backup) 410 (dayname
386 (cdr (car d)) 411 (format "%s\\|%s\\.?"
387 (car d))) 412 (calendar-day-name date)
388 (backup (equal (car (car d)) 'backup)) 413 (calendar-day-name date 'abbrev)))
389 (dayname 414 (monthname
390 (format "%s\\|%s\\.?" 415 (format "\\*\\|%s\\|%s\\.?"
391 (calendar-day-name date) 416 (calendar-month-name month)
392 (calendar-day-name date 'abbrev))) 417 (calendar-month-name month 'abbrev)))
393 (monthname 418 (month (concat "\\*\\|0*" (int-to-string month)))
394 (format "\\*\\|%s\\|%s\\.?" 419 (day (concat "\\*\\|0*" (int-to-string day)))
395 (calendar-month-name month) 420 (year
396 (calendar-month-name month 'abbrev))) 421 (concat
397 (month (concat "\\*\\|0*" (int-to-string month))) 422 "\\*\\|0*" (int-to-string year)
398 (day (concat "\\*\\|0*" (int-to-string day))) 423 (if abbreviated-calendar-year
399 (year 424 (concat "\\|" (format "%02d" (% year 100)))
400 (concat 425 "")))
401 "\\*\\|0*" (int-to-string year) 426 (regexp
402 (if abbreviated-calendar-year 427 (concat
403 (concat "\\|" (format "%02d" (% year 100))) 428 "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
404 ""))) 429 (mapconcat 'eval date-form "\\)\\(")
405 (regexp 430 "\\)"))
406 (concat 431 (case-fold-search t))
407 "\\(\\`\\|\^M\\|\n\\)" mark "?\\(" 432 (goto-char (point-min))
408 (mapconcat 'eval date-form "\\)\\(") 433 (while (re-search-forward regexp nil t)
409 "\\)")) 434 (if backup (re-search-backward "\\<" nil t))
410 (case-fold-search t)) 435 (if (and (or (char-equal (preceding-char) ?\^M)
411 (goto-char (point-min)) 436 (char-equal (preceding-char) ?\n))
412 (while (re-search-forward regexp nil t) 437 (not (looking-at " \\|\^I")))
413 (if backup (re-search-backward "\\<" nil t)) 438 ;; Diary entry that consists only of date.
414 (if (and (or (char-equal (preceding-char) ?\^M) 439 (backward-char 1)
415 (char-equal (preceding-char) ?\n)) 440 ;; Found a nonempty diary entry--make it
416 (not (looking-at " \\|\^I"))) 441 ;; visible and add it to the list.
417 ;; Diary entry that consists only of date. 442 (setq entry-found t)
418 (backward-char 1) 443 (let ((entry-start (point))
419 ;; Found a nonempty diary entry--make it 444 date-start temp)
420 ;; visible and add it to the list. 445 (re-search-backward "\^M\\|\n\\|\\`")
421 (setq entry-found t) 446 (setq date-start (point))
422 (let ((entry-start (point)) 447 (re-search-forward "\^M\\|\n" nil t 2)
423 date-start temp) 448 (while (looking-at " \\|\^I")
424 (re-search-backward "\^M\\|\n\\|\\`") 449 (re-search-forward "\^M\\|\n" nil t))
425 (setq date-start (point)) 450 (backward-char 1)
426 (re-search-forward "\^M\\|\n" nil t 2) 451 (subst-char-in-region date-start
427 (while (looking-at " \\|\^I") 452 (point) ?\^M ?\n t)
428 (re-search-forward "\^M\\|\n" nil t)) 453 (setq entry (buffer-substring entry-start (point))
429 (backward-char 1) 454 temp (diary-pull-attrs entry file-glob-attrs)
430 (subst-char-in-region date-start 455 entry (nth 0 temp))
431 (point) ?\^M ?\n t) 456 (add-to-diary-list
432 (setq entry (buffer-substring entry-start (point)) 457 date
433 temp (diary-pull-attrs entry file-glob-attrs) 458 entry
434 entry (nth 0 temp)) 459 (buffer-substring
435 (add-to-diary-list 460 (1+ date-start) (1- entry-start))
436 date 461 (copy-marker entry-start) (nth 1 temp)))))))
437 entry 462 (or entry-found
438 (buffer-substring 463 (not diary-list-include-blanks)
439 (1+ date-start) (1- entry-start)) 464 (setq diary-entries-list
440 (copy-marker entry-start) (nth 1 temp)))))) 465 (append diary-entries-list
441 (setq d (cdr d))) 466 (list (list date "" "" "" "")))))
442 (or entry-found 467 (setq date
443 (not diary-list-include-blanks) 468 (calendar-gregorian-from-absolute
444 (setq diary-entries-list 469 (1+ (calendar-absolute-from-gregorian date))))
445 (append diary-entries-list 470 (setq entry-found nil)))
446 (list (list date "" "" "" ""))))) 471 (set-buffer-modified-p diary-modified)))
447 (setq date
448 (calendar-gregorian-from-absolute
449 (1+ (calendar-absolute-from-gregorian date))))
450 (setq entry-found nil)))
451 (set-buffer-modified-p diary-modified))
452 (set-syntax-table old-diary-syntax-table))
453 (goto-char (point-min)) 472 (goto-char (point-min))
454 (run-hooks 'nongregorian-diary-listing-hook 473 (run-hooks 'nongregorian-diary-listing-hook
455 'list-diary-entries-hook) 474 'list-diary-entries-hook)
@@ -459,6 +478,14 @@ These hooks have the following distinct roles:
459 (run-hooks 'diary-hook) 478 (run-hooks 'diary-hook)
460 diary-entries-list)))))) 479 diary-entries-list))))))
461 480
481(defun diary-unhide-everything ()
482 (setq selective-display nil)
483 (let ((inhibit-read-only t)
484 (modified (buffer-modified-p)))
485 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
486 (set-buffer-modified-p modified))
487 (kill-local-variable 'mode-line-format))
488
462(defun include-other-diary-files () 489(defun include-other-diary-files ()
463 "Include the diary entries from other diary files with those of diary-file. 490 "Include the diary entries from other diary files with those of diary-file.
464This function is suitable for use in `list-diary-entries-hook'; 491This function is suitable for use in `list-diary-entries-hook';
@@ -471,34 +498,24 @@ changing the variable `diary-include-string'."
471 (goto-char (point-min)) 498 (goto-char (point-min))
472 (while (re-search-forward 499 (while (re-search-forward
473 (concat 500 (concat
474 "\\(\\`\\|\^M\\|\n\\)" 501 "\\(?:\\`\\|\^M\\|\n\\)"
475 (regexp-quote diary-include-string) 502 (regexp-quote diary-include-string)
476 " \"\\([^\"]*\\)\"") 503 " \"\\([^\"]*\\)\"")
477 nil t) 504 nil t)
478 (let* ((diary-file (substitute-in-file-name 505 (let* ((diary-file (substitute-in-file-name
479 (buffer-substring-no-properties 506 (match-string-no-properties 1)))
480 (match-beginning 2) (match-end 2))))
481 (diary-list-include-blanks nil) 507 (diary-list-include-blanks nil)
482 (list-diary-entries-hook 'include-other-diary-files) 508 (list-diary-entries-hook 'include-other-diary-files)
483 (diary-display-hook 'ignore) 509 (diary-display-hook 'ignore)
484 (diary-hook nil) 510 (diary-hook nil))
485 (d-buffer (find-buffer-visiting diary-file))
486 (diary-modified (if d-buffer
487 (save-excursion
488 (set-buffer d-buffer)
489 (buffer-modified-p)))))
490 (if (file-exists-p diary-file) 511 (if (file-exists-p diary-file)
491 (if (file-readable-p diary-file) 512 (if (file-readable-p diary-file)
492 (unwind-protect 513 (unwind-protect
493 (setq diary-entries-list 514 (setq diary-entries-list
494 (append diary-entries-list 515 (append diary-entries-list
495 (list-diary-entries original-date number))) 516 (list-diary-entries original-date number)))
496 (save-excursion 517 (with-current-buffer (find-buffer-visiting diary-file)
497 (set-buffer (find-buffer-visiting diary-file)) 518 (diary-unhide-everything)))
498 (let ((inhibit-read-only t))
499 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))
500 (setq selective-display nil)
501 (set-buffer-modified-p diary-modified)))
502 (beep) 519 (beep)
503 (message "Can't read included diary file %s" diary-file) 520 (message "Can't read included diary file %s" diary-file)
504 (sleep-for 2)) 521 (sleep-for 2))
@@ -564,13 +581,9 @@ changing the variable `diary-include-string'."
564(defun fancy-diary-display () 581(defun fancy-diary-display ()
565 "Prepare a diary buffer with relevant entries in a fancy, noneditable form. 582 "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
566This function is provided for optional use as the `diary-display-hook'." 583This function is provided for optional use as the `diary-display-hook'."
567 (save-excursion;; Turn off selective-display in the diary file's buffer. 584 (with-current-buffer ;; Turn off selective-display in the diary file's buffer.
568 (set-buffer (find-buffer-visiting (substitute-in-file-name diary-file))) 585 (find-buffer-visiting (substitute-in-file-name diary-file))
569 (let ((diary-modified (buffer-modified-p))) 586 (diary-unhide-everything))
570 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
571 (setq selective-display nil)
572 (kill-local-variable 'mode-line-format)
573 (set-buffer-modified-p diary-modified)))
574 (if (or (not diary-entries-list) 587 (if (or (not diary-entries-list)
575 (and (not (cdr diary-entries-list)) 588 (and (not (cdr diary-entries-list))
576 (string-equal (car (cdr (car diary-entries-list))) ""))) 589 (string-equal (car (cdr (car diary-entries-list))) "")))
@@ -740,7 +753,8 @@ the actual printing."
740 (kill-buffer temp-buffer))) 753 (kill-buffer temp-buffer)))
741 (error "You don't have a diary buffer!"))))) 754 (error "You don't have a diary buffer!")))))
742 755
743(defun show-all-diary-entries () 756(define-obsolete-function-alias 'show-all-diary-entries 'diary-show-all-entries)
757(defun diary-show-all-entries ()
744 "Show all of the diary entries in the diary file. 758 "Show all of the diary entries in the diary file.
745This function gets rid of the selective display of the diary file so that 759This function gets rid of the selective display of the diary file so that
746all entries, not just some, are visible. If there is no diary buffer, one 760all entries, not just some, are visible. If there is no diary buffer, one
@@ -748,16 +762,9 @@ is created."
748 (interactive) 762 (interactive)
749 (let ((d-file (diary-check-diary-file)) 763 (let ((d-file (diary-check-diary-file))
750 (pop-up-frames (window-dedicated-p (selected-window)))) 764 (pop-up-frames (window-dedicated-p (selected-window))))
751 (save-excursion 765 (with-current-buffer (or (find-buffer-visiting d-file)
752 (set-buffer (or (find-buffer-visiting d-file) 766 (find-file-noselect d-file t))
753 (find-file-noselect d-file t))) 767 (diary-unhide-everything))))
754 (let ((buffer-read-only nil)
755 (diary-modified (buffer-modified-p)))
756 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
757 (setq selective-display nil
758 mode-line-format default-mode-line-format)
759 (display-buffer (current-buffer))
760 (set-buffer-modified-p diary-modified)))))
761 768
762(defcustom diary-mail-addr 769(defcustom diary-mail-addr
763 (if (boundp 'user-mail-address) user-mail-address "") 770 (if (boundp 'user-mail-address) user-mail-address "")
@@ -807,9 +814,7 @@ to run it every morning at 1am."
807 (calendar-date-string (calendar-current-date)))) 814 (calendar-date-string (calendar-current-date))))
808 (insert 815 (insert
809 (if (get-buffer fancy-diary-buffer) 816 (if (get-buffer fancy-diary-buffer)
810 (save-excursion 817 (with-current-buffer fancy-diary-buffer (buffer-string))
811 (set-buffer fancy-diary-buffer)
812 (buffer-substring (point-min) (point-max)))
813 "No entries found")) 818 "No entries found"))
814 (call-interactively (get mail-user-agent 'sendfunc)))) 819 (call-interactively (get mail-user-agent 'sendfunc))))
815 820
@@ -844,7 +849,7 @@ marked. After the entries are marked, the hooks
844`nongregorian-diary-marking-hook' and `mark-diary-entries-hook' 849`nongregorian-diary-marking-hook' and `mark-diary-entries-hook'
845are run. If the optional argument REDRAW is non-nil (which is 850are run. If the optional argument REDRAW is non-nil (which is
846the case interactively, for example) then any existing diary 851the case interactively, for example) then any existing diary
847marks are first removed. This is intended to deal with deleted 852marks are first removed. This is intended to deal with deleted
848diary entries." 853diary entries."
849 (interactive "p") 854 (interactive "p")
850 ;; To remove any deleted diary entries. Do not redraw when: 855 ;; To remove any deleted diary entries. Do not redraw when:
@@ -858,8 +863,7 @@ diary entries."
858 (redraw-calendar)) 863 (redraw-calendar))
859 (let ((marking-diary-entries t) 864 (let ((marking-diary-entries t)
860 file-glob-attrs marks) 865 file-glob-attrs marks)
861 (save-excursion 866 (with-current-buffer (find-file-noselect (diary-check-diary-file) t)
862 (set-buffer (find-file-noselect (diary-check-diary-file) t))
863 (setq mark-diary-entries-in-calendar t) 867 (setq mark-diary-entries-in-calendar t)
864 (message "Marking diary entries...") 868 (message "Marking diary entries...")
865 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) 869 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
@@ -902,30 +906,20 @@ diary entries."
902 (while (re-search-forward regexp nil t) 906 (while (re-search-forward regexp nil t)
903 (let* ((dd-name 907 (let* ((dd-name
904 (if d-name-pos 908 (if d-name-pos
905 (buffer-substring-no-properties 909 (match-string-no-properties d-name-pos)))
906 (match-beginning d-name-pos)
907 (match-end d-name-pos))))
908 (mm-name 910 (mm-name
909 (if m-name-pos 911 (if m-name-pos
910 (buffer-substring-no-properties 912 (match-string-no-properties m-name-pos)))
911 (match-beginning m-name-pos)
912 (match-end m-name-pos))))
913 (mm (string-to-number 913 (mm (string-to-number
914 (if m-pos 914 (if m-pos
915 (buffer-substring-no-properties 915 (match-string-no-properties m-pos)
916 (match-beginning m-pos)
917 (match-end m-pos))
918 ""))) 916 "")))
919 (dd (string-to-number 917 (dd (string-to-number
920 (if d-pos 918 (if d-pos
921 (buffer-substring-no-properties 919 (match-string-no-properties d-pos)
922 (match-beginning d-pos)
923 (match-end d-pos))
924 ""))) 920 "")))
925 (y-str (if y-pos 921 (y-str (if y-pos
926 (buffer-substring-no-properties 922 (match-string-no-properties y-pos)))
927 (match-beginning y-pos)
928 (match-end y-pos))))
929 (yy (if (not y-str) 923 (yy (if (not y-str)
930 0 924 0
931 (if (and (= (length y-str) 2) 925 (if (and (= (length y-str) 2)
@@ -941,13 +935,13 @@ diary entries."
941 (if (> (- current-y y) 50) 935 (if (> (- current-y y) 50)
942 (+ y 100) 936 (+ y 100)
943 y))) 937 y)))
944 (string-to-number y-str)))) 938 (string-to-number y-str)))))
945 (save-excursion 939 (save-excursion
946 (setq entry (buffer-substring-no-properties 940 (setq entry (buffer-substring-no-properties
947 (point) (line-end-position)) 941 (point) (line-end-position))
948 temp (diary-pull-attrs entry file-glob-attrs) 942 temp (diary-pull-attrs entry file-glob-attrs)
949 entry (nth 0 temp) 943 entry (nth 0 temp)
950 marks (nth 1 temp)))) 944 marks (nth 1 temp)))
951 (if dd-name 945 (if dd-name
952 (mark-calendar-days-named 946 (mark-calendar-days-named
953 (cdr (assoc-string 947 (cdr (assoc-string
@@ -982,8 +976,7 @@ is marked. See the documentation for the function `list-sexp-diary-entries'."
982 sexp-mark "(diary-remind\\)")) 976 sexp-mark "(diary-remind\\)"))
983 (file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) 977 (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
984 m y first-date last-date mark file-glob-attrs) 978 m y first-date last-date mark file-glob-attrs)
985 (save-excursion 979 (with-current-buffer calendar-buffer
986 (set-buffer calendar-buffer)
987 (setq m displayed-month) 980 (setq m displayed-month)
988 (setq y displayed-year)) 981 (setq y displayed-year))
989 (increment-calendar-month m y -1) 982 (increment-calendar-month m y -1)
@@ -1048,12 +1041,12 @@ changing the variable `diary-include-string'."
1048 (goto-char (point-min)) 1041 (goto-char (point-min))
1049 (while (re-search-forward 1042 (while (re-search-forward
1050 (concat 1043 (concat
1051 "\\(\\`\\|\^M\\|\n\\)" 1044 "\\(?:\\`\\|\^M\\|\n\\)"
1052 (regexp-quote diary-include-string) 1045 (regexp-quote diary-include-string)
1053 " \"\\([^\"]*\\)\"") 1046 " \"\\([^\"]*\\)\"")
1054 nil t) 1047 nil t)
1055 (let* ((diary-file (substitute-in-file-name 1048 (let* ((diary-file (substitute-in-file-name
1056 (match-string-no-properties 2))) 1049 (match-string-no-properties 1)))
1057 (mark-diary-entries-hook 'mark-included-diary-files) 1050 (mark-diary-entries-hook 'mark-included-diary-files)
1058 (dbuff (find-buffer-visiting diary-file))) 1051 (dbuff (find-buffer-visiting diary-file)))
1059 (if (file-exists-p diary-file) 1052 (if (file-exists-p diary-file)
@@ -1073,8 +1066,7 @@ changing the variable `diary-include-string'."
1073(defun mark-calendar-days-named (dayname &optional color) 1066(defun mark-calendar-days-named (dayname &optional color)
1074 "Mark all dates in the calendar window that are day DAYNAME of the week. 1067 "Mark all dates in the calendar window that are day DAYNAME of the week.
10750 means all Sundays, 1 means all Mondays, and so on." 10680 means all Sundays, 1 means all Mondays, and so on."
1076 (save-excursion 1069 (with-current-buffer calendar-buffer
1077 (set-buffer calendar-buffer)
1078 (let ((prev-month displayed-month) 1070 (let ((prev-month displayed-month)
1079 (prev-year displayed-year) 1071 (prev-year displayed-year)
1080 (succ-month displayed-month) 1072 (succ-month displayed-month)
@@ -1094,8 +1086,7 @@ changing the variable `diary-include-string'."
1094(defun mark-calendar-date-pattern (month day year &optional color) 1086(defun mark-calendar-date-pattern (month day year &optional color)
1095 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. 1087 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
1096A value of 0 in any position is a wildcard." 1088A value of 0 in any position is a wildcard."
1097 (save-excursion 1089 (with-current-buffer calendar-buffer
1098 (set-buffer calendar-buffer)
1099 (let ((m displayed-month) 1090 (let ((m displayed-month)
1100 (y displayed-year)) 1091 (y displayed-year))
1101 (increment-calendar-month m y -1) 1092 (increment-calendar-month m y -1)
@@ -1152,22 +1143,17 @@ be used instead of a colon (:) to separate the hour and minute parts."
1152 (cond ((string-match ; Military time 1143 (cond ((string-match ; Military time
1153 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" 1144 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
1154 s) 1145 s)
1155 (+ (* 100 (string-to-number 1146 (+ (* 100 (string-to-number (match-string 1 s)))
1156 (substring s (match-beginning 1) (match-end 1)))) 1147 (string-to-number (match-string 2 s))))
1157 (string-to-number (substring s (match-beginning 2) (match-end 2)))))
1158 ((string-match ; Hour only XXam or XXpm 1148 ((string-match ; Hour only XXam or XXpm
1159 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) 1149 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
1160 (+ (* 100 (% (string-to-number 1150 (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
1161 (substring s (match-beginning 1) (match-end 1)))
1162 12))
1163 (if (equal ?a (downcase (aref s (match-beginning 2)))) 1151 (if (equal ?a (downcase (aref s (match-beginning 2))))
1164 0 1200))) 1152 0 1200)))
1165 ((string-match ; Hour and minute XX:XXam or XX:XXpm 1153 ((string-match ; Hour and minute XX:XXam or XX:XXpm
1166 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) 1154 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
1167 (+ (* 100 (% (string-to-number 1155 (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
1168 (substring s (match-beginning 1) (match-end 1))) 1156 (string-to-number (match-string 2 s))
1169 12))
1170 (string-to-number (substring s (match-beginning 2) (match-end 2)))
1171 (if (equal ?a (downcase (aref s (match-beginning 3)))) 1157 (if (equal ?a (downcase (aref s (match-beginning 3))))
1172 0 1200))) 1158 0 1200)))
1173 (t diary-unknown-time)))) ; Unrecognizable 1159 (t diary-unknown-time)))) ; Unrecognizable
@@ -1404,14 +1390,7 @@ best if they are nonmarking."
1404 (error 1390 (error
1405 (beep) 1391 (beep)
1406 (message "Bad sexp at line %d in %s: %s" 1392 (message "Bad sexp at line %d in %s: %s"
1407 (save-excursion 1393 (count-lines (point-min) (point))
1408 (save-restriction
1409 (narrow-to-region 1 (point))
1410 (goto-char (point-min))
1411 (let ((lines 1))
1412 (while (re-search-forward "\n\\|\^M" nil t)
1413 (setq lines (1+ lines)))
1414 lines)))
1415 diary-file sexp) 1394 diary-file sexp)
1416 (sleep-for 2)))))) 1395 (sleep-for 2))))))
1417 (cond ((stringp result) result) 1396 (cond ((stringp result) result)
@@ -1688,12 +1667,9 @@ If omitted, NONMARKING defaults to nil and FILE defaults to
1688redrawn with the new entry marked, if necessary." 1667redrawn with the new entry marked, if necessary."
1689 (let ((pop-up-frames (window-dedicated-p (selected-window)))) 1668 (let ((pop-up-frames (window-dedicated-p (selected-window))))
1690 (find-file-other-window (substitute-in-file-name (or file diary-file)))) 1669 (find-file-other-window (substitute-in-file-name (or file diary-file))))
1691 (add-hook 'write-contents-functions 'diary-redraw-calendar nil t) 1670 (add-hook 'after-save-hook 'diary-redraw-calendar nil t)
1692 (when selective-display
1693 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
1694 (setq selective-display nil)
1695 (kill-local-variable 'mode-line-format))
1696 (widen) 1671 (widen)
1672 (diary-unhide-everything)
1697 (goto-char (point-max)) 1673 (goto-char (point-max))
1698 (when (let ((case-fold-search t)) 1674 (when (let ((case-fold-search t))
1699 (search-backward "Local Variables:" 1675 (search-backward "Local Variables:"
@@ -1701,7 +1677,7 @@ redrawn with the new entry marked, if necessary."
1701 t)) 1677 t))
1702 (beginning-of-line) 1678 (beginning-of-line)
1703 (insert "\n") 1679 (insert "\n")
1704 (previous-line 1)) 1680 (forward-line -1))
1705 (insert 1681 (insert
1706 (if (bolp) "" "\n") 1682 (if (bolp) "" "\n")
1707 (if nonmarking diary-nonmarking-symbol "") 1683 (if nonmarking diary-nonmarking-symbol "")
@@ -1798,19 +1774,29 @@ Prefix arg will make the entry nonmarking."
1798 (calendar-date-string (calendar-cursor-to-date t) nil t)) 1774 (calendar-date-string (calendar-cursor-to-date t) nil t))
1799 arg))) 1775 arg)))
1800 1776
1777(defvar diary-mode-map
1778 (let ((map (make-sparse-keymap)))
1779 (define-key map "\C-c\C-s" 'diary-show-all-entries)
1780 (define-key map "\C-c\C-q" 'quit-window)
1781 map)
1782 "Keymap for `diary-mode'.")
1783
1801;;;###autoload 1784;;;###autoload
1802(define-derived-mode diary-mode fundamental-mode 1785(define-derived-mode diary-mode fundamental-mode "Diary"
1803 "Diary"
1804 "Major mode for editing the diary file." 1786 "Major mode for editing the diary file."
1805 (set (make-local-variable 'font-lock-defaults) 1787 (set (make-local-variable 'font-lock-defaults)
1806 '(diary-font-lock-keywords t))) 1788 '(diary-font-lock-keywords t))
1789 (add-to-invisibility-spec '(diary . nil))
1790 (add-hook 'after-save-hook 'diary-redraw-calendar nil t)
1791 (if diary-header-line-flag
1792 (setq header-line-format diary-header-line-format)))
1807 1793
1808(define-derived-mode fancy-diary-display-mode fundamental-mode 1794(define-derived-mode fancy-diary-display-mode fundamental-mode
1809 "Diary" 1795 "Diary"
1810 "Major mode used while displaying diary entries using Fancy Display." 1796 "Major mode used while displaying diary entries using Fancy Display."
1811 (set (make-local-variable 'font-lock-defaults) 1797 (set (make-local-variable 'font-lock-defaults)
1812 '(fancy-diary-font-lock-keywords t)) 1798 '(fancy-diary-font-lock-keywords t))
1813 (define-key (current-local-map) "q" 'quit-window)) 1799 (local-set-key "q" 'quit-window))
1814 1800
1815 1801
1816(defvar fancy-diary-font-lock-keywords 1802(defvar fancy-diary-font-lock-keywords
@@ -1836,7 +1822,7 @@ Prefix arg will make the entry nonmarking."
1836 "Keywords to highlight in fancy diary display") 1822 "Keywords to highlight in fancy diary display")
1837 1823
1838 1824
1839(defun font-lock-diary-sexps (limit) 1825(defun diary-font-lock-sexps (limit)
1840 "Recognize sexp diary entry for font-locking." 1826 "Recognize sexp diary entry for font-locking."
1841 (if (re-search-forward 1827 (if (re-search-forward
1842 (concat "^" (regexp-quote diary-nonmarking-symbol) 1828 (concat "^" (regexp-quote diary-nonmarking-symbol)
@@ -1851,7 +1837,7 @@ Prefix arg will make the entry nonmarking."
1851 t)) 1837 t))
1852 (error t)))) 1838 (error t))))
1853 1839
1854(defun font-lock-diary-date-forms (month-array &optional symbol abbrev-array) 1840(defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array)
1855 "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. 1841 "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
1856If given, optional SYMBOL must be a prefix to entries. 1842If given, optional SYMBOL must be a prefix to entries.
1857If optional ABBREV-ARRAY is present, the abbreviations constructed 1843If optional ABBREV-ARRAY is present, the abbreviations constructed
@@ -1865,7 +1851,7 @@ names."
1865 (month "\\([0-9]+\\|\\*\\)") 1851 (month "\\([0-9]+\\|\\*\\)")
1866 (day "\\([0-9]+\\|\\*\\)") 1852 (day "\\([0-9]+\\|\\*\\)")
1867 (year "-?\\([0-9]+\\|\\*\\)")) 1853 (year "-?\\([0-9]+\\|\\*\\)"))
1868 (mapcar '(lambda (x) 1854 (mapcar (lambda (x)
1869 (cons 1855 (cons
1870 (concat "^" (regexp-quote diary-nonmarking-symbol) "?" 1856 (concat "^" (regexp-quote diary-nonmarking-symbol) "?"
1871 (if symbol (regexp-quote symbol) "") "\\(" 1857 (if symbol (regexp-quote symbol) "") "\\("
@@ -1873,7 +1859,7 @@ names."
1873 ;; If backup, omit first item (backup) 1859 ;; If backup, omit first item (backup)
1874 ;; and last item (not part of date) 1860 ;; and last item (not part of date)
1875 (if (equal (car x) 'backup) 1861 (if (equal (car x) 'backup)
1876 (reverse (cdr (reverse (cdr x)))) 1862 (nreverse (cdr (reverse (cdr x))))
1877 x) 1863 x)
1878 "") 1864 "")
1879 ;; With backup, last item is not part of date 1865 ;; With backup, last item is not part of date
@@ -1888,14 +1874,14 @@ names."
1888 1874
1889(defvar diary-font-lock-keywords 1875(defvar diary-font-lock-keywords
1890 (append 1876 (append
1891 (font-lock-diary-date-forms calendar-month-name-array 1877 (diary-font-lock-date-forms calendar-month-name-array
1892 nil calendar-month-abbrev-array) 1878 nil calendar-month-abbrev-array)
1893 (when (or (memq 'mark-hebrew-diary-entries 1879 (when (or (memq 'mark-hebrew-diary-entries
1894 nongregorian-diary-marking-hook) 1880 nongregorian-diary-marking-hook)
1895 (memq 'list-hebrew-diary-entries 1881 (memq 'list-hebrew-diary-entries
1896 nongregorian-diary-listing-hook)) 1882 nongregorian-diary-listing-hook))
1897 (require 'cal-hebrew) 1883 (require 'cal-hebrew)
1898 (font-lock-diary-date-forms 1884 (diary-font-lock-date-forms
1899 calendar-hebrew-month-name-array-leap-year 1885 calendar-hebrew-month-name-array-leap-year
1900 hebrew-diary-entry-symbol)) 1886 hebrew-diary-entry-symbol))
1901 (when (or (memq 'mark-islamic-diary-entries 1887 (when (or (memq 'mark-islamic-diary-entries
@@ -1903,7 +1889,7 @@ names."
1903 (memq 'list-islamic-diary-entries 1889 (memq 'list-islamic-diary-entries
1904 nongregorian-diary-listing-hook)) 1890 nongregorian-diary-listing-hook))
1905 (require 'cal-islam) 1891 (require 'cal-islam)
1906 (font-lock-diary-date-forms 1892 (diary-font-lock-date-forms
1907 calendar-islamic-month-name-array 1893 calendar-islamic-month-name-array
1908 islamic-diary-entry-symbol)) 1894 islamic-diary-entry-symbol))
1909 (list 1895 (list
@@ -1925,10 +1911,10 @@ names."
1925 (concat "^" (regexp-quote diary-nonmarking-symbol) 1911 (concat "^" (regexp-quote diary-nonmarking-symbol)
1926 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") 1912 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
1927 '(1 font-lock-reference-face)) 1913 '(1 font-lock-reference-face))
1928 '(font-lock-diary-sexps . font-lock-keyword-face) 1914 '(diary-font-lock-sexps . font-lock-keyword-face)
1929 '("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?" 1915 '("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"
1930 . font-lock-function-name-face))) 1916 . font-lock-function-name-face)))
1931 "Forms to highlight in diary-mode") 1917 "Forms to highlight in `diary-mode'.")
1932 1918
1933 1919
1934;; Following code from Dave Love <fx@gnu.org>. 1920;; Following code from Dave Love <fx@gnu.org>.
@@ -2087,5 +2073,5 @@ user is asked to confirm its addition."
2087 2073
2088(provide 'diary-lib) 2074(provide 'diary-lib)
2089 2075
2090;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010 2076;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
2091;;; diary-lib.el ends here 2077;;; diary-lib.el ends here
diff --git a/lisp/custom.el b/lisp/custom.el
index d634160e534..cf6ef88456e 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -649,17 +649,16 @@ See `custom-known-themes' for a list of known themes."
649 (progn 649 (progn
650 (setcar (cdr setting) mode) 650 (setcar (cdr setting) mode)
651 (setcar (cddr setting) value)) 651 (setcar (cddr setting) value))
652 (if (and (null old) 652 ;; If no custom theme has been applied yet, first save the
653 (boundp symbol)) 653 ;; current values to the 'standard theme.
654 (setq old 654 (if (null old)
655 (list 655 (if (and (eq prop 'theme-value)
656 (list 'standard 'set 656 (boundp symbol))
657 (if (eq prop 'theme-value) 657 (setq old
658 (symbol-value symbol) 658 (list (list 'standard 'set (symbol-value symbol))))
659 (list 659 (if (facep symbol)
660 (append 660 (setq old (list (list 'standard 'set (list
661 '(t) 661 (append '(t) (custom-face-attributes-get symbol nil)))))))))
662 (custom-face-attributes-get symbol nil))))))))
663 (put symbol prop (cons (list theme mode value) old))) 662 (put symbol prop (cons (list theme mode value) old)))
664 ;; Record, for each theme, all its settings. 663 ;; Record, for each theme, all its settings.
665 (put theme 'theme-settings 664 (put theme 'theme-settings
diff --git a/lisp/faces.el b/lisp/faces.el
index 505b53bcc05..10ffc38395f 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1834,20 +1834,27 @@ created."
1834 ;; User init file can set term-file-prefix to nil to prevent this. 1834 ;; User init file can set term-file-prefix to nil to prevent this.
1835 (with-selected-frame frame 1835 (with-selected-frame frame
1836 (unless (null term-file-prefix) 1836 (unless (null term-file-prefix)
1837 (let ((term (frame-parameter frame 'tty-type)) 1837 (let* ((term (frame-parameter frame 'tty-type))
1838 hyphend term-init-func) 1838 (term2 term)
1839 hyphend term-init-func)
1839 (while (and term 1840 (while (and term
1840 (not (fboundp
1841 (setq term-init-func (intern (concat "terminal-init-" term)))))
1842 (not (load (concat term-file-prefix term) t t))) 1841 (not (load (concat term-file-prefix term) t t)))
1843 ;; Strip off last hyphen and what follows, then try again 1842 ;; Strip off last hyphen and what follows, then try again
1844 (setq term 1843 (setq term
1845 (if (setq hyphend (string-match "[-_][^-_]+$" term)) 1844 (if (setq hyphend (string-match "[-_][^-_]+$" term))
1846 (substring term 0 hyphend) 1845 (substring term 0 hyphend)
1847 nil))) 1846 nil)))
1848 (when (and term (fboundp term-init-func)) 1847 ;; The terminal file has been loaded, now find and call the
1849 ;; The terminal file has been loaded, now call the terminal 1848 ;; terminal specific initialization function.
1850 ;; specific initialization function. 1849 (while (and term2
1850 (not (fboundp
1851 (setq term-init-func (intern (concat "terminal-init-" term2))))))
1852 ;; Strip off last hyphen and what follows, then try again
1853 (setq term2
1854 (if (setq hyphend (string-match "[-_][^-_]+$" term2))
1855 (substring term2 0 hyphend)
1856 nil)))
1857 (when (fboundp term-init-func)
1851 (funcall term-init-func)))))) 1858 (funcall term-init-func))))))
1852 1859
1853;; Called from C function init_display to initialize faces of the 1860;; Called from C function init_display to initialize faces of the
diff --git a/lisp/files.el b/lisp/files.el
index 68a85f07df8..33fc39dea1c 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1738,7 +1738,11 @@ in that case, this function acts as if `enable-local-variables' were t."
1738 (hack-local-variables))) 1738 (hack-local-variables)))
1739 ;; Turn font lock off and on, to make sure it takes account of 1739 ;; Turn font lock off and on, to make sure it takes account of
1740 ;; whatever file local variables are relevant to it. 1740 ;; whatever file local variables are relevant to it.
1741 (when (and font-lock-mode (eq (car font-lock-keywords) t)) 1741 (when (and font-lock-mode
1742 ;; Font-lock-mode (now in font-core.el) can be ON when
1743 ;; font-lock.el still hasn't been loaded.
1744 (boundp 'font-lock-keywords)
1745 (eq (car font-lock-keywords) t))
1742 (setq font-lock-keywords (cadr font-lock-keywords)) 1746 (setq font-lock-keywords (cadr font-lock-keywords))
1743 (font-lock-mode 1)) 1747 (font-lock-mode 1))
1744 1748
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 12b265661ea..75a2ba3c21a 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -340,6 +340,7 @@ This can be an \"!\" or the \"n\" in \"ifndef\".")
340 340
341;; Fontification variables: 341;; Fontification variables:
342 342
343;;;###autoload
343(defvar font-lock-keywords nil 344(defvar font-lock-keywords nil
344 "A list of the keywords to highlight. 345 "A list of the keywords to highlight.
345There are two kinds of values: user-level, and compiled. 346There are two kinds of values: user-level, and compiled.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index ed58234ffad..fc8277e7414 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -522,7 +522,7 @@ it is displayed along with the global value."
522 (message "You did not specify a variable") 522 (message "You did not specify a variable")
523 (save-excursion 523 (save-excursion
524 (let ((valvoid (not (with-current-buffer buffer (boundp variable)))) 524 (let ((valvoid (not (with-current-buffer buffer (boundp variable))))
525 val locus) 525 val val-start-pos locus)
526 ;; Extract the value before setting up the output buffer, 526 ;; Extract the value before setting up the output buffer,
527 ;; in case `buffer' *is* the output buffer. 527 ;; in case `buffer' *is* the output buffer.
528 (unless valvoid 528 (unless valvoid
@@ -535,10 +535,50 @@ it is displayed along with the global value."
535 (with-output-to-temp-buffer (help-buffer) 535 (with-output-to-temp-buffer (help-buffer)
536 (with-current-buffer buffer 536 (with-current-buffer buffer
537 (prin1 variable) 537 (prin1 variable)
538 ;; Make a hyperlink to the library if appropriate. (Don't
539 ;; change the format of the buffer's initial line in case
540 ;; anything expects the current format.)
541 (let ((file-name (symbol-file variable 'defvar)))
542 (when (equal file-name "loaddefs.el")
543 ;; Find the real def site of the preloaded variable.
544 (let ((location
545 (condition-case nil
546 (find-variable-noselect variable file-name)
547 (error nil))))
548 (when location
549 (with-current-buffer (car location)
550 (goto-char (cdr location))
551 (when (re-search-backward
552 "^;;; Generated autoloads from \\(.*\\)" nil t)
553 (setq file-name (match-string 1)))))))
554 (when (and (null file-name)
555 (integerp (get variable 'variable-documentation)))
556 ;; It's a variable not defined in Elisp but in C.
557 (setq file-name
558 (if (get-buffer " *DOC*")
559 (help-C-file-name variable 'var)
560 'C-source)))
561 (if file-name
562 (progn
563 (princ " is a variable defined in `")
564 (princ (if (eq file-name 'C-source) "C source code" file-name))
565 (princ "'.\n")
566 (with-current-buffer standard-output
567 (save-excursion
568 (re-search-backward "`\\([^`']+\\)'" nil t)
569 (help-xref-button 1 'help-variable-def
570 variable file-name)))
571 (if valvoid
572 (princ "It is void as a variable.\n")
573 (princ "Its ")))
574 (if valvoid
575 (princ " is void as a variable.\n")
576 (princ "'s "))))
538 (if valvoid 577 (if valvoid
539 (princ " is void") 578 nil
540 (with-current-buffer standard-output 579 (with-current-buffer standard-output
541 (princ "'s value is ") 580 (setq val-start-pos (point))
581 (princ "value is ")
542 (terpri) 582 (terpri)
543 (let ((from (point))) 583 (let ((from (point)))
544 (pp val) 584 (pp val)
@@ -548,6 +588,7 @@ it is displayed along with the global value."
548 (if (< (point) (+ from 20)) 588 (if (< (point) (+ from 20))
549 (delete-region (1- from) from))))) 589 (delete-region (1- from) from)))))
550 (terpri) 590 (terpri)
591
551 (when locus 592 (when locus
552 (if (bufferp locus) 593 (if (bufferp locus)
553 (princ (format "%socal in buffer %s; " 594 (princ (format "%socal in buffer %s; "
@@ -570,38 +611,35 @@ it is displayed along with the global value."
570 ;; See previous comment for this function. 611 ;; See previous comment for this function.
571 ;; (help-xref-on-pp from (point)) 612 ;; (help-xref-on-pp from (point))
572 (if (< (point) (+ from 20)) 613 (if (< (point) (+ from 20))
573 (delete-region (1- from) from)))))) 614 (delete-region (1- from) from)))))))
574 (terpri)) 615 ;; Add a note for variables that have been make-var-buffer-local.
616 (when (and (local-variable-if-set-p variable)
617 (or (not (local-variable-p variable))
618 (with-temp-buffer
619 (local-variable-if-set-p variable))))
620 (princ "\nAutomatically becomes buffer-local when set in any fashion.\n"))
575 (terpri) 621 (terpri)
622
623 ;; If the value is large, move it to the end.
576 (with-current-buffer standard-output 624 (with-current-buffer standard-output
577 (when (> (count-lines (point-min) (point-max)) 10) 625 (when (> (count-lines (point-min) (point-max)) 10)
578 ;; Note that setting the syntax table like below 626 ;; Note that setting the syntax table like below
579 ;; makes forward-sexp move over a `'s' at the end 627 ;; makes forward-sexp move over a `'s' at the end
580 ;; of a symbol. 628 ;; of a symbol.
581 (set-syntax-table emacs-lisp-mode-syntax-table) 629 (set-syntax-table emacs-lisp-mode-syntax-table)
582 (goto-char (point-min)) 630 (goto-char val-start-pos)
583 (if valvoid 631 (delete-region (point) (progn (end-of-line) (point)))
584 (forward-line 1)
585 (forward-sexp 1)
586 (delete-region (point) (progn (end-of-line) (point)))
587 (save-excursion
588 (insert "\n\nValue:")
589 (set (make-local-variable 'help-button-cache)
590 (point-marker)))
591 (insert " value is shown ")
592 (insert-button "below"
593 'action help-button-cache
594 'follow-link t
595 'help-echo "mouse-2, RET: show value")
596 (insert ".\n\n")))
597 ;; Add a note for variables that have been make-var-buffer-local.
598 (when (and (local-variable-if-set-p variable)
599 (or (not (local-variable-p variable))
600 (with-temp-buffer
601 (local-variable-if-set-p variable))))
602 (save-excursion 632 (save-excursion
603 (forward-line -1) 633 (insert "\n\nValue:")
604 (insert "Automatically becomes buffer-local when set in any fashion.\n")))) 634 (set (make-local-variable 'help-button-cache)
635 (point-marker)))
636 (insert "value is shown ")
637 (insert-button "below"
638 'action help-button-cache
639 'follow-link t
640 'help-echo "mouse-2, RET: show value")
641 (insert ".\n\n")))
642
605 ;; Mention if it's an alias 643 ;; Mention if it's an alias
606 (let* ((alias (condition-case nil 644 (let* ((alias (condition-case nil
607 (indirect-variable variable) 645 (indirect-variable variable)
@@ -610,17 +648,15 @@ it is displayed along with the global value."
610 (doc (or (documentation-property variable 'variable-documentation) 648 (doc (or (documentation-property variable 'variable-documentation)
611 (documentation-property alias 'variable-documentation)))) 649 (documentation-property alias 'variable-documentation))))
612 (unless (eq alias variable) 650 (unless (eq alias variable)
613 (princ (format "This variable is an alias for `%s'." alias)) 651 (princ (format "\nThis variable is an alias for `%s'.\n" alias)))
614 (terpri)
615 (terpri))
616 (when obsolete 652 (when obsolete
617 (princ "This variable is obsolete") 653 (princ "\nThis variable is obsolete")
618 (if (cdr obsolete) (princ (format " since %s" (cdr obsolete)))) 654 (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
619 (princ ";") (terpri) 655 (princ ";") (terpri)
620 (princ (if (stringp (car obsolete)) (car obsolete) 656 (princ (if (stringp (car obsolete)) (car obsolete)
621 (format "use `%s' instead." (car obsolete)))) 657 (format "use `%s' instead." (car obsolete))))
622 (terpri)
623 (terpri)) 658 (terpri))
659 (princ "Documentation:\n")
624 (princ (or doc "Not documented as a variable."))) 660 (princ (or doc "Not documented as a variable.")))
625 ;; Make a link to customize if this variable can be customized. 661 ;; Make a link to customize if this variable can be customized.
626 (if (custom-variable-p variable) 662 (if (custom-variable-p variable)
@@ -633,39 +669,6 @@ it is displayed along with the global value."
633 (re-search-backward 669 (re-search-backward
634 (concat "\\(" customize-label "\\)") nil t) 670 (concat "\\(" customize-label "\\)") nil t)
635 (help-xref-button 1 'help-customize-variable variable))))) 671 (help-xref-button 1 'help-customize-variable variable)))))
636 ;; Make a hyperlink to the library if appropriate. (Don't
637 ;; change the format of the buffer's initial line in case
638 ;; anything expects the current format.)
639 (let ((file-name (symbol-file variable 'defvar)))
640 (when (equal file-name "loaddefs.el")
641 ;; Find the real def site of the preloaded variable.
642 (let ((location
643 (condition-case nil
644 (find-variable-noselect variable file-name)
645 (error nil))))
646 (when location
647 (with-current-buffer (car location)
648 (goto-char (cdr location))
649 (when (re-search-backward
650 "^;;; Generated autoloads from \\(.*\\)" nil t)
651 (setq file-name (match-string 1)))))))
652 (when (and (null file-name)
653 (integerp (get variable 'variable-documentation)))
654 ;; It's a variable not defined in Elisp but in C.
655 (setq file-name
656 (if (get-buffer " *DOC*")
657 (help-C-file-name variable 'var)
658 'C-source)))
659 (when file-name
660 (princ "\n\nDefined in `")
661 (princ (if (eq file-name 'C-source) "C source code" file-name))
662 (princ "'.")
663 (with-current-buffer standard-output
664 (save-excursion
665 (re-search-backward "`\\([^`']+\\)'" nil t)
666 (help-xref-button 1 'help-variable-def
667 variable file-name)))))
668
669 (print-help-return-message) 672 (print-help-return-message)
670 (save-excursion 673 (save-excursion
671 (set-buffer standard-output) 674 (set-buffer standard-output)
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index f5c34ff80ca..32328a33177 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1591,8 +1591,13 @@ is inserted.
1591The normal hook `mail-setup-hook' is run after the message is 1591The normal hook `mail-setup-hook' is run after the message is
1592initialized. It can add more default fields to the message. 1592initialized. It can add more default fields to the message.
1593 1593
1594When calling from a program, the first argument if non-nil says 1594The first argument, NOERASE, determines what to do when there is
1595not to erase the existing contents of the `*mail*' buffer. 1595an existing modified `*mail*' buffer. If NOERASE is nil, the
1596existing mail buffer is used, and the user is prompted whether to
1597keep the old contents or to erase them. If NOERASE has the value
1598`new', a new mail buffer will be created instead of using the old
1599one. Any other non-nil value means to always select the old
1600buffer without erasing the contents.
1596 1601
1597The second through fifth arguments, 1602The second through fifth arguments,
1598 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil 1603 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil
@@ -1649,7 +1654,11 @@ The seventh argument ACTIONS is a list of actions to take
1649;;; (file-exists-p buffer-auto-save-file-name)) 1654;;; (file-exists-p buffer-auto-save-file-name))
1650;;; (message "Auto save file for draft message exists; consider M-x mail-recover")) 1655;;; (message "Auto save file for draft message exists; consider M-x mail-recover"))
1651;;; t)) 1656;;; t))
1652 (pop-to-buffer "*mail*") 1657
1658 (if (eq noerase 'new)
1659 (pop-to-buffer (generate-new-buffer "*mail*"))
1660 (pop-to-buffer "*mail*"))
1661
1653 ;; Avoid danger that the auto-save file can't be written. 1662 ;; Avoid danger that the auto-save file can't be written.
1654 (let ((dir (expand-file-name 1663 (let ((dir (expand-file-name
1655 (file-name-as-directory mail-default-directory)))) 1664 (file-name-as-directory mail-default-directory))))
@@ -1664,7 +1673,8 @@ The seventh argument ACTIONS is a list of actions to take
1664 ;; (in case the user has actually visited a file *mail*). 1673 ;; (in case the user has actually visited a file *mail*).
1665; (set-visited-file-name nil) 1674; (set-visited-file-name nil)
1666 (let (initialized) 1675 (let (initialized)
1667 (and (not noerase) 1676 (and (or (not noerase)
1677 (eq noerase 'new))
1668 (if buffer-file-name 1678 (if buffer-file-name
1669 (if (buffer-modified-p) 1679 (if (buffer-modified-p)
1670 (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ") 1680 (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ")
diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el
new file mode 100644
index 00000000000..c6597695354
--- /dev/null
+++ b/lisp/net/newsticker.el
@@ -0,0 +1,4919 @@
1;;; newsticker.el --- A Newsticker for Emacs.
2
3;; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; Author: Ulf Jasper <ulf.jasper@web.de>
8;; Filename: newsticker.el
9;; URL: http://www.nongnu.org/newsticker
10;; Created: 17. June 2003
11;; Keywords: News, RSS
12;; Time-stamp: "26. August 2005, 16:33:46 (ulf)"
13;; CVS-Version: $Id: newsticker.el,v 1.2 2005/09/12 22:54:28 miles Exp $
14
15(defconst newsticker-version "1.8" "Version number of newsticker.el.")
16
17;; ======================================================================
18
19;; This program is free software; you can redistribute it and/or modify
20;; it under the terms of the GNU General Public License as published by
21;; the Free Software Foundation; either version 2 of the License, or (at
22;; your option) any later version.
23
24;; This program is distributed in the hope that it will be useful, but
25;; WITHOUT ANY WARRANTY; without even the implied warranty of
26;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
27;; General Public License for more details.
28
29;; You should have received a copy of the GNU General Public License
30;; along with this program; if not, write to the Free Software
31;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
32;; USA
33
34;; ======================================================================
35;;; Commentary:
36
37;; Overview
38;; --------
39
40;; Newsticker provides a newsticker for Emacs. A newsticker is a thing that
41;; asynchronously retrieves headlines from a list of news sites, prepares
42;; these headlines for reading, and allows for loading the corresponding
43;; articles in a web browser.
44
45;; Headlines consist of a title and (possibly) a small description. They
46;; are contained in RSS (RDF Site Summary) files. Newsticker should work
47;; with all RSS files that follow the RDF Rich Site Summary 1.0
48;; specification. It should also work with version 2.0 as well as
49;; other/older/alternative RSS formats (like 0.9<something> or such). In
50;; other words: Newsticker is a "RSS reader" or "RSS aggregator".
51
52;; Newsticker provides several commands for reading headlines, navigating
53;; through them, marking them as read/unread, hiding old headlines
54;; etc. Headlines can be displayed as plain text or as rendered HTML.
55
56;; Headlines can be displayed in the echo area, either scrolling like
57;; messages in a stock-quote ticker, or just changing.
58
59;; Newsticker allows for automatic processing of headlines by providing
60;; hooks and (sample) functions for automatically downloading images and
61;; enclosed files (as delivered by podcasts, e.g.).
62
63
64
65;; Requirements
66;; ------------
67;; Newsticker can be used with GNU Emacs version 21.1 or later as well as
68;; XEmacs. It requires an XML-parser (`xml.el') which is part of GNU
69;; Emacs. If you are using XEmacs you want to get the `net-utils' package
70;; which contains `xml.el' for XEmacs.
71
72;; Newsticker requires a program which can retrieve files via http and
73;; prints them to stdout. By default Newsticker will use wget for this
74;; task.
75
76;; Installation
77;; ------------
78;; Place Newsticker in a directory where Emacs can find it. Add the
79;; following line to your Emacs startup file (`~/.emacs').
80;; (add-to-list 'load-path "/path/to/newsticker/")
81;; (autoload 'newsticker-start "newsticker" "Emacs Newsticker" t)
82;; (autoload 'newsticker-show-news "newsticker" "Emacs Newsticker" t)
83
84;; Newsticker-mode supports imenu. It allows for navigating with the help
85;; of a menu. In order to use this feature you should also add the
86;; following.
87;; (add-hook 'newsticker-mode-hook 'imenu-add-menubar-index)
88
89;; That's it.
90
91;; Usage
92;; -----
93;; The command newsticker-show-news will display all available headlines in
94;; a special buffer, called `*newsticker*'. It will also start the
95;; asynchronous download of headlines. The modeline in the `*newsticker*'
96;; buffer informs whenever new headlines have arrived. Clicking
97;; mouse-button 2 or pressing RET in this buffer on a headline will call
98;; browse-url to load the corresponding news story in your favourite web
99;; browser.
100
101;; The scrolling, or flashing of headlines in the echo area, can be started
102;; with the command newsticker-start-ticker. It can be stopped with
103;; newsticker-stop-ticker.
104
105;; If you just want to start the periodic download of headlines use the
106;; command newsticker-start. Calling newsticker-stop will stop the periodic
107;; download, but will call newsticker-stop-ticker as well.
108
109;; Configuration
110;; -------------
111;; All Newsticker options are customizable, i.e. they can be changed with
112;; Emacs customization methods: Call the command customize-group and enter
113;; `newsticker' for the customization group.
114
115;; All Newsticker options have reasonable default values, so that in most
116;; cases it is not necessary to customize settings before starting
117;; Newsticker for the first time.
118
119;; Newsticker options are organized in the following groups.
120
121;; * newsticker-feed contains options that define which news
122;; feeds are retrieved and how this is done.
123;; o newsticker-url-list defines the list of headlines which are
124;; retrieved.
125;; o newsticker-retrieval-interval defines how often headlines are
126;; retrieved.
127;; * newsticker-headline-processing contains options that define how the
128;; retrieved headlines are processed.
129;; o newsticker-keep-obsolete-items decides whether unread headlines that
130;; have been removed from the feed are kept in the Newsticker cache.
131;; * newsticker-layout contains options that define how the buffer for
132;; reading RSS headlines is formatted.
133;; o newsticker-item-format defines how the title of a headline is
134;; formatted.
135;; * newsticker-ticker contains options that define how headlines are shown
136;; in the echo area.
137;; o newsticker-display-interval and newsticker-scroll-smoothly define
138;; how headlines are shown in the echo area.
139;; * newsticker-hooks contains options for hooking other Emacs commands to
140;; newsticker functions.
141;; o newsticker-new-item-functions allows for automatic processing of
142;; headlines. See `newsticker-download-images', and
143;; `newsticker-download-enclosures' for sample functions.
144;; * newsticker-miscellaneous contains other Newsticker options.
145
146;; Please have a look at the customization buffers for the complete list of
147;; options.
148
149;; Remarks
150;; -------
151;; This newsticker is designed do its job silently in the background
152;; without disturbing you. However, it is probably impossible to prevent
153;; such a tool from slightly attenuating your Editor's responsiveness every
154;; once in a while.
155
156;; Byte-compiling newsticker.el is recommended.
157
158;; ======================================================================
159;;; History:
160
161;; 1.8 (2005-08-26)
162;; * Added commands `newsticker-show-extra' and `newsticker-hide-extra'
163;; to show and hide extra RSS elements, bound to "sx" and "hx"
164;; resp. Changed default value of `newsticker-show-all-rss-elements'
165;; to nil.
166;; * mode-line: Introduced special mode-line-format for newsticker.
167;; * Get feed logos only once every 24 h.
168;; * Default faces changed.
169;; * Minor fixes.
170
171;; 1.7 (2005-06-25)
172;; * Tool-bar support: most important commands can be called from
173;; tool-bar buttons.
174;; * Auto-Narrowing introduced: *newsticker* buffer can be narrowed to
175;; a single item (bound to key `xi') or a single feed (bound to `xf').
176;; * Enclosure support: enclosed items are shown (see
177;; `newsticker-enclosure-face') and can be (automatically) downloaded
178;; (see below). For those of you who read "podcasts".
179;; * Added variable `newsticker-auto-mark-filter' for automatically
180;; marking items as immortal or old.
181;; * Added hook variable `newsticker-new-item-functions' for handling
182;; new items. Added sample functions `newsticker-download-images',
183;; and `newsticker-download-enclosures'.
184;; * Added hook variable `newsticker-select-item-hook' which is run
185;; after `newsticker-(next|previous)-(new-)?-item'.
186;; * Added hook variable `newsticker-select-feed-hook' which is run
187;; after `newsticker-(next|previous)-feed'.
188;; * Added hook variable `newsticker-buffer-change-hook' which is run
189;; after the contents or visibility of the newsticker buffer has
190;; changed, e.g. after `newsticker-buffer-update' or
191;; `newsticker-show-feed-desc'.
192;; * Added command `newsticker-handle-url' for interactively launching
193;; arbitrary programs for URLs, bound to `C-RET'.
194;; * URLs in extra elements are clickable.
195;; * Better support for w3, added command
196;; `newsticker-w3m-show-inline-images' for displaying all inline
197;; images.
198;; * Insert an artificial headline which notifies about failed retrievals.
199;; * Use pubDate element (RSS 2.0) instead of retrieval time when
200;; available.
201;; * Customizable options grouped.
202;; * Bugfixes: `newsticker--imenu-create-index'; strip whitespace
203;; from links; apply coding-system to extra-elements; time-comparison
204;; for obsolete items; and others which I have forgotten.
205;; * Workaround for another bug in xml-parse-region -- thanks to anonymous
206;; for sending patch.
207;; * Renamed invisible buffers ` *wget-newsticker-<feed>*' to
208;; ` *newsticker-wget-<feed>*'.
209;; * Tested with GNU Emacs versions 21.3 and 22.0 and XEmacs 21.something.
210
211;; 1.6 * Support for (some) optional RSS elements: guid, dc:date. See
212;; `newsticker-show-all-rss-elements' `newsticker-extra-face'.
213;; * Better support for w3m -- `newsticker-default-face' is obsolete
214;; now, removed `newsticker-w3m-toggle-inline-image'.
215;; * Added `newsticker-desc-comp-max' -- comparison of item descriptions
216;; can take quite some time.
217;; * Added `newsticker--buffer-make-item-completely-visible' to
218;; ensure that the current item is fully visible.
219;; * Allow for non-positive retrieval-interval, which make newsticker
220;; get news only once.
221;; * Use :set for customizable variables.
222;; * Added `newsticker-buffer-force-update', bound to key `U'.
223;; * Added concept of obsolete items, see
224;; `newsticker-keep-obsolete-items', `newsticker-obsolete-item-face',
225;; `newsticker-obsolete-item-max-age'.
226;; * Added `newsticker-add-url'.
227;; * OPML export.
228;; * Save pre-formatted titles => even better performance!!
229;; * `newsticker-*-new-item' wraps at beginning/end of buffer.
230;; * Always sort obsolete items to end of item list.
231;; * Bugfixes:
232;; - newsticker-hide-entry,
233;; - changes of feed-titles led to duplicate feed items,
234;; - faces for rendered HTML texts,
235;; - length of ticker-text (for "exotic"/multibyte texts),
236;; Thanks to Hiroshi Maruyama.
237;; - suppress items with empty title and description
238;; - newsticker-sort-method was ignored!
239;; - prevent call of fill-region on HTML-rendered descriptions.
240
241;; 1.5 * Rewrote the visibility stuff. newsticker does not inherit
242;; outline anymore. Now you have complete freedom for
243;; `newsticker-*-format'.
244;; * Save pre-formatted descriptions => incredible performance boost!!
245;; * Introduced `newsticker-(start|stop)-ticker'.
246;; * Introduced statistics for heading-format and
247;; `newsticker-statistics-face'.
248;; * Introduced `newsticker-enable-logo-manipulations'.
249;; * Compare link of items (as well as title and desc).
250;; * Added `newsticker-start-hook' and `newsticker-stop-hook', thanks
251;; to mace.
252;; * Bugfixes -- thanks to Ryan Yeske, Jari Aalto, Bruce Ingalls.
253;; * Tested with Emacs 21.3.50, 21.3.1, 21.2, 21.1; XEmacs 21.4.15
254
255;; 1.4 * Enabled HTML rendering, added `newsticker-html-renderer' to
256;; choose a HTML rendering engine, thanks to Greg Scott for testing
257;; * New Outline handling using text properties instead of "**"
258;; prefixes.
259;; * Added possibility to mark single item as old (bound to key
260;; `o' (`newsticker-mark-item-at-point-as-read').
261;; * Added possibility to mark single item as immortal (bound to key
262;; `i' (`newsticker-mark-item-at-point-as-immortal').
263;; * Added possibility to display feed logos.
264;; * Added `newsticker-heading-format', `newsticker-item-format'.
265;; * Added `newsticker-date-format'.
266;; * Added `newsticker-justification'.
267;; * Added `newsticker-automatically-mark-visited-items-as-old'.
268;; * Added `newsticker-w3m-toggle-inline-image' which calls
269;; `w3m-toggle-inline-image' if `newsticker-html-renderer' is
270;; `w3m-region'. Exists for convenience only (bound to key
271;; `RET').
272
273;; 1.3 * Compare title AND desc to check whether item is old, except
274;; for feed desc
275;; * Mark as not-up-to-date only after new items have arrived.
276;; * Added XEmacs compatibility code, tested with XEmacs 21.4.13.
277;; * Tested with Emacs 21.3.50 and Emacs 21.2.something.
278;; * Bugfix: Apply coding-systems to feed title and description,
279;; thanks to OHASHI Akira
280;; * Bugfix: xml-parser-workaround did not work for japanese texts,
281;; thanks to OHASHI Akira
282;; * Kill wget-buffers unless newsticker-debug is not nil.
283;; * Bugfix: xml-parser-workaround for "DOCTYPE rdf:RDF"
284
285;; 1.2 Peter S Galbraith <psg@debian.org>
286;; * Added `newsticker-url-list-defaults', splitting the URLs into
287;; a customizable selection list, and a user add-on list.
288;; * Minor checkdoc fixes.
289
290;; 1.1 * Introduced optional feed-specific wget-arguments.
291;; * Keep order of feeds as given in `newsticker-url-list' in
292;; *newsticker* buffer.
293;; * Ignore unsupported coding systems.
294
295;; 1.0 * Introduced feed-specific retrieval-timers.
296;; * Removed dependency on 'cl (cddddr).
297;; * Thanks to Kevin Rodgers and T.V. Raman for their help.
298;; * Use utf-8 for reading and writing cache data.
299;; * Reported to work with Emacs 21.3.50.
300
301;; 0.99 * Minor tweaks.
302;; * Tested with Emacs 21.3.2
303
304;; 0.98 * Check exit status of wget processes. Keep cache data if
305;; something went wrong. Throw error when old wget-processes
306;; are hanging around.
307;; * Introduced newsticker-specific faces.
308;; * Added `newsticker-show-descriptions-of-new-items'.
309;; * Added `newsticker-hide-old-items-in-newsticker-buffer'.
310;; * Added `newsticker-(hide|show)-old-items'.
311
312;; 0.97 * Minor tweaks.
313
314;; 0.96 * Added caching.
315;; * newsticker-mode inherits outline-mode.
316;; * newsticker-mode supports imenu.
317;; * Easy buffer-navigation with newsticker-mode's keymap.
318;; * Some bugs fixed.
319;; * Thanks to Moritz Epple for documentation tips.
320
321;; 0.95 * Added newsticker-mode -- Thanks to T.V. Raman.
322;; * Catch xml-parser errors -- Thanks to T.V. Raman.
323;; * Remove stupid newlines in titles (headlines) -- Thanks to
324;; Jeff Rancier.
325
326;; 0.94 * Added clickerability and description for channel headings.
327;; * Made it work for (at least some) rss 0.9<something> feeds.
328
329;; 0.93 * Added some more sites.
330;; * Do not flood the *Messages* buffer.
331;; * First attempt at handling coding systems.
332
333;; 0.92 * Added `newsticker-wget-name'.
334;; * Try to display message only if minibuffer and echo area are
335;; not in use already.
336;; * Dirty workaround for newer versions of xml.el: Remove
337;; whitespace in rdf.
338;; * Tested with Emacs 21.3.2 and CVS-snapshot of 2003-06-21.
339
340;; 0.91 * First bugfix: *newsticker* is read-only.
341
342;; 0.9 * First release.
343;; * Tested with Emacs 21.3.2 and wget 1.8.2.
344
345;; ======================================================================
346;;; To Do:
347
348;; * Image handling for XEmacs (create-image does not exist)
349
350;; ======================================================================
351;;; Code:
352
353(require 'derived)
354(require 'xml)
355
356;; ======================================================================
357;;; Customizables
358;; ======================================================================
359(defgroup newsticker nil
360 "RSS aggregator."
361 :group 'applications)
362
363(defconst newsticker--raw-url-list-defaults
364 '(("CNET News.com"
365 "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml")
366 ("Debian Security Advisories"
367 "http://www.debian.org/security/dsa.en.rdf")
368 ("Debian Security Advisories - Long format"
369 "http://www.debian.org/security/dsa-long.en.rdf")
370 ("Emacs Wiki"
371 "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
372 nil
373 3600)
374 ("Freshmeat.net"
375 "http://freshmeat.net/backend/fm.rdf")
376 ("Kuro5hin.org"
377 "http://www.kuro5hin.org/backend.rdf")
378 ("LWN (Linux Weekly News)"
379 "http://lwn.net/headlines/rss")
380 ("NewsForge"
381 "http://newsforge.com/index.rss")
382 ("NY Times: Technology"
383 "http://partners.userland.com/nytRss/technology.xml")
384 ("NY Times"
385 "http://partners.userland.com/nytRss/nytHomepage.xml")
386 ("Quote of the day"
387 "http://www.quotationspage.com/data/qotd.rss"
388 "07:00"
389 86400)
390 ("The Register"
391 "http://www.theregister.co.uk/tonys/slashdot.rdf")
392 ("slashdot"
393 "http://slashdot.org/index.rss"
394 nil
395 3600) ;/. will ban you if under 3600 seconds!
396 ("Wired News"
397 "http://www.wired.com/news_drop/netcenter/netcenter.rdf")
398 ("Heise News (german)"
399 "http://www.heise.de/newsticker/heise.rdf")
400 ("Tagesschau (german)"
401 "http://www.tagesschau.de/newsticker.rdf"
402 nil
403 1800)
404 ("Telepolis (german)"
405 "http://www.heise.de/tp/news.rdf"))
406 "Default URL list in raw form.
407This list is fed into defcustom via `newsticker--splicer'.")
408
409(defun newsticker--splicer (item)
410 "Convert ITEM for splicing into `newsticker-url-list-defaults'."
411 (let ((result (list 'list :tag (nth 0 item) (list 'const (nth 0 item))))
412 (element (cdr item)))
413 (while element
414 (setq result (append result (list (list 'const (car element)))))
415 (setq element (cdr element)))
416 result))
417
418;; ======================================================================
419;;; Customization
420;; ======================================================================
421(defun newsticker--set-customvar (symbol value)
422 "Set newsticker-variable SYMBOL value to VALUE.
423
424Calls all necessary actions which are necessary in order to make
425the new value effective. Changing `newsticker-url-list', for example,
426will re-start the retrieval-timers."
427 (unless (condition-case nil
428 (eq (symbol-value symbol) value)
429 (error nil))
430 (set symbol value)
431 (cond ((eq symbol 'newsticker-sort-method)
432 (when (fboundp 'newsticker--cache-sort)
433 (message "Applying new sort method...")
434 (newsticker--cache-sort)
435 (newsticker--buffer-set-uptodate nil)
436 (message "Applying new sort method...done")))
437 ((memq symbol '(newsticker-url-list-defaults
438 newsticker-url-list
439 newsticker-retrieval-interval))
440 (when (and (fboundp 'newsticker-running-p)
441 (newsticker-running-p))
442 (message "Restarting newsticker")
443 (newsticker-stop)
444 (newsticker-start)))
445 ((eq symbol 'newsticker-display-interval)
446 (when (and (fboundp 'newsticker-running-p)
447 (newsticker-running-p))
448 (message "Restarting ticker")
449 (newsticker-stop-ticker)
450 (newsticker-start-ticker)
451 (message "")))
452 ((memq symbol '(newsticker-hide-old-items-in-echo-area
453 newsticker-hide-obsolete-items-in-echo-area
454 newsticker-hide-immortal-items-in-echo-area))
455 (when (and (fboundp 'newsticker-running-p)
456 (newsticker-running-p))
457 (message "Restarting newsticker")
458 (newsticker-stop-ticker)
459 (newsticker--ticker-text-setup)
460 (newsticker-start-ticker)
461 (message "")))
462 ((memq symbol '(newsticker-hide-old-items-in-newsticker-buffer
463 newsticker-show-descriptions-of-new-items))
464 (when (fboundp 'newsticker--buffer-set-uptodate)
465 (newsticker--buffer-set-uptodate nil)))
466 ((memq symbol '(newsticker-heading-format
467 newsticker-item-format
468 newsticker-desc-format
469 newsticker-date-format
470 newsticker-statistics-format
471 newsticker-justification
472 newsticker-use-full-width
473 newsticker-html-renderer
474 newsticker-feed-face
475 newsticker-new-item-face
476 newsticker-old-item-face
477 newsticker-immortal-item-face
478 newsticker-obsolete-item-face
479 newsticker-date-face
480 newsticker-statistics-face
481 ;;newsticker-default-face
482 ))
483 (when (fboundp 'newsticker--forget-preformatted)
484 (newsticker--forget-preformatted)))
485 (t
486 (error "Ooops %s" symbol)))))
487
488;; customization group feed
489(defgroup newsticker-feed nil
490 "Settings for the RSS feeds."
491 :group 'newsticker)
492
493(defcustom newsticker-url-list-defaults
494 '(("Emacs Wiki"
495 "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
496 nil
497 3600))
498 "A customizable list of news feeds to select from.
499These were mostly extracted from the Radio Community Server at
500http://subhonker6.userland.com/rcsPublic/rssHotlist.
501
502You may add other entries in `newsticker-url-list'."
503 :type `(set ,@(mapcar `newsticker--splicer
504 newsticker--raw-url-list-defaults))
505 :set 'newsticker--set-customvar
506 :group 'newsticker-feed)
507
508(defcustom newsticker-url-list nil
509 "The news feeds which you like to watch.
510
511This alist will be used in addition to selection made customizing
512`newsticker-url-list-defaults'.
513
514This is an alist. Each element consists of two items: a LABEL and a URL,
515optionally followed by a START-TIME, INTERVAL specifier and WGET-ARGUMENTS.
516
517The LABEL gives the name of the news feed. It can be an arbitrary string.
518
519The URL gives the location of the news feed. It must point to a valid
520RSS file. The RSS file is retrieved by calling wget, or whatever you
521specify as `newsticker-wget-name'.
522
523The START-TIME can be either a string, or nil. If it is a string it
524specifies a fixed time at which this feed shall be retrieved for the
525first time. (Examples: \"11:00pm\", \"23:00\"). If it is nil (or
526unspecified), this feed will be retrieved immediately after calling
527`newsticker-start'.
528
529The INTERVAL specifies the time between retrievals for this feed. If it
530is nil (or unspecified) the default interval value as set in
531`newsticker-retrieval-interval' is used.
532
533\(newsticker.el calls `run-at-time'. The newsticker-parameters START-TIME
534and INTERVAL correspond to the `run-at-time'-parameters TIME and REPEAT.)
535
536WGET-ARGUMENTS specifies arguments for wget (see `newsticker-wget-name')
537which apply for this feed only, overriding the value of
538`newsticker-wget-arguments'."
539 :type '(repeat (list :tag "News feed"
540 (string :tag "Label")
541 (string :tag "URI")
542 (choice :tag "Start"
543 (const :tag "Default" nil)
544 (string :tag "Fixed Time"))
545 (choice :tag "Interval"
546 (const :tag "Default" nil)
547 (const :tag "Hourly" 3600)
548 (const :tag "Daily" 86400)
549 (integer :tag "Interval"))
550 (choice :tag "Wget Arguments"
551 (const :tag "Default arguments" nil)
552 (repeat :tag "Special arguments" string))))
553 :set 'newsticker--set-customvar
554 :group 'newsticker-feed)
555
556(defcustom newsticker-wget-name
557 "wget"
558 "Name of the program which is called to retrieve news from the web.
559The canonical choice is wget but you may take any other program which is
560able to return the contents of a news feed file on stdout."
561 :type 'string
562 :group 'newsticker-feed)
563
564(defcustom newsticker-wget-arguments
565 '("-q" "-O" "-")
566 "Arguments which are passed to wget.
567There is probably no reason to change the default settings, unless you
568are living behind a firewall."
569 :type '(repeat (string :tag "Argument"))
570 :group 'newsticker-feed)
571
572(defcustom newsticker-retrieval-interval
573 3600
574 "Time interval for retrieving new news items (seconds).
575If this value is not positive (i.e. less than or equal to 0)
576items are retrieved only once!
577Please note that some feeds, e.g. Slashdot, will ban you if you
578make it less than 1800 seconds (30 minutes)!"
579 :type '(choice :tag "Interval"
580 (const :tag "No automatic retrieval" 0)
581 (const :tag "Hourly" 3600)
582 (const :tag "Daily" 86400)
583 (integer :tag "Interval"))
584 :set 'newsticker--set-customvar
585 :group 'newsticker-feed)
586
587(defcustom newsticker-desc-comp-max
588 100
589 "Relevant length of headline descriptions.
590This value gives the maximum number of characters which will be
591taken into account when newsticker compares two headline
592descriptions."
593 :type 'integer
594 :group 'newsticker-feed)
595
596;; customization group behaviour
597(defgroup newsticker-headline-processing nil
598 "Settings for the automatic processing of RSS headlines."
599 :group 'newsticker)
600
601(defcustom newsticker-automatically-mark-items-as-old
602 t
603 "Decides whether to automatically mark items as old.
604If t a new item is considered as new only after its first retrieval. As
605soon as it is retrieved a second time, it becomes old. If not t all
606items stay new until you mark them as old. This is done in the
607*newsticker* buffer."
608 :type 'boolean
609 :group 'newsticker-headline-processing)
610
611(defcustom newsticker-automatically-mark-visited-items-as-old
612 t
613 "Decides whether to automatically mark visited items as old.
614If t an item is marked as old as soon as the associated link is
615visited, i.e. after pressing RET or mouse2 on the item's
616headline."
617
618 :type 'boolean
619 :group 'newsticker-headline-processing)
620
621(defcustom newsticker-keep-obsolete-items
622 t
623 "Decides whether to keep unread items which have been removed from feed.
624If t a new item, which has been removed from the feed, is kept in
625the cache until it is marked as read."
626 :type 'boolean
627 :group 'newsticker-headline-processing)
628
629(defcustom newsticker-obsolete-item-max-age
630 (* 60 60 24)
631 "Maximal age of obsolete items, in seconds.
632Obsolete items which are older than this value will be silently
633deleted at the next retrieval."
634 :type 'integer
635 :group 'newsticker-headline-processing)
636
637(defcustom newsticker-auto-mark-filter
638 nil
639 "A filter for automatically marking headlines.
640
641This is an alist of the form (FEED-NAME OLD-LIST IMMORTAL-LIST). I.e. each
642element consists of a FEED-NAME and two lists. Each list consists a set of
643regular expressions. The first list contains patterns of headlines which
644will be marked as old. The second list contains patterns of headlines which
645will be marked as immortal.
646
647This filter is checked after a new headline has been retrieved. If
648FEED-NAME matches the name of the corresponding news feed, both sublists
649are checked: If the title of the headline matches any of the regular
650expressions in OLD-LIST, this headline is marked as old, if it matches any
651of the expressions in IMMORTAL-LIST it is marked as immortal.
652
653If, for example, `newsticker-auto-mark-filter' looks like
654 \((slashdot (\"^Forget me!$\") (\"^Read me$\" \"important\")))
655then all articles from slashdot are marked as old if they have the title
656\"Forget me!\". All articles which have the title \"Read me\" and all
657articles which contain the string \"important\" in their title are marked
658as immortal."
659 :type '(repeat (list :tag "Feed filter rule"
660 (string :tag "Feed name")
661 ;;(choice ,@(mapcar (lambda (i)
662 ;; (list :tag (car i) (car i)))
663 ;; newsticker-url-list))
664 (repeat :tag "Mark as old" string)
665 (repeat :tag "Mark as immortal" string)))
666 :group 'newsticker-headline-processing)
667
668;; customization group layout
669(defgroup newsticker-layout nil
670 "Settings for layout of the RSS reader."
671 :group 'newsticker)
672
673(defcustom newsticker-sort-method
674 'sort-by-original-order
675 "Sort method for news items.
676The following sort methods are available:
677* `sort-by-original-order' keeps the order in which the items
678 appear in the RSS file (please note that for immortal items,
679 which have been removed from the news feed, there is no original
680 order),
681* `sort-by-time' looks at the time at which an item has been seen
682 the first time. The most recent item is put at top,
683* `sort-by-title' will put the items in an alphabetical order."
684 :type '(choice
685 (const :tag "Keep original order" sort-by-original-order)
686 (const :tag "Sort by time" sort-by-time)
687 (const :tag "Sort by title" sort-by-title))
688 :set 'newsticker--set-customvar
689 :group 'newsticker-layout)
690
691(defcustom newsticker-hide-old-items-in-newsticker-buffer
692 nil
693 "Decides whether to automatically hide old items in the *newsticker* buffer.
694If set to t old items will be completely folded and only new items
695will show up in the *newsticker* buffer. Otherwise old as well as new
696items will be visible."
697 :type 'boolean
698 :set 'newsticker--set-customvar
699 :group 'newsticker-layout)
700
701(defcustom newsticker-show-descriptions-of-new-items
702 t
703 "Whether to automatically show descriptions of new items in *newsticker*.
704If set to t old items will be folded and new items will be
705unfolded. Otherwise old as well as new items will be folded."
706 :type 'boolean
707 :set 'newsticker--set-customvar
708 :group 'newsticker-layout)
709
710(defcustom newsticker-heading-format
711 "%l
712%t %d %s"
713 "Format string for feed headings.
714The following printf-like specifiers can be used:
715%d The date the feed was retrieved. See `newsticker-date-format'.
716%l The logo (image) of the feed. Most RSS feeds provide a small
717 image as logo. Newsticker can display them, if Emacs can --
718 see `image-types' for a list of supported image types.
719%L The logo (image) of the feed. If the logo is not available
720 the title of the feed is used.
721%s The statistical data of the feed. See `newsticker-statistics-format'.
722%t The title of the feed, i.e. its name."
723 :type 'string
724 :set 'newsticker--set-customvar
725 :group 'newsticker-layout)
726
727(defcustom newsticker-item-format
728 "%t %d"
729 "Format string for news item headlines.
730The following printf-like specifiers can be used:
731%d The date the item was (first) retrieved. See `newsticker-date-format'.
732%l The logo (image) of the feed. Most RSS feeds provide a small
733 image as logo. Newsticker can display them, if Emacs can --
734 see `image-types' for a list of supported image types.
735%L The logo (image) of the feed. If the logo is not available
736 the title of the feed is used.
737%t The title of the item."
738 :type 'string
739 :set 'newsticker--set-customvar
740 :group 'newsticker-layout)
741
742(defcustom newsticker-desc-format
743 "%d %c"
744 "Format string for news descriptions (contents).
745The following printf-like specifiers can be used:
746%c The contents (description) of the item.
747%d The date the item was (first) retrieved. See `newsticker-date-format'."
748 :type 'string
749 :set 'newsticker--set-customvar
750 :group 'newsticker-layout)
751
752(defcustom newsticker-date-format
753 "(%A, %H:%M)"
754 "Format for the date part in item and feed lines.
755See `format-time-string' for a list of valid specifiers."
756 :type 'string
757 :set 'newsticker--set-customvar
758 :group 'newsticker-layout)
759
760(defcustom newsticker-statistics-format
761 "[%n + %i + %o + %O = %a]"
762 "Format for the statistics part in feed lines.
763The following printf-like specifiers can be used:
764%a The number of all items in the feed.
765%i The number of immortal items in the feed.
766%n The number of new items in the feed.
767%o The number of old items in the feed.
768%O The number of obsolete items in the feed."
769 :type 'string
770 :set 'newsticker--set-customvar
771 :group 'newsticker-layout)
772
773(defcustom newsticker-show-all-rss-elements
774 nil
775 "Show all RSS elements."
776 :type 'boolean
777 ;;:set 'newsticker--set-customvar
778 :group 'newsticker-layout)
779
780;; image related things
781(defcustom newsticker-enable-logo-manipulations
782 t
783 "If non-nil newsticker manipulates logo images.
784This enables the following image properties: heuristic mask for all
785logos, and laplace-conversion for images without new items."
786 :type 'boolean
787 :group 'newsticker-layout)
788
789
790;; rendering
791(defcustom newsticker-justification
792 'left
793 "How to fill item descriptions.
794If non-nil newsticker calls `fill-region' to wrap long lines in
795item descriptions. However, if an item description contains HTML
796text and `newsticker-html-renderer' is non-nil, filling is not
797done."
798 :type '(choice :tag "Justification"
799 (const :tag "No filling" nil)
800 (const :tag "Left" left)
801 (const :tag "Right" right)
802 (const :tag "Center" center)
803 (const :tag "Full" full))
804 :set 'newsticker--set-customvar
805 :group 'newsticker-layout)
806
807(defcustom newsticker-use-full-width
808 t
809 "Decides whether to use the full window width when filling.
810If non-nil newsticker sets `fill-column' so that the whole
811window is used when filling. See also `newsticker-justification'."
812 :type 'boolean
813 :set 'newsticker--set-customvar
814 :group 'newsticker-layout)
815
816(defcustom newsticker-html-renderer
817 nil
818 "Function for rendering HTML contents.
819If non-nil, newsticker.el will call this function whenever it finds
820HTML-like tags in item descriptions. Possible functions are, for
821example, `w3m-region', `w3-region', and (if you have htmlr.el installed)
822`newsticker-htmlr-render'.
823
824In order to make sure that the HTML renderer is loaded when you
825run newsticker, you should add one of the following statements to
826your .emacs. If you use w3m,
827
828 (autoload 'w3m-region \"w3m\"
829 \"Render region in current buffer and replace with result.\" t)
830
831or, if you use w3,
832
833 (require 'w3-auto)
834
835or, if you use htmlr
836
837 (require 'htmlr)"
838 :type '(choice :tag "Function"
839 (const :tag "None" nil)
840 (const :tag "w3" w3-region)
841 (const :tag "w3m" w3m-region)
842 (const :tag "htmlr" newsticker-htmlr-render))
843 :set 'newsticker--set-customvar
844 :group 'newsticker-layout)
845
846
847;; faces
848(defgroup newsticker-faces nil
849 "Settings for the faces of the RSS reader."
850 :group 'newsticker-layout)
851
852(defface newsticker-feed-face
853 '((((class color) (background dark))
854 (:family "helvetica" :bold t :height 1.2 :foreground "misty rose"))
855 (((class color) (background light))
856 (:family "helvetica" :bold t :height 1.2 :foreground "black")))
857 "Face for news feeds."
858 :group 'newsticker-faces)
859
860(defface newsticker-new-item-face
861 '((((class color) (background dark))
862 (:family "helvetica" :bold t))
863 (((class color) (background light))
864 (:family "helvetica" :bold t)))
865 "Face for old news items."
866 :group 'newsticker-faces)
867
868(defface newsticker-old-item-face
869 '((((class color) (background dark))
870 (:family "helvetica" :bold t :foreground "orange3"))
871 (((class color) (background light))
872 (:family "helvetica" :bold t :foreground "red4")))
873 "Face for old news items."
874 :group 'newsticker-faces)
875
876(defface newsticker-immortal-item-face
877 '((((class color) (background dark))
878 (:family "helvetica" :bold t :italic t :foreground "orange"))
879 (((class color) (background light))
880 (:family "helvetica" :bold t :italic t :foreground "blue")))
881 "Face for immortal news items."
882 :group 'newsticker-faces)
883
884(defface newsticker-obsolete-item-face
885 '((((class color) (background dark))
886 (:family "helvetica" :bold t :strike-through t))
887 (((class color) (background light))
888 (:family "helvetica" :bold t :strike-through t)))
889 "Face for old news items."
890 :group 'newsticker-faces)
891
892(defface newsticker-date-face
893 '((((class color) (background dark))
894 (:family "helvetica" :italic t :height 0.8))
895 (((class color) (background light))
896 (:family "helvetica" :italic t :height 0.8)))
897 "Face for newsticker dates."
898 :group 'newsticker-faces)
899
900(defface newsticker-statistics-face
901 '((((class color) (background dark))
902 (:family "helvetica" :italic t :height 0.8))
903 (((class color) (background light))
904 (:family "helvetica" :italic t :height 0.8)))
905 "Face for newsticker dates."
906 :group 'newsticker-faces)
907
908(defface newsticker-enclosure-face
909 '((((class color) (background dark))
910 (:bold t :background "orange"))
911 (((class color) (background light))
912 (:bold t :background "orange")))
913 "Face for enclosed elements."
914 :group 'newsticker-faces)
915
916(defface newsticker-extra-face
917 '((((class color) (background dark))
918 (:italic t :foreground "gray50" :height 0.8))
919 (((class color) (background light))
920 (:italic t :foreground "gray50" :height 0.8)))
921 "Face for newsticker dates."
922 :group 'newsticker-faces)
923
924;; (defface newsticker-default-face
925;; '((((class color) (background dark))
926;; (:inherit default))
927;; (((class color) (background light))
928;; (:inherit default)))
929;; "Face for the description of news items."
930;; ;;:set 'newsticker--set-customvar
931;; :group 'newsticker-faces)
932
933
934;; customization group ticker
935(defgroup newsticker-ticker nil
936 "Settings for the RSS ticker."
937 :group 'newsticker)
938
939(defcustom newsticker-display-interval
940 0.3
941 "Time interval for displaying news items in the echo area (seconds).
942If equal or less than 0 no messages are shown in the echo area. For
943smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems
944reasonable. For non-smooth display a value of 10 is a good starting
945point."
946 :type 'number
947 :set 'newsticker--set-customvar
948 :group 'newsticker-ticker)
949
950(defcustom newsticker-scroll-smoothly
951 t
952 "Decides whether to flash or scroll news items.
953If t the news headlines are scrolled (more-or-less) smoothly in the echo
954area. If nil one headline after another is displayed in the echo area.
955The variable `newsticker-display-interval' determines how fast this
956display moves/changes and whether headlines are shown in the echo area
957at all. If you change `newsticker-scroll-smoothly' you should also change
958`newsticker-display-interval'."
959 :type 'boolean
960 :group 'newsticker-ticker)
961
962(defcustom newsticker-hide-immortal-items-in-echo-area
963 t
964 "Decides whether to show immortal/non-expiring news items in the ticker.
965If t the echo area will not show immortal items. See also
966`newsticker-hide-old-items-in-echo-area."
967 :type 'boolean
968 :set 'newsticker--set-customvar
969 :group 'newsticker-ticker)
970
971(defcustom newsticker-hide-old-items-in-echo-area
972 t
973 "Decides whether to show only the newest news items in the ticker.
974If t the echo area will show only new items, i.e. only items which have
975been added between the last two retrievals."
976 :type 'boolean
977 :set 'newsticker--set-customvar
978 :group 'newsticker-ticker)
979
980(defcustom newsticker-hide-obsolete-items-in-echo-area
981 t
982 "Decides whether to show obsolete items items in the ticker.
983If t the echo area will not show obsolete items. See also
984`newsticker-hide-old-items-in-echo-area."
985 :type 'boolean
986 :set 'newsticker--set-customvar
987 :group 'newsticker-ticker)
988
989(defgroup newsticker-hooks nil
990 "Settings for newsticker hooks."
991 :group 'newsticker)
992
993(defcustom newsticker-start-hook
994 nil
995 "Hook run when starting newsticker.
996This hook is run at the very end of `newsticker-start'."
997 :options '(newsticker-start-ticker)
998 :type 'hook
999 :group 'newsticker-hooks)
1000
1001(defcustom newsticker-stop-hook
1002 nil
1003 "Hook run when stopping newsticker.
1004This hook is run at the very end of `newsticker-stop'."
1005 :options nil
1006 :type 'hook
1007 :group 'newsticker-hooks)
1008
1009(defcustom newsticker-new-item-functions
1010 nil
1011 "List of functions run after a new headline has been retrieved.
1012Each function is called with the following three arguments:
1013FEED the name of the corresponding news feed,
1014TITLE the title of the headline,
1015DESC the decoded description of the headline.
1016
1017See `newsticker-download-images', and
1018`newsticker-download-enclosures' for sample functions.
1019
1020Please note that these functions are called only once for a
1021headline after it has been retrieved for the first time."
1022 :type 'hook
1023 :options '(newsticker-download-images
1024 newsticker-download-enclosures)
1025 :group 'newsticker-hooks)
1026
1027(defcustom newsticker-select-item-hook
1028 'newsticker--buffer-make-item-completely-visible
1029 "List of functions run after a headline has been selected.
1030Each function is called after one of `newsticker-next-item',
1031`newsticker-next-new-item', `newsticker-previous-item',
1032`newsticker-previous-new-item' has been called.
1033
1034The default value 'newsticker--buffer-make-item-completely-visible
1035assures that the current item is always completely visible."
1036 :type 'hook
1037 :options '(newsticker--buffer-make-item-completely-visible)
1038 :group 'newsticker-hooks)
1039
1040(defcustom newsticker-select-feed-hook
1041 'newsticker--buffer-make-item-completely-visible
1042 "List of functions run after a feed has been selected.
1043Each function is called after one of `newsticker-next-feed', and
1044`newsticker-previous-feed' has been called.
1045
1046The default value 'newsticker--buffer-make-item-completely-visible
1047assures that the current feed is completely visible."
1048 :type 'hook
1049 :options '(newsticker--buffer-make-item-completely-visible)
1050 :group 'newsticker-hooks)
1051
1052(defcustom newsticker-buffer-change-hook
1053 'newsticker-w3m-show-inline-images
1054 "List of functions run after the newsticker buffer has been updated.
1055Each function is called after `newsticker-buffer-update' has been called.
1056
1057The default value '`newsticker-w3m-show-inline-images' loads inline
1058images."
1059 :type 'hook
1060 :group 'newsticker-hooks)
1061
1062(defcustom newsticker-narrow-hook
1063 'newsticker-w3m-show-inline-images
1064 "List of functions run after narrowing in newsticker buffer has changed.
1065Each function is called after
1066`newsticker-toggle-auto-narrow-to-feed' or
1067`newsticker-toggle-auto-narrow-to-item' has been called.
1068
1069The default value '`newsticker-w3m-show-inline-images' loads inline
1070images."
1071 :type 'hook
1072 :group 'newsticker-hooks)
1073
1074(defgroup newsticker-miscellaneous nil
1075 "Miscellaneous newsticker settings."
1076 :group 'newsticker)
1077
1078(defcustom newsticker-cache-filename
1079 "~/.newsticker-cache"
1080 "Name of the newsticker cache file."
1081 :type 'string
1082 :group 'newsticker-miscellaneous)
1083
1084(defcustom newsticker-imagecache-dirname
1085 "~/.newsticker-images"
1086 "Name of the directory where newsticker stores cached images."
1087 :type 'string
1088 :group 'newsticker-miscellaneous)
1089
1090;; debugging
1091(defcustom newsticker-debug
1092 nil
1093 "Enables some features needed for debugging newsticker.el.
1094
1095If set to t newsticker.el will print lots of debugging messages, and the
1096buffers *newsticker-wget-<feed>* will not be closed."
1097 :type 'boolean
1098 ;;:set 'newsticker--set-customvar
1099 :group 'newsticker-miscellaneous)
1100
1101;; ======================================================================
1102;;; Compatibility section, XEmacs, Emacs
1103;; ======================================================================
1104(unless (fboundp 'time-add)
1105 (require 'time-date);;FIXME
1106 (defun time-add (t1 t2)
1107 (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2)))))
1108
1109(unless (fboundp 'match-string-no-properties)
1110 (defalias 'match-string-no-properties 'match-string))
1111
1112(unless (fboundp 'replace-regexp-in-string)
1113 (defun replace-regexp-in-string (re rp st)
1114 (save-match-data ;; apparently XEmacs needs save-match-data
1115 (replace-in-string st re rp))))
1116
1117;; copied from subr.el
1118(unless (fboundp 'add-to-invisibility-spec)
1119 (defun add-to-invisibility-spec (arg)
1120 "Add elements to `buffer-invisibility-spec'.
1121See documentation for `buffer-invisibility-spec' for the kind of elements
1122that can be added."
1123 (if (eq buffer-invisibility-spec t)
1124 (setq buffer-invisibility-spec (list t)))
1125 (setq buffer-invisibility-spec
1126 (cons arg buffer-invisibility-spec))))
1127
1128;; copied from subr.el
1129(unless (fboundp 'remove-from-invisibility-spec)
1130 (defun remove-from-invisibility-spec (arg)
1131 "Remove elements from `buffer-invisibility-spec'."
1132 (if (consp buffer-invisibility-spec)
1133 (setq buffer-invisibility-spec (delete arg buffer-invisibility-spec)))))
1134
1135;; ======================================================================
1136;;; Internal variables
1137;; ======================================================================
1138(defvar newsticker--display-timer nil
1139 "Timer for newsticker display.")
1140(defvar newsticker--retrieval-timer-list nil
1141 "List of timers for news retrieval.
1142This is an alist, each element consisting of (feed-name . timer)")
1143(defvar newsticker--item-list nil
1144 "List of newsticker items.")
1145(defvar newsticker--item-position 0
1146 "Actual position in list of newsticker items.")
1147(defvar newsticker--prev-message "There was no previous message yet!"
1148 "Last message that the newsticker displayed.")
1149(defvar newsticker--scrollable-text ""
1150 "The text which is scrolled smoothly in the echo area.")
1151(defvar newsticker--buffer-uptodate-p nil
1152 "Tells whether the newsticker buffer is up to date.")
1153(defvar newsticker--latest-update-time (current-time)
1154 "The time at which the latest news arrived.")
1155
1156(defvar newsticker--cache nil "Cached newsticker data.
1157This is a list of the form
1158
1159 ((label1
1160 (title description link time age index preformatted-contents
1161 preformatted-title)
1162 ...)
1163 (label2
1164 (title description link time age index preformatted-contents
1165 preformatted-title)
1166 ...)
1167 ...)
1168
1169where LABEL is a symbol. TITLE, DESCRIPTION, and LINK are
1170strings. TIME is a time value as returned by `current-time'.
1171AGE is a symbol: 'new, 'old, 'immortal, and 'obsolete denote
1172ordinary news items, whereas 'feed denotes an item which is not a
1173headline but describes the feed itself. INDEX denotes the
1174original position of the item -- used for restoring the original
1175order. PREFORMATTED-CONTENTS and PREFORMATTED-TITLE hold the
1176formatted contents of the item's description and title. This
1177speeds things up if HTML rendering is used, which is rather
1178slow.")
1179
1180(defvar newsticker--auto-narrow-to-feed nil
1181 "Automatically narrow to current news feed.
1182If non-nil only the items of the current news feed are visible.")
1183
1184(defvar newsticker--auto-narrow-to-item nil
1185 "Automatically narrow to current news item.
1186If non-nil only the current headline is visible.")
1187
1188(defconst newsticker--error-headline
1189 "[COULD NOT DOWNLOAD HEADLINES!]"
1190 "Title of error headline which will be inserted if news retrieval fails.")
1191
1192;; ======================================================================
1193;;; Toolbar
1194;; ======================================================================
1195(defconst newsticker--next-item-image
1196 (if (fboundp 'create-image)
1197 (create-image "/* XPM */
1198static char * next_xpm[] = {
1199\"24 24 42 1\",
1200\" c None\",
1201\". c #000000\",
1202\"+ c #7EB6DE\",
1203\"@ c #82BBE2\",
1204\"# c #85BEE4\",
1205\"$ c #88C1E7\",
1206\"% c #8AC3E8\",
1207\"& c #87C1E6\",
1208\"* c #8AC4E9\",
1209\"= c #8CC6EA\",
1210\"- c #8CC6EB\",
1211\"; c #88C2E7\",
1212\"> c #8BC5E9\",
1213\", c #8DC7EB\",
1214\"' c #87C0E6\",
1215\") c #8AC4E8\",
1216\"! c #8BC5EA\",
1217\"~ c #8BC4E9\",
1218\"{ c #88C1E6\",
1219\"] c #89C3E8\",
1220\"^ c #86BFE5\",
1221\"/ c #83BBE2\",
1222\"( c #82BBE1\",
1223\"_ c #86C0E5\",
1224\": c #87C0E5\",
1225\"< c #83BCE2\",
1226\"[ c #81B9E0\",
1227\"} c #81BAE1\",
1228\"| c #78B0D9\",
1229\"1 c #7BB3DB\",
1230\"2 c #7DB5DD\",
1231\"3 c #7DB6DD\",
1232\"4 c #72A9D4\",
1233\"5 c #75ACD6\",
1234\"6 c #76AED7\",
1235\"7 c #77AFD8\",
1236\"8 c #6BA1CD\",
1237\"9 c #6EA4CF\",
1238\"0 c #6FA6D1\",
1239\"a c #6298C6\",
1240\"b c #659BC8\",
1241\"c c #5C91C0\",
1242\" \",
1243\" \",
1244\" . \",
1245\" .. \",
1246\" .+. \",
1247\" .@#. \",
1248\" .#$%. \",
1249\" .&*=-. \",
1250\" .;>,,,. \",
1251\" .;>,,,=. \",
1252\" .')!==~;. \",
1253\" .#{]*%;^/. \",
1254\" .(#_':#<. \",
1255\" .+[@</}. \",
1256\" .|1232. \",
1257\" .4567. \",
1258\" .890. \",
1259\" .ab. \",
1260\" .c. \",
1261\" .. \",
1262\" . \",
1263\" \",
1264\" \",
1265\" \"};
1266"
1267 'xpm t)
1268 "Image for the next item button."))
1269
1270(defconst newsticker--previous-item-image
1271 (if (fboundp 'create-image)
1272 (create-image "/* XPM */
1273static char * previous_xpm[] = {
1274\"24 24 39 1\",
1275\" c None\",
1276\". c #000000\",
1277\"+ c #7BB3DB\",
1278\"@ c #83BCE2\",
1279\"# c #7FB8DF\",
1280\"$ c #89C2E7\",
1281\"% c #86BFE5\",
1282\"& c #83BBE2\",
1283\"* c #8CC6EA\",
1284\"= c #8BC4E9\",
1285\"- c #88C2E7\",
1286\"; c #85BEE4\",
1287\"> c #8DC7EB\",
1288\", c #89C3E8\",
1289\"' c #8AC4E8\",
1290\") c #8BC5EA\",
1291\"! c #88C1E6\",
1292\"~ c #8AC4E9\",
1293\"{ c #8AC3E8\",
1294\"] c #86C0E5\",
1295\"^ c #87C0E6\",
1296\"/ c #87C0E5\",
1297\"( c #82BBE2\",
1298\"_ c #81BAE1\",
1299\": c #7FB7DF\",
1300\"< c #7DB6DD\",
1301\"[ c #7DB5DD\",
1302\"} c #7CB4DC\",
1303\"| c #79B1DA\",
1304\"1 c #76ADD7\",
1305\"2 c #77AFD8\",
1306\"3 c #73AAD4\",
1307\"4 c #70A7D1\",
1308\"5 c #6EA5D0\",
1309\"6 c #6CA2CE\",
1310\"7 c #689ECB\",
1311\"8 c #6399C7\",
1312\"9 c #6095C4\",
1313\"0 c #5C90C0\",
1314\" \",
1315\" \",
1316\" . \",
1317\" .. \",
1318\" .+. \",
1319\" .@#. \",
1320\" .$%&. \",
1321\" .*=-;. \",
1322\" .>>*,%. \",
1323\" .>>>*,%. \",
1324\" .')**=-;. \",
1325\" .;!,~{-%&. \",
1326\" .;]^/;@#. \",
1327\" .(@&_:+. \",
1328\" .<[}|1. \",
1329\" .2134. \",
1330\" .567. \",
1331\" .89. \",
1332\" .0. \",
1333\" .. \",
1334\" . \",
1335\" \",
1336\" \",
1337\" \"};
1338"
1339 'xpm t)
1340 "Image for the previous item button."))
1341
1342(defconst newsticker--previous-feed-image
1343 (if (fboundp 'create-image)
1344 (create-image "/* XPM */
1345static char * prev_feed_xpm[] = {
1346\"24 24 52 1\",
1347\" c None\",
1348\". c #000000\",
1349\"+ c #70A7D2\",
1350\"@ c #75ADD6\",
1351\"# c #71A8D3\",
1352\"$ c #79B1DA\",
1353\"% c #7BB3DB\",
1354\"& c #7DB5DD\",
1355\"* c #83BBE2\",
1356\"= c #7EB6DE\",
1357\"- c #78B0D9\",
1358\"; c #7FB7DE\",
1359\"> c #88C2E7\",
1360\", c #85BEE4\",
1361\"' c #80B9E0\",
1362\") c #80B8DF\",
1363\"! c #8CC6EA\",
1364\"~ c #89C3E8\",
1365\"{ c #86BFE5\",
1366\"] c #81BAE1\",
1367\"^ c #7CB4DC\",
1368\"/ c #7FB8DF\",
1369\"( c #8DC7EB\",
1370\"_ c #7BB3DC\",
1371\": c #7EB7DE\",
1372\"< c #8BC4E9\",
1373\"[ c #8AC4E9\",
1374\"} c #8AC3E8\",
1375\"| c #87C0E6\",
1376\"1 c #87C0E5\",
1377\"2 c #83BCE2\",
1378\"3 c #75ACD6\",
1379\"4 c #7FB7DF\",
1380\"5 c #77AED8\",
1381\"6 c #71A8D2\",
1382\"7 c #70A7D1\",
1383\"8 c #76ADD7\",
1384\"9 c #6CA2CE\",
1385\"0 c #699FCC\",
1386\"a c #73AAD4\",
1387\"b c #6BA1CD\",
1388\"c c #669CC9\",
1389\"d c #6298C5\",
1390\"e c #689ECB\",
1391\"f c #6499C7\",
1392\"g c #6095C3\",
1393\"h c #5C91C0\",
1394\"i c #5E93C2\",
1395\"j c #5B90C0\",
1396\"k c #588CBC\",
1397\"l c #578CBC\",
1398\"m c #5589BA\",
1399\" \",
1400\" \",
1401\" ... . \",
1402\" .+. .. \",
1403\" .@. .#. \",
1404\" .$. .%@. \",
1405\" .&. .*=-. \",
1406\" .;. .>,'%. \",
1407\" .). .!~{]^. \",
1408\" ./. .(!~{]_. \",
1409\" .:. .!!<>,'%. \",
1410\" .&. .~[}>{*=-. \",
1411\" .$. .|1,2/%@. \",
1412\" .3. .*]4%56. \",
1413\" .7. .^$8#9. \",
1414\" .0. .a7bc. \",
1415\" .d. .efg. \",
1416\" .h. .ij. \",
1417\" .k. .l. \",
1418\" .m. .. \",
1419\" ... . \",
1420\" \",
1421\" \",
1422\" \"};
1423"
1424 'xpm t)
1425 "Image for the previous feed button."))
1426
1427(defconst newsticker--next-feed-image
1428 (if (fboundp 'create-image)
1429 (create-image "/* XPM */
1430static char * next_feed_xpm[] = {
1431\"24 24 57 1\",
1432\" c None\",
1433\". c #000000\",
1434\"+ c #6CA2CE\",
1435\"@ c #75ADD6\",
1436\"# c #71A8D3\",
1437\"$ c #79B1DA\",
1438\"% c #7EB7DE\",
1439\"& c #7DB5DD\",
1440\"* c #81BAE1\",
1441\"= c #85BEE4\",
1442\"- c #78B0D9\",
1443\"; c #7FB7DE\",
1444\"> c #83BCE3\",
1445\", c #87C1E6\",
1446\"' c #8AC4E9\",
1447\") c #7BB3DB\",
1448\"! c #80B8DF\",
1449\"~ c #88C2E7\",
1450\"{ c #8BC5E9\",
1451\"] c #8DC7EB\",
1452\"^ c #7CB4DC\",
1453\"/ c #7FB8DF\",
1454\"( c #84BDE3\",
1455\"_ c #7BB3DC\",
1456\": c #83BCE2\",
1457\"< c #87C0E6\",
1458\"[ c #8AC4E8\",
1459\"} c #8BC5EA\",
1460\"| c #8CC6EA\",
1461\"1 c #88C1E6\",
1462\"2 c #89C3E8\",
1463\"3 c #8AC3E8\",
1464\"4 c #7EB6DE\",
1465\"5 c #82BBE1\",
1466\"6 c #86C0E5\",
1467\"7 c #87C0E5\",
1468\"8 c #75ACD6\",
1469\"9 c #7AB2DA\",
1470\"0 c #81B9E0\",
1471\"a c #82BBE2\",
1472\"b c #71A8D2\",
1473\"c c #70A7D1\",
1474\"d c #74ACD6\",
1475\"e c #699FCC\",
1476\"f c #6EA5D0\",
1477\"g c #72A9D4\",
1478\"h c #669CC9\",
1479\"i c #6298C5\",
1480\"j c #679DCA\",
1481\"k c #6BA1CD\",
1482\"l c #6095C3\",
1483\"m c #5C91C0\",
1484\"n c #5F94C2\",
1485\"o c #5B90C0\",
1486\"p c #588CBC\",
1487\"q c #578CBC\",
1488\"r c #5589BA\",
1489\" \",
1490\" \",
1491\" . ... \",
1492\" .. .+. \",
1493\" .@. .#. \",
1494\" .$%. .@. \",
1495\" .&*=. .-. \",
1496\" .;>,'. .). \",
1497\" .!=~{]. .^. \",
1498\" ./(~{]]. ._. \",
1499\" .%:<[}||. .). \",
1500\" .&*=12'3~. .-. \",
1501\" .$45=6<7. .@. \",
1502\" .8940a:. .b. \",
1503\" .cd-)&. .+. \",
1504\" .efg8. .h. \",
1505\" .ijk. .l. \",
1506\" .mn. .o. \",
1507\" .p. .q. \",
1508\" .. .r. \",
1509\" . ... \",
1510\" \",
1511\" \",
1512\" \"};
1513"
1514 'xpm t)
1515 "Image for the next feed button."))
1516
1517(defconst newsticker--mark-read-image
1518 (if (fboundp 'create-image)
1519 (create-image "/* XPM */
1520static char * mark_read_xpm[] = {
1521\"24 24 44 1\",
1522\" c None\",
1523\". c #C20000\",
1524\"+ c #BE0000\",
1525\"@ c #C70000\",
1526\"# c #CE0000\",
1527\"$ c #C90000\",
1528\"% c #BD0000\",
1529\"& c #CB0000\",
1530\"* c #D10000\",
1531\"= c #D70000\",
1532\"- c #D30000\",
1533\"; c #CD0000\",
1534\"> c #C60000\",
1535\", c #D40000\",
1536\"' c #DA0000\",
1537\") c #DE0000\",
1538\"! c #DB0000\",
1539\"~ c #D60000\",
1540\"{ c #D00000\",
1541\"] c #DC0000\",
1542\"^ c #E00000\",
1543\"/ c #E40000\",
1544\"( c #E10000\",
1545\"_ c #DD0000\",
1546\": c #D80000\",
1547\"< c #E50000\",
1548\"[ c #E70000\",
1549\"} c #E60000\",
1550\"| c #E20000\",
1551\"1 c #E90000\",
1552\"2 c #E80000\",
1553\"3 c #E30000\",
1554\"4 c #DF0000\",
1555\"5 c #D90000\",
1556\"6 c #CC0000\",
1557\"7 c #C10000\",
1558\"8 c #C30000\",
1559\"9 c #BF0000\",
1560\"0 c #B90000\",
1561\"a c #BC0000\",
1562\"b c #BB0000\",
1563\"c c #B80000\",
1564\"d c #B50000\",
1565\"e c #B70000\",
1566\" \",
1567\" \",
1568\" \",
1569\" . + \",
1570\" +@# $.% \",
1571\" &*= -;> \",
1572\" ,') !~{ \",
1573\" ]^/ (_: \",
1574\" (<[ }|) \",
1575\" <[1 2<| \",
1576\" }222[< \",
1577\" }}}< \",
1578\" 333| \",
1579\" _4^4)] \",
1580\" ~:' 5=- \",
1581\" 6{- *#$ \",
1582\" 7>$ @89 \",
1583\" 0a+ %bc \",
1584\" ddc edd \",
1585\" ddd ddd \",
1586\" d d \",
1587\" \",
1588\" \",
1589\" \"};
1590"
1591 'xpm t)
1592 "Image for the next feed button."))
1593
1594(defconst newsticker--mark-immortal-image
1595 (if (fboundp 'create-image)
1596 (create-image "/* XPM */
1597static char * mark_immortal_xpm[] = {
1598\"24 24 93 2\",
1599\" c None\",
1600\". c #171717\",
1601\"+ c #030303\",
1602\"@ c #000000\",
1603\"# c #181818\",
1604\"$ c #090909\",
1605\"% c #FFC960\",
1606\"& c #FFCB61\",
1607\"* c #FFCB62\",
1608\"= c #FFC961\",
1609\"- c #FFC75F\",
1610\"; c #FFC65E\",
1611\"> c #FFCA61\",
1612\", c #FFCD63\",
1613\"' c #FFCF65\",
1614\") c #FFD065\",
1615\"! c #FFCE64\",
1616\"~ c #FFC35C\",
1617\"{ c #FFC45D\",
1618\"] c #FFD166\",
1619\"^ c #FFD267\",
1620\"/ c #FFD368\",
1621\"( c #FFD167\",
1622\"_ c #FFC05A\",
1623\": c #010101\",
1624\"< c #040404\",
1625\"[ c #FFCC62\",
1626\"} c #FFD569\",
1627\"| c #FFD56A\",
1628\"1 c #FFC860\",
1629\"2 c #FFC25B\",
1630\"3 c #FFBB56\",
1631\"4 c #020202\",
1632\"5 c #060606\",
1633\"6 c #FFC15B\",
1634\"7 c #FFC85F\",
1635\"8 c #FFD469\",
1636\"9 c #FFD66A\",
1637\"0 c #FFBC57\",
1638\"a c #1B1B1B\",
1639\"b c #070707\",
1640\"c c #FFBA55\",
1641\"d c #FFB451\",
1642\"e c #FFB954\",
1643\"f c #FFB350\",
1644\"g c #FFB652\",
1645\"h c #FFBE58\",
1646\"i c #FFCD64\",
1647\"j c #FFD066\",
1648\"k c #FFC059\",
1649\"l c #FFB14E\",
1650\"m c #0B0B0B\",
1651\"n c #FFBB55\",
1652\"o c #FFC15A\",
1653\"p c #FFB552\",
1654\"q c #FFAD4B\",
1655\"r c #080808\",
1656\"s c #FFAF4C\",
1657\"t c #FFB853\",
1658\"u c #FFA948\",
1659\"v c #050505\",
1660\"w c #FFB04E\",
1661\"x c #FFB753\",
1662\"y c #FFBC56\",
1663\"z c #FFC55D\",
1664\"A c #FFC55E\",
1665\"B c #FFC45C\",
1666\"C c #FFBD57\",
1667\"D c #FFB854\",
1668\"E c #FFB34F\",
1669\"F c #FFAB4A\",
1670\"G c #FFA545\",
1671\"H c #FFAA49\",
1672\"I c #FFB04D\",
1673\"J c #FFB551\",
1674\"K c #FFBF58\",
1675\"L c #FFB24F\",
1676\"M c #FFAC4A\",
1677\"N c #FFA646\",
1678\"O c #FFA344\",
1679\"P c #FFA848\",
1680\"Q c #FFB14F\",
1681\"R c #FFAF4D\",
1682\"S c #FFA546\",
1683\"T c #FFA243\",
1684\"U c #FFA445\",
1685\"V c #FFAE4C\",
1686\"W c #FFA444\",
1687\"X c #FFA142\",
1688\"Y c #FF9F41\",
1689\"Z c #0A0A0A\",
1690\"` c #FF9E40\",
1691\" . c #FF9F40\",
1692\" \",
1693\" \",
1694\" \",
1695\" . + @ @ + # \",
1696\" $ @ % & * * = - + + \",
1697\" @ ; > , ' ) ' ! * - ~ @ \",
1698\" @ { > ! ] ^ / / ( ' * ; _ : \",
1699\" < _ ; [ ) / } | } / ] , 1 2 3 4 \",
1700\" 5 6 7 , ] 8 9 9 9 } ^ ! = ~ 0 a \",
1701\" b c 6 - , ] 8 9 9 9 } ^ ! % ~ 0 d 5 \",
1702\" : e _ ; * ) / 8 } } / ] , 1 2 3 f 5 \",
1703\" : g h { = i j ^ / ^ ] ! * ; k e l m \",
1704\" : f n o ; > , ' ) ' ! * - 2 0 p q r \",
1705\" : s g 0 6 ; % > * * = - ~ h t l u r \",
1706\" v u w x y k ~ z A z B o C D E F G b \",
1707\" 5 H I J e 0 h K h C c x L M N . \",
1708\" 4 O P q Q d g x g J L R H S T < \",
1709\" @ T U P F q V q M H N W X + \",
1710\" @ Y T O W G G W O X Y @ \",
1711\" 4 Z ` Y Y Y .` 4 4 \",
1712\" 5 : : @ @ Z \",
1713\" \",
1714\" \",
1715\" \"};
1716"
1717 'xpm t)
1718 "Image for the next feed button."))
1719
1720
1721(defconst newsticker--narrow-image
1722 (if (fboundp 'create-image)
1723 (create-image "/* XPM */
1724static char * narrow_xpm[] = {
1725\"24 24 48 1\",
1726\" c None\",
1727\". c #000000\",
1728\"+ c #969696\",
1729\"@ c #9E9E9E\",
1730\"# c #A4A4A4\",
1731\"$ c #AAAAAA\",
1732\"% c #AEAEAE\",
1733\"& c #B1B1B1\",
1734\"* c #B3B3B3\",
1735\"= c #B4B4B4\",
1736\"- c #B2B2B2\",
1737\"; c #AFAFAF\",
1738\"> c #ABABAB\",
1739\", c #A6A6A6\",
1740\"' c #A0A0A0\",
1741\") c #989898\",
1742\"! c #909090\",
1743\"~ c #73AAD4\",
1744\"{ c #7AB2DA\",
1745\"] c #7FB8DF\",
1746\"^ c #84BDE3\",
1747\"/ c #88C2E7\",
1748\"( c #8BC5E9\",
1749\"_ c #8DC7EB\",
1750\": c #8CC6EA\",
1751\"< c #89C3E8\",
1752\"[ c #86BFE5\",
1753\"} c #81BAE1\",
1754\"| c #7BB3DC\",
1755\"1 c #75ACD6\",
1756\"2 c #6DA4CF\",
1757\"3 c #979797\",
1758\"4 c #A3A3A3\",
1759\"5 c #A8A8A8\",
1760\"6 c #ADADAD\",
1761\"7 c #ACACAC\",
1762\"8 c #A9A9A9\",
1763\"9 c #A5A5A5\",
1764\"0 c #9A9A9A\",
1765\"a c #929292\",
1766\"b c #8C8C8C\",
1767\"c c #808080\",
1768\"d c #818181\",
1769\"e c #838383\",
1770\"f c #848484\",
1771\"g c #858585\",
1772\"h c #868686\",
1773\"i c #828282\",
1774\" \",
1775\" \",
1776\" \",
1777\" .................. \",
1778\" .+@#$%&*=*-;>,')!. \",
1779\" .................. \",
1780\" \",
1781\" \",
1782\" .................. \",
1783\" .~{]^/(___:<[}|12. \",
1784\" .................. \",
1785\" \",
1786\" \",
1787\" .................. \",
1788\" .!3@45>666789'0ab. \",
1789\" .................. \",
1790\" \",
1791\" \",
1792\" .................. \",
1793\" .cccdefghhgficccc. \",
1794\" .................. \",
1795\" \",
1796\" \",
1797\" \"};
1798"
1799 'xpm t)
1800 "Image for the next feed button."))
1801
1802(defconst newsticker--get-all-image
1803 (if (fboundp 'create-image)
1804 (create-image "/* XPM */
1805static char * get_all_xpm[] = {
1806\"24 24 70 1\",
1807\" c None\",
1808\". c #000000\",
1809\"+ c #F3DA00\",
1810\"@ c #F5DF00\",
1811\"# c #F7E300\",
1812\"$ c #F9E700\",
1813\"% c #FAEA00\",
1814\"& c #FBEC00\",
1815\"* c #FBED00\",
1816\"= c #FCEE00\",
1817\"- c #FAEB00\",
1818\"; c #F9E800\",
1819\"> c #F8E500\",
1820\", c #F6E000\",
1821\"' c #F4DB00\",
1822\") c #F1D500\",
1823\"! c #EFD000\",
1824\"~ c #B7CA00\",
1825\"{ c #BFD100\",
1826\"] c #C5D700\",
1827\"^ c #CBDB00\",
1828\"/ c #CFDF00\",
1829\"( c #D2E200\",
1830\"_ c #D4E400\",
1831\": c #D3E300\",
1832\"< c #D0E000\",
1833\"[ c #CCDD00\",
1834\"} c #C7D800\",
1835\"| c #C1D300\",
1836\"1 c #BACC00\",
1837\"2 c #B1C500\",
1838\"3 c #A8BC00\",
1839\"4 c #20A900\",
1840\"5 c #22AF00\",
1841\"6 c #24B500\",
1842\"7 c #26B900\",
1843\"8 c #27BC00\",
1844\"9 c #27BE00\",
1845\"0 c #28BF00\",
1846\"a c #27BD00\",
1847\"b c #26BA00\",
1848\"c c #25B600\",
1849\"d c #23B100\",
1850\"e c #21AB00\",
1851\"f c #1FA400\",
1852\"g c #1C9B00\",
1853\"h c #21AA00\",
1854\"i c #24B300\",
1855\"j c #25B800\",
1856\"k c #25B700\",
1857\"l c #24B400\",
1858\"m c #23B000\",
1859\"n c #1FA500\",
1860\"o c #1D9E00\",
1861\"p c #20A800\",
1862\"q c #21AC00\",
1863\"r c #23B200\",
1864\"s c #22AD00\",
1865\"t c #1D9F00\",
1866\"u c #20A700\",
1867\"v c #1EA100\",
1868\"w c #1C9C00\",
1869\"x c #1DA000\",
1870\"y c #1B9800\",
1871\"z c #1A9600\",
1872\"A c #1A9700\",
1873\"B c #1A9500\",
1874\"C c #199200\",
1875\"D c #189100\",
1876\"E c #178C00\",
1877\" \",
1878\" \",
1879\" \",
1880\" \",
1881\" ................... \",
1882\" .+@#$%&*=*&-;>,')!. \",
1883\" ................... \",
1884\" \",
1885\" ................... \",
1886\" .~{]^/(___:<[}|123. \",
1887\" ................... \",
1888\" \",
1889\" ................... \",
1890\" .45678909abcdefg. \",
1891\" .h5icj7jklmeno. \",
1892\" .pq5drrmshft. \",
1893\" .fu4h4pnvw. \",
1894\" .oxvxtwy. \",
1895\" .zAAzB. \",
1896\" .CCD. \",
1897\" .E. \",
1898\" . \",
1899\" \",
1900\" \"};
1901"
1902 'xpm t)
1903 "Image for the next feed button."))
1904
1905
1906(defconst newsticker--update-image
1907 (if (fboundp 'create-image)
1908 (create-image "/* XPM */
1909static char * update_xpm[] = {
1910\"24 24 37 1\",
1911\" c None\",
1912\". c #076D00\",
1913\"+ c #0A8600\",
1914\"@ c #0A8800\",
1915\"# c #098400\",
1916\"$ c #087200\",
1917\"% c #087900\",
1918\"& c #098500\",
1919\"* c #098100\",
1920\"= c #087600\",
1921\"- c #097E00\",
1922\"; c #097F00\",
1923\"> c #0A8700\",
1924\", c #0A8C00\",
1925\"' c #097C00\",
1926\") c #098300\",
1927\"! c #0A8900\",
1928\"~ c #0A8E00\",
1929\"{ c #0B9200\",
1930\"] c #087700\",
1931\"^ c #076E00\",
1932\"/ c #076C00\",
1933\"( c #076B00\",
1934\"_ c #076A00\",
1935\": c #076900\",
1936\"< c #076800\",
1937\"[ c #066700\",
1938\"} c #066500\",
1939\"| c #066400\",
1940\"1 c #066300\",
1941\"2 c #066600\",
1942\"3 c #066200\",
1943\"4 c #076700\",
1944\"5 c #065E00\",
1945\"6 c #066100\",
1946\"7 c #065F00\",
1947\"8 c #066000\",
1948\" \",
1949\" \",
1950\" \",
1951\" . +@@@+# \",
1952\" $% &@ +* \",
1953\" =-# ; \",
1954\" %*>, ' \",
1955\" ')!~{ = \",
1956\" ]$ \",
1957\" ^ ^ \",
1958\" . . \",
1959\" / ( \",
1960\" _ : \",
1961\" < [ \",
1962\" } | \",
1963\" [[ \",
1964\" 1 $.:23 \",
1965\" 3 4}35 \",
1966\" 6 655 \",
1967\" 76 85 55 \",
1968\" 5555555 5 \",
1969\" \",
1970\" \",
1971\" \"};
1972"
1973 'xpm t)
1974 "Image for the update button."))
1975
1976(defconst newsticker--browse-image
1977 (if (fboundp 'create-image)
1978 (create-image "/* XPM */
1979static char * visit_xpm[] = {
1980\"24 24 39 1\",
1981\" c None\",
1982\". c #000000\",
1983\"+ c #FFFFFF\",
1984\"@ c #00E63D\",
1985\"# c #00E83E\",
1986\"$ c #00E73D\",
1987\"% c #00E93E\",
1988\"& c #00E63C\",
1989\"* c #00E53C\",
1990\"= c #00E23B\",
1991\"- c #00E33B\",
1992\"; c #00E83D\",
1993\"> c #00E13A\",
1994\", c #00DD38\",
1995\"' c #00DE38\",
1996\") c #00E23A\",
1997\"! c #00E43C\",
1998\"~ c #00DF39\",
1999\"{ c #00DB37\",
2000\"] c #00D634\",
2001\"^ c #00D734\",
2002\"/ c #00E039\",
2003\"( c #00DC37\",
2004\"_ c #00D835\",
2005\": c #00D332\",
2006\"< c #00CD2F\",
2007\"[ c #00DB36\",
2008\"} c #00D433\",
2009\"| c #00CF30\",
2010\"1 c #00DA36\",
2011\"2 c #00D936\",
2012\"3 c #00D533\",
2013\"4 c #00D131\",
2014\"5 c #00CE2F\",
2015\"6 c #00CC2F\",
2016\"7 c #00CA2D\",
2017\"8 c #00C62B\",
2018\"9 c #00C52A\",
2019\"0 c #00BE27\",
2020\" \",
2021\" \",
2022\" . \",
2023\" .+. \",
2024\" .+++. \",
2025\" .++.++. \",
2026\" .++.@.++. \",
2027\" .++.##$.++. \",
2028\" .++.%%%#&.++. \",
2029\" .++.$%%%#*=.++. \",
2030\" .++.-@;##$*>,.++. \",
2031\" .++.')!&@@*=~{].++. \",
2032\" .++.^{~>---)/(_:<.++. \",
2033\" .++.^[,~/~'(_}|.++. \",
2034\" .++.]_1[12^:|.++. \",
2035\" .++.:}33:45.++. \",
2036\" .++.<5567.++. \",
2037\" .++.889.++. \",
2038\" .++.0.++. \",
2039\" .++.++. \",
2040\" .+++. \",
2041\" .+. \",
2042\" . \",
2043\" \"};
2044"
2045 'xpm t)
2046 "Image for the browse button."))
2047
2048
2049(defvar newsticker-tool-bar-map
2050 (if (featurep 'xemacs)
2051 nil
2052 (let ((tool-bar-map (make-sparse-keymap)))
2053 (define-key tool-bar-map [newsticker-sep-1]
2054 (list 'menu-item "--double-line"))
2055 (define-key tool-bar-map [newsticker-browse-url]
2056 (list 'menu-item "newsticker-browse-url" 'newsticker-browse-url
2057 :visible t
2058 :help "Browse URL for item at point"
2059 :image newsticker--browse-image))
2060 (define-key tool-bar-map [newsticker-buffer-force-update]
2061 (list 'menu-item "newsticker-buffer-force-update"
2062 'newsticker-buffer-force-update
2063 :visible t
2064 :help "Update newsticker buffer"
2065 :image newsticker--update-image
2066 :enable '(not newsticker--buffer-uptodate-p)))
2067 (define-key tool-bar-map [newsticker-get-all-news]
2068 (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
2069 :visible t
2070 :help "Get news for all feeds"
2071 :image newsticker--get-all-image))
2072 (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
2073 (list 'menu-item "newsticker-mark-item-at-point-as-read"
2074 'newsticker-mark-item-at-point-as-read
2075 :visible t
2076 :image newsticker--mark-read-image
2077 :help "Mark current item as read"
2078 :enable '(newsticker-item-not-old-p)))
2079 (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
2080 (list 'menu-item "newsticker-mark-item-at-point-as-immortal"
2081 'newsticker-mark-item-at-point-as-immortal
2082 :visible t
2083 :image newsticker--mark-immortal-image
2084 :help "Mark current item as immortal"
2085 :enable '(newsticker-item-not-immortal-p)))
2086 (define-key tool-bar-map [newsticker-toggle-auto-narrow-to-feed]
2087 (list 'menu-item "newsticker-toggle-auto-narrow-to-feed"
2088 'newsticker-toggle-auto-narrow-to-feed
2089 :visible t
2090 :help "Toggle visibility of other feeds"
2091 :image newsticker--narrow-image))
2092 (define-key tool-bar-map [newsticker-next-feed]
2093 (list 'menu-item "newsticker-next-feed" 'newsticker-next-feed
2094 :visible t
2095 :help "Go to next feed"
2096 :image newsticker--next-feed-image
2097 :enable '(newsticker-next-feed-available-p)))
2098 (define-key tool-bar-map [newsticker-next-item]
2099 (list 'menu-item "newsticker-next-item" 'newsticker-next-item
2100 :visible t
2101 :help "Go to next item"
2102 :image newsticker--next-item-image
2103 :enable '(newsticker-next-item-available-p)))
2104 (define-key tool-bar-map [newsticker-previous-item]
2105 (list 'menu-item "newsticker-previous-item" 'newsticker-previous-item
2106 :visible t
2107 :help "Go to previous item"
2108 :image newsticker--previous-item-image
2109 :enable '(newsticker-previous-item-available-p)))
2110 (define-key tool-bar-map [newsticker-previous-feed]
2111 (list 'menu-item "newsticker-previous-feed" 'newsticker-previous-feed
2112 :visible t
2113 :help "Go to previous feed"
2114 :image newsticker--previous-feed-image
2115 :enable '(newsticker-previous-feed-available-p)))
2116 ;; standard icons / actions
2117 (tool-bar-add-item "close"
2118 'newsticker-close-buffer
2119 'newsticker-close-buffer
2120 :help "Close newsticker buffer")
2121 (tool-bar-add-item "preferences"
2122 'newsticker-customize
2123 'newsticker-customize
2124 :help "Customize newsticker")
2125 tool-bar-map)))
2126
2127;; ======================================================================
2128;;; Newsticker mode
2129;; ======================================================================
2130
2131(define-derived-mode newsticker-mode fundamental-mode
2132 "NewsTicker"
2133 "Viewing RSS news feeds in Emacs."
2134 (set (make-local-variable 'tool-bar-map) newsticker-tool-bar-map)
2135 (set (make-local-variable 'imenu-sort-function) nil)
2136 (set (make-local-variable 'scroll-conservatively) 999)
2137 (setq imenu-create-index-function 'newsticker--imenu-create-index)
2138 (setq imenu-default-goto-function 'newsticker--imenu-goto)
2139 (setq buffer-read-only t)
2140 (auto-fill-mode -1) ;; turn auto-fill off!
2141 (font-lock-mode -1) ;; turn off font-lock!!
2142 (set (make-local-variable 'font-lock-defaults) nil)
2143 (set (make-local-variable 'line-move-ignore-invisible) t)
2144 (setq mode-line-format
2145 (list "-"
2146 'mode-line-mule-info
2147 'mode-line-modified
2148 'mode-line-frame-identification
2149 " Newsticker ("
2150 '(newsticker--buffer-uptodate-p
2151 "up to date"
2152 "NEED UPDATE")
2153 ") -- "
2154 '(:eval (newsticker--buffer-get-feed-title-at-point))
2155 ": "
2156 '(:eval (newsticker--buffer-get-item-title-at-point))
2157 " %-"))
2158 (unless newsticker-show-all-rss-elements
2159 (add-to-invisibility-spec 'extra))
2160 (newsticker--buffer-set-uptodate nil))
2161
2162;; refine its mode-map
2163(define-key newsticker-mode-map "sO" 'newsticker-show-old-items)
2164(define-key newsticker-mode-map "hO" 'newsticker-hide-old-items)
2165(define-key newsticker-mode-map "sa" 'newsticker-show-all-desc)
2166(define-key newsticker-mode-map "ha" 'newsticker-hide-all-desc)
2167(define-key newsticker-mode-map "sf" 'newsticker-show-feed-desc)
2168(define-key newsticker-mode-map "hf" 'newsticker-hide-feed-desc)
2169(define-key newsticker-mode-map "so" 'newsticker-show-old-item-desc)
2170(define-key newsticker-mode-map "ho" 'newsticker-hide-old-item-desc)
2171(define-key newsticker-mode-map "sn" 'newsticker-show-new-item-desc)
2172(define-key newsticker-mode-map "hn" 'newsticker-hide-new-item-desc)
2173(define-key newsticker-mode-map "se" 'newsticker-show-entry)
2174(define-key newsticker-mode-map "he" 'newsticker-hide-entry)
2175(define-key newsticker-mode-map "sx" 'newsticker-show-extra)
2176(define-key newsticker-mode-map "hx" 'newsticker-hide-extra)
2177
2178(define-key newsticker-mode-map " " 'scroll-up)
2179(define-key newsticker-mode-map "q" 'newsticker-close-buffer)
2180(define-key newsticker-mode-map "p" 'newsticker-previous-item)
2181(define-key newsticker-mode-map "P" 'newsticker-previous-new-item)
2182(define-key newsticker-mode-map "F" 'newsticker-previous-feed)
2183(define-key newsticker-mode-map "\t" 'newsticker-next-item)
2184(define-key newsticker-mode-map "n" 'newsticker-next-item)
2185(define-key newsticker-mode-map "N" 'newsticker-next-new-item)
2186(define-key newsticker-mode-map "f" 'newsticker-next-feed)
2187(define-key newsticker-mode-map "M" 'newsticker-mark-all-items-as-read)
2188(define-key newsticker-mode-map "m"
2189 'newsticker-mark-all-items-at-point-as-read)
2190(define-key newsticker-mode-map "o" 'newsticker-mark-item-at-point-as-read)
2191(define-key newsticker-mode-map "G" 'newsticker-get-all-news)
2192(define-key newsticker-mode-map "g" 'newsticker-get-news-at-point)
2193(define-key newsticker-mode-map "u" 'newsticker-buffer-update)
2194(define-key newsticker-mode-map "U" 'newsticker-buffer-force-update)
2195(define-key newsticker-mode-map "a" 'newsticker-add-url)
2196
2197(define-key newsticker-mode-map "i"
2198 'newsticker-mark-item-at-point-as-immortal)
2199
2200(define-key newsticker-mode-map "xf" 'newsticker-toggle-auto-narrow-to-feed)
2201(define-key newsticker-mode-map "xi" 'newsticker-toggle-auto-narrow-to-item)
2202
2203;; maps for the clickable portions
2204(defvar newsticker--url-keymap (make-sparse-keymap)
2205 "Key map for click-able headings in the newsticker buffer.")
2206(define-key newsticker--url-keymap [mouse-2]
2207 'newsticker-mouse-browse-url)
2208(define-key newsticker--url-keymap "\n"
2209 'newsticker-browse-url)
2210(define-key newsticker--url-keymap "\C-m"
2211 'newsticker-browse-url)
2212(define-key newsticker--url-keymap [(control return)]
2213 'newsticker-handle-url)
2214
2215;; newsticker menu
2216(defvar newsticker-menu (make-sparse-keymap "Newsticker"))
2217
2218(define-key newsticker-menu [newsticker-browse-url]
2219 '("Browse URL for item at point" . newsticker-browse-url))
2220(define-key newsticker-menu [newsticker-separator-1]
2221 '("--"))
2222(define-key newsticker-menu [newsticker-buffer-update]
2223 '("Update buffer" . newsticker-buffer-update))
2224(define-key newsticker-menu [newsticker-separator-2]
2225 '("--"))
2226(define-key newsticker-menu [newsticker-get-all-news]
2227 '("Get news from all feeds" . newsticker-get-all-news))
2228(define-key newsticker-menu [newsticker-get-news-at-point]
2229 '("Get news from feed at point" . newsticker-get-news-at-point))
2230(define-key newsticker-menu [newsticker-separator-3]
2231 '("--"))
2232(define-key newsticker-menu [newsticker-mark-all-items-as-read]
2233 '("Mark all items as read" . newsticker-mark-all-items-as-read))
2234(define-key newsticker-menu [newsticker-mark-all-items-at-point-as-read]
2235 '("Mark all items in feed at point as read" .
2236 newsticker-mark-all-items-at-point-as-read))
2237(define-key newsticker-menu [newsticker-mark-item-at-point-as-read]
2238 '("Mark item at point as read" .
2239 newsticker-mark-item-at-point-as-read))
2240(define-key newsticker-menu [newsticker-mark-item-at-point-as-immortal]
2241 '("Toggle immortality for item at point" .
2242 newsticker-mark-item-at-point-as-immortal))
2243(define-key newsticker-menu [newsticker-separator-4]
2244 '("--"))
2245(define-key newsticker-menu [newsticker-hide-old-items]
2246 '("Hide old items" . newsticker-hide-old-items))
2247(define-key newsticker-menu [newsticker-show-old-items]
2248 '("Show old items" . newsticker-show-old-items))
2249(define-key newsticker-menu [newsticker-next-item]
2250 '("Go to next item" . newsticker-next-item))
2251(define-key newsticker-menu [newsticker-previous-item]
2252 '("Go to previous item" . newsticker-previous-item))
2253
2254;; bind menu to mouse
2255(define-key newsticker-mode-map [down-mouse-3] newsticker-menu)
2256;; Put menu in menu-bar
2257(define-key newsticker-mode-map [menu-bar Newsticker]
2258 (cons "Newsticker" newsticker-menu))
2259
2260
2261;; ======================================================================
2262;;; shortcuts
2263;; ======================================================================
2264(defsubst newsticker--title (item)
2265 "Return title of ITEM."
2266 (nth 0 item))
2267(defsubst newsticker--desc (item)
2268 "Return description of ITEM."
2269 (nth 1 item))
2270(defsubst newsticker--link (item)
2271 "Return link of ITEM."
2272 (nth 2 item))
2273(defsubst newsticker--time (item)
2274 "Return time of ITEM."
2275 (nth 3 item))
2276(defsubst newsticker--age (item)
2277 "Return age of ITEM."
2278 (nth 4 item))
2279(defsubst newsticker--pos (item)
2280 "Return position/index of ITEM."
2281 (nth 5 item))
2282(defsubst newsticker--preformatted-contents (item)
2283 "Return pre-formatted text of ITEM."
2284 (nth 6 item))
2285(defsubst newsticker--preformatted-title (item)
2286 "Return pre-formatted title of ITEM."
2287 (nth 7 item))
2288(defsubst newsticker--extra (item)
2289 "Return extra attributes of ITEM."
2290 (nth 8 item))
2291(defsubst newsticker--guid (item)
2292 "Return guid of ITEM."
2293 (let ((guid (assoc 'guid (newsticker--extra item))))
2294 (if (stringp guid)
2295 guid
2296 (car (xml-node-children guid)))))
2297(defsubst newsticker--enclosure (item)
2298 "Return enclosure element of ITEM in the form \(...FIXME...\)or nil."
2299 (let ((enclosure (assoc 'enclosure (newsticker--extra item))))
2300 (if enclosure
2301 (xml-node-attributes enclosure))))
2302
2303;; ======================================================================
2304;;; User fun
2305;; ======================================================================
2306
2307(defun newsticker-start (&optional do-not-complain-if-running)
2308 "Start the newsticker.
2309Start the timers for display and retrieval. If the newsticker, i.e. the
2310timers, are running already a warning message is printed unless
2311DO-NOT-COMPLAIN-IF-RUNNING is not nil.
2312Run `newsticker-start-hook' if newsticker was not running already."
2313 (interactive)
2314 (let ((running (newsticker-running-p)))
2315 ;; read old cache if it exists and newsticker is not running
2316 (unless running
2317 (let* ((coding-system-for-read 'utf-8)
2318 (buf (find-file-noselect newsticker-cache-filename)))
2319 (when buf
2320 (set-buffer buf)
2321 (goto-char (point-min))
2322 (condition-case nil
2323 (setq newsticker--cache (read buf))
2324 (error
2325 (message "Error while reading newsticker cache file!")
2326 (setq newsticker--cache nil))))))
2327 ;; start retrieval timers -- for sake of simplicity we will start
2328 ;; one timer for each feed
2329 (mapc (lambda (item)
2330 (let* ((feed-name (car item))
2331 (start-time (nth 2 item))
2332 (interval (or (nth 3 item)
2333 newsticker-retrieval-interval))
2334 (timer (assoc (car item)
2335 newsticker--retrieval-timer-list)))
2336 (if timer
2337 (or do-not-complain-if-running
2338 (message "Timer for %s is running already!"
2339 feed-name))
2340 (newsticker--debug-msg "Starting timer for %s: %s, %d"
2341 feed-name start-time interval)
2342 ;; do not repeat retrieval if interval not positive
2343 (if (<= interval 0)
2344 (setq interval nil))
2345 ;; Suddenly XEmacs doesn't like start-time 0
2346 (if (or (not start-time)
2347 (and (numberp start-time) (= start-time 0)))
2348 (setq start-time 1))
2349 (message "start-time %s" start-time)
2350 (setq timer (run-at-time start-time interval
2351 'newsticker-get-news feed-name))
2352 (if interval
2353 (add-to-list 'newsticker--retrieval-timer-list
2354 (cons feed-name timer))))))
2355 (append newsticker-url-list-defaults newsticker-url-list))
2356 (unless running
2357 (run-hooks 'newsticker-start-hook)
2358 (message "Newsticker started!"))))
2359
2360(defun newsticker-start-ticker ()
2361 "Start newsticker's ticker (but not the news retrieval.
2362Start display timer for the actual ticker if wanted and not
2363running already."
2364 (interactive)
2365 (if (and (> newsticker-display-interval 0)
2366 (not newsticker--display-timer))
2367 (setq newsticker--display-timer
2368 (run-at-time newsticker-display-interval
2369 newsticker-display-interval
2370 'newsticker--display-tick))))
2371
2372(defun newsticker-stop ()
2373 "Stop the newsticker and the newsticker-ticker.
2374Cancel the timers for display and retrieval. Run `newsticker-stop-hook'
2375if newsticker has been running."
2376 (interactive)
2377 (newsticker--cache-update t)
2378 (newsticker-stop-ticker)
2379 (when (newsticker-running-p)
2380 (mapc (lambda (name-and-timer)
2381 (cancel-timer (cdr name-and-timer)))
2382 newsticker--retrieval-timer-list)
2383 (setq newsticker--retrieval-timer-list nil)
2384 (run-hooks 'newsticker-stop-hook)
2385 (message "Newsticker stopped!")))
2386
2387(defun newsticker-stop-ticker ()
2388 "Stop newsticker's ticker (but not the news retrieval)."
2389 (interactive)
2390 (when newsticker--display-timer
2391 (cancel-timer newsticker--display-timer)
2392 (setq newsticker--display-timer nil)))
2393
2394;; the functions we need for retrieval and display
2395(defun newsticker-show-news ()
2396 "Switch to newsticker buffer. You may want to bind this to a key."
2397 (interactive)
2398 (newsticker-start t) ;; will start only if not running
2399 (newsticker-buffer-update)
2400 (switch-to-buffer "*newsticker*"))
2401
2402(defun newsticker-buffer-force-update ()
2403 "Update the newsticker buffer, even if not necessary."
2404 (interactive)
2405 (newsticker-buffer-update t))
2406
2407(defun newsticker-buffer-update (&optional force)
2408 "Update the *newsticker* buffer.
2409Unless FORCE is t this is donly only if necessary, i.e. when the
2410*newsticker* buffer is not up-to-date."
2411 (interactive)
2412 ;; bring cache data into proper order....
2413 (newsticker--cache-sort)
2414 ;; fill buffer
2415 (save-excursion
2416 (let ((buf (get-buffer "*newsticker*")))
2417 (if buf
2418 (switch-to-buffer buf)
2419 (switch-to-buffer (get-buffer-create "*newsticker*"))
2420 (newsticker--buffer-set-uptodate nil)))
2421 (when (or force
2422 (not newsticker--buffer-uptodate-p))
2423 (message "Preparing newsticker buffer...")
2424 (setq buffer-undo-list t)
2425 (let ((inhibit-read-only t))
2426 (set-buffer-modified-p nil)
2427 (erase-buffer)
2428 (newsticker-mode)
2429 ;; Emacs 21.3.50 does not care if we turn off auto-fill in the
2430 ;; definition of newsticker-mode, so we do it here (again)
2431 (auto-fill-mode -1)
2432
2433 (set-buffer-file-coding-system 'utf-8)
2434
2435 (if newsticker-use-full-width
2436 (set (make-local-variable 'fill-column) (1- (window-width))))
2437 (newsticker--buffer-insert-all-items)
2438
2439 ;; FIXME: needed for methods buffer in ecb
2440 ;; (set-visited-file-name "*newsticker*")
2441
2442 (set-buffer-modified-p nil)
2443 (newsticker-hide-all-desc)
2444 (if newsticker-hide-old-items-in-newsticker-buffer
2445 (newsticker-hide-old-items))
2446 (if newsticker-show-descriptions-of-new-items
2447 (newsticker-show-new-item-desc))
2448 )
2449 (message ""))
2450 (newsticker--buffer-set-uptodate t)
2451 (run-hooks 'newsticker-buffer-change-hook)))
2452
2453(defun newsticker-get-all-news ()
2454 "Launch retrieval of news from all configured newsticker sites.
2455This does NOT start the retrieval timers."
2456 (interactive)
2457 ;; launch retrieval of news
2458 (mapc (lambda (item)
2459 (newsticker-get-news (car item)))
2460 (append newsticker-url-list-defaults newsticker-url-list)))
2461
2462(defun newsticker-get-news-at-point ()
2463 "Launch retrieval of news for the feed point is in.
2464This does NOT start the retrieval timers."
2465 (interactive)
2466 ;; launch retrieval of news
2467 (let ((feed (get-text-property (point) 'feed)))
2468 (when feed
2469 (newsticker--debug-msg "Getting news for %s" (symbol-name feed))
2470 (newsticker-get-news (symbol-name feed)))))
2471
2472(defun newsticker-add-url (url name)
2473 "Add given URL under given NAME to `newsticker-url-list'.
2474If URL is nil it is searched at point."
2475 (interactive
2476 (list
2477 (read-string "URL: "
2478 (save-excursion
2479 (end-of-line)
2480 (and
2481 (re-search-backward
2482 "http://"
2483 (if (> (point) (+ (point-min) 100))
2484 (- (point) 100)
2485 (point-min))
2486 t)
2487 (re-search-forward
2488 "http://[-a-zA-Z0-9&/_.]*"
2489 (if (< (point) (- (point-max) 200))
2490 (+ (point) 200)
2491 (point-max))
2492 t)
2493 (buffer-substring-no-properties (match-beginning 0)
2494 (match-end 0)))))
2495 (read-string "Name: ")))
2496 (add-to-list 'newsticker-url-list (list name url nil nil nil) t)
2497 (customize-variable 'newsticker-url-list))
2498
2499(defun newsticker-w3m-show-inline-images ()
2500 "Show inline images in visible text ranges.
2501In-line images in invisible text ranges are hidden. This function
2502calls `w3m-toggle-inline-image'. It works only if
2503`newsticker-html-renderer' is set to `w3m-region'"
2504 (interactive)
2505 (if (eq newsticker-html-renderer 'w3m-region)
2506 (let ((inhibit-read-only t))
2507 (save-excursion
2508 (save-restriction
2509 (widen)
2510 (goto-char (point-min))
2511 (let ((pos (point)))
2512 (while pos
2513 (setq pos (next-single-property-change pos 'w3m-image))
2514 (when pos
2515 (goto-char pos)
2516 (when (get-text-property pos 'w3m-image)
2517 (let ((invis (newsticker--lists-intersect-p
2518 (get-text-property (1- (point)) 'invisible)
2519 buffer-invisibility-spec)))
2520 (if invis
2521 (w3m-remove-image
2522 pos (next-single-property-change pos 'w3m-image))
2523 (w3m-toggle-inline-image t))))))))))))
2524
2525;; ======================================================================
2526;;; keymap stuff
2527;; ======================================================================
2528(defun newsticker-close-buffer ()
2529 "Close the newsticker buffer."
2530 (interactive)
2531 (newsticker--cache-update t)
2532 (bury-buffer))
2533
2534(defun newsticker-next-new-item (&optional do-not-wrap-at-eob)
2535 "Go to next new news item.
2536If no new item is found behind point, search is continued at
2537beginning of buffer unless optional argument DO-NOT-WRAP-AT-EOB
2538is non-nil."
2539 (interactive)
2540 (widen)
2541 (let ((go-ahead t))
2542 (while go-ahead
2543 (unless (newsticker--buffer-goto '(item) 'new)
2544 ;; found nothing -- wrap
2545 (unless do-not-wrap-at-eob
2546 (goto-char (point-min))
2547 (newsticker-next-new-item t))
2548 (setq go-ahead nil))
2549 (unless (newsticker--lists-intersect-p
2550 (get-text-property (point) 'invisible)
2551 buffer-invisibility-spec)
2552 ;; this item is invisible -- continue search
2553 (setq go-ahead nil))))
2554 (run-hooks 'newsticker-select-item-hook)
2555 (point))
2556
2557(defun newsticker-previous-new-item (&optional do-not-wrap-at-bob)
2558 "Go to previous new news item.
2559If no new item is found before point, search is continued at
2560beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
2561is non-nil."
2562 (interactive)
2563 (widen)
2564 (let ((go-ahead t))
2565 (while go-ahead
2566 (unless (newsticker--buffer-goto '(item) 'new t)
2567 (unless do-not-wrap-at-bob
2568 (goto-char (point-max))
2569 (newsticker--buffer-goto '(item) 'new t)))
2570 (unless (newsticker--lists-intersect-p
2571 (get-text-property (point) 'invisible)
2572 buffer-invisibility-spec)
2573 (setq go-ahead nil))))
2574 (run-hooks 'newsticker-select-item-hook)
2575 (point))
2576
2577(defun newsticker-next-item (&optional do-not-wrap-at-eob)
2578 "Go to next news item.
2579Return new buffer position.
2580If no item is found below point, search is continued at beginning
2581of buffer unless optional argument DO-NOT-WRAP-AT-EOB is
2582non-nil."
2583 (interactive)
2584 (widen)
2585 (let ((go-ahead t)
2586 (search-list '(item)))
2587 (if newsticker--auto-narrow-to-item
2588 (setq search-list '(item feed)))
2589 (while go-ahead
2590 (unless (newsticker--buffer-goto search-list)
2591 ;; found nothing -- wrap
2592 (unless do-not-wrap-at-eob
2593 (goto-char (point-min)))
2594 (setq go-ahead nil))
2595 (unless (newsticker--lists-intersect-p
2596 (get-text-property (point) 'invisible)
2597 buffer-invisibility-spec)
2598 (setq go-ahead nil))))
2599 (run-hooks 'newsticker-select-item-hook)
2600 (point))
2601
2602(defun newsticker-previous-item (&optional do-not-wrap-at-bob)
2603 "Go to previous news item.
2604Return new buffer position.
2605If no item is found before point, search is continued at
2606beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
2607is non-nil."
2608 (interactive)
2609 (widen)
2610 (let ((go-ahead t)
2611 (search-list '(item)))
2612 (if newsticker--auto-narrow-to-item
2613 (setq search-list '(item feed)))
2614 (when (bobp)
2615 (unless do-not-wrap-at-bob
2616 (goto-char (point-max))))
2617 (while go-ahead
2618 (if (newsticker--buffer-goto search-list nil t)
2619 (unless (newsticker--lists-intersect-p
2620 (get-text-property (point) 'invisible)
2621 buffer-invisibility-spec)
2622 (setq go-ahead nil))
2623 (goto-char (point-min))
2624 (setq go-ahead nil))))
2625 (run-hooks 'newsticker-select-item-hook)
2626 (point))
2627
2628(defun newsticker-next-feed ()
2629 "Go to next news feed.
2630Return new buffer position."
2631 (interactive)
2632 (widen)
2633 (newsticker--buffer-goto '(feed))
2634 (run-hooks 'newsticker-select-feed-hook)
2635 (point))
2636
2637(defun newsticker-previous-feed ()
2638 "Go to previous news feed.
2639Return new buffer position."
2640 (interactive)
2641 (widen)
2642 (newsticker--buffer-goto '(feed) nil t)
2643 (run-hooks 'newsticker-select-feed-hook)
2644 (point))
2645
2646(defun newsticker-mark-all-items-at-point-as-read ()
2647 "Mark all items as read and clear ticker contents."
2648 (interactive)
2649 (when (or newsticker--buffer-uptodate-p
2650 (y-or-n-p
2651 "Buffer is not up to date -- really mark items as read? "))
2652 (let ((feed (get-text-property (point) 'feed))
2653 (pos (point)))
2654 (when feed
2655 (message "Marking all items as read for %s" (symbol-name feed))
2656 (newsticker--cache-replace-age newsticker--cache feed 'new 'old)
2657 (newsticker--cache-replace-age newsticker--cache feed 'obsolete 'old)
2658 (newsticker--cache-update)
2659 (newsticker--buffer-set-uptodate nil)
2660 (newsticker--ticker-text-setup)
2661 (newsticker-buffer-update)
2662 ;; go back to where we came frome
2663 (goto-char pos)
2664 (end-of-line)
2665 (newsticker--buffer-goto '(feed) nil t)))))
2666
2667(defun newsticker-mark-item-at-point-as-read (&optional respect-immortality)
2668 "Mark item at point as read.
2669If optional argument RESPECT-IMMORTALITY is not nil immortal items do
2670not get changed."
2671 (interactive)
2672 (when (or newsticker--buffer-uptodate-p
2673 (y-or-n-p
2674 "Buffer is not up to date -- really mark this item as read? "))
2675 (let ((feed (get-text-property (point) 'feed))
2676 (item nil))
2677 (when feed
2678 (save-excursion
2679 (newsticker--buffer-beginning-of-item)
2680 (let ((inhibit-read-only t)
2681 (age (get-text-property (point) 'nt-age))
2682 (title (get-text-property (point) 'nt-title))
2683 (guid (get-text-property (point) 'nt-guid))
2684 (nt-desc (get-text-property (point) 'nt-desc))
2685 (pos (save-excursion (newsticker--buffer-end-of-item))))
2686 (when (or (eq age 'new)
2687 (eq age 'obsolete)
2688 (and (eq age 'immortal)
2689 (not respect-immortality)))
2690 ;; find item
2691 (setq item (newsticker--cache-contains newsticker--cache
2692 feed title nt-desc
2693 nil nil guid))
2694 ;; mark as old
2695 (when item
2696 (setcar (nthcdr 4 item) 'old)
2697 (newsticker--do-forget-preformatted item))
2698 ;; clean up ticker
2699 (if (or (and (eq age 'new)
2700 newsticker-hide-immortal-items-in-echo-area)
2701 (and (memq age '(old immortal))
2702 (not
2703 (eq newsticker-hide-old-items-in-newsticker-buffer
2704 newsticker-hide-immortal-items-in-echo-area))))
2705 (newsticker--ticker-text-remove feed title))
2706 ;; set faces etc.
2707 (save-excursion
2708 (save-restriction
2709 (widen)
2710 (put-text-property (point) pos 'nt-age 'old)
2711 (newsticker--buffer-set-faces (point) pos)))
2712 (set-buffer-modified-p nil))))
2713 ;; move forward
2714 (newsticker-next-item t)))))
2715
2716(defun newsticker-mark-item-at-point-as-immortal ()
2717 "Mark item at point as read."
2718 (interactive)
2719 (when (or newsticker--buffer-uptodate-p
2720 (y-or-n-p
2721 "Buffer is not up to date -- really mark this item as read? "))
2722 (let ((feed (get-text-property (point) 'feed))
2723 (item nil))
2724 (when feed
2725 (save-excursion
2726 (newsticker--buffer-beginning-of-item)
2727 (let ((inhibit-read-only t)
2728 (oldage (get-text-property (point) 'nt-age))
2729 (title (get-text-property (point) 'nt-title))
2730 (guid (get-text-property (point) 'nt-guid))
2731 (pos (save-excursion (newsticker--buffer-end-of-item))))
2732 (let ((newage 'immortal))
2733 (if (eq oldage 'immortal)
2734 (setq newage 'old))
2735 (setq item (newsticker--cache-contains newsticker--cache
2736 feed title nil nil nil
2737 guid))
2738 ;; change age
2739 (when item
2740 (setcar (nthcdr 4 item) newage)
2741 (newsticker--do-forget-preformatted item))
2742 (if (or (and (eq newage 'immortal)
2743 newsticker-hide-immortal-items-in-echo-area)
2744 (and (eq newage 'obsolete)
2745 newsticker-hide-obsolete-items-in-echo-area)
2746 (and (eq oldage 'immortal)
2747 (not
2748 (eq newsticker-hide-old-items-in-newsticker-buffer
2749 newsticker-hide-immortal-items-in-echo-area))))
2750 (newsticker--ticker-text-remove feed title)
2751 (newsticker--ticker-text-setup))
2752 (save-excursion
2753 (save-restriction
2754 (widen)
2755 (put-text-property (point) pos 'nt-age newage)
2756 (if (eq newage 'immortal)
2757 (put-text-property (point) pos 'nt-age 'immortal)
2758 (put-text-property (point) pos 'nt-age 'old))
2759 (newsticker--buffer-set-faces (point) pos))))))
2760 (if item
2761 (newsticker-next-item t))))))
2762
2763(defun newsticker-mark-all-items-as-read ()
2764 "Mark all items as read and clear ticker contents."
2765 (interactive)
2766 (when (or newsticker--buffer-uptodate-p
2767 (y-or-n-p
2768 "Buffer is not up to date -- really mark items as read? "))
2769 (newsticker--cache-replace-age newsticker--cache 'any 'new 'old)
2770 (newsticker--buffer-set-uptodate nil)
2771 (newsticker--ticker-text-setup)
2772 (newsticker--cache-update)
2773 (newsticker-buffer-update)))
2774
2775(defun newsticker-hide-extra ()
2776 "Hide the extra elements of items."
2777 (interactive)
2778 (newsticker--buffer-hideshow 'extra nil)
2779 (newsticker--buffer-redraw))
2780
2781(defun newsticker-show-extra ()
2782 "Show the extra elements of items."
2783 (interactive)
2784 (newsticker--buffer-hideshow 'extra t)
2785 (newsticker--buffer-redraw))
2786
2787(defun newsticker-hide-old-item-desc ()
2788 "Hide the description of old items."
2789 (interactive)
2790 (newsticker--buffer-hideshow 'desc-old nil)
2791 (newsticker--buffer-redraw))
2792
2793(defun newsticker-show-old-item-desc ()
2794 "Show the description of old items."
2795 (interactive)
2796 (newsticker--buffer-hideshow 'item-old t)
2797 (newsticker--buffer-hideshow 'desc-old t)
2798 (newsticker--buffer-redraw))
2799
2800(defun newsticker-hide-new-item-desc ()
2801 "Hide the description of new items."
2802 (interactive)
2803 (newsticker--buffer-hideshow 'desc-new nil)
2804 (newsticker--buffer-hideshow 'desc-immortal nil)
2805 (newsticker--buffer-hideshow 'desc-obsolete nil)
2806 (newsticker--buffer-redraw))
2807
2808(defun newsticker-show-new-item-desc ()
2809 "Show the description of new items."
2810 (interactive)
2811 (newsticker--buffer-hideshow 'desc-new t)
2812 (newsticker--buffer-hideshow 'desc-immortal t)
2813 (newsticker--buffer-hideshow 'desc-obsolete t)
2814 (newsticker--buffer-redraw))
2815
2816(defun newsticker-hide-feed-desc ()
2817 "Hide the description of feeds."
2818 (interactive)
2819 (newsticker--buffer-hideshow 'desc-feed nil)
2820 (newsticker--buffer-redraw))
2821
2822(defun newsticker-show-feed-desc ()
2823 "Show the description of old items."
2824 (interactive)
2825 (newsticker--buffer-hideshow 'desc-feed t)
2826 (newsticker--buffer-redraw))
2827
2828(defun newsticker-hide-all-desc ()
2829 "Hide the descriptions of feeds and all items."
2830 (interactive)
2831 (newsticker--buffer-hideshow 'desc-feed nil)
2832 (newsticker--buffer-hideshow 'desc-immortal nil)
2833 (newsticker--buffer-hideshow 'desc-obsolete nil)
2834 (newsticker--buffer-hideshow 'desc-new nil)
2835 (newsticker--buffer-hideshow 'desc-old nil)
2836 (newsticker--buffer-redraw))
2837
2838(defun newsticker-show-all-desc ()
2839 "Show the descriptions of feeds and all items."
2840 (interactive)
2841 (newsticker--buffer-hideshow 'desc-feed t)
2842 (newsticker--buffer-hideshow 'desc-immortal t)
2843 (newsticker--buffer-hideshow 'desc-obsolete t)
2844 (newsticker--buffer-hideshow 'desc-new t)
2845 (newsticker--buffer-hideshow 'desc-old t)
2846 (newsticker--buffer-redraw))
2847
2848(defun newsticker-hide-old-items ()
2849 "Hide old items."
2850 (interactive)
2851 (newsticker--buffer-hideshow 'desc-old nil)
2852 (newsticker--buffer-hideshow 'item-old nil)
2853 (newsticker--buffer-redraw))
2854
2855(defun newsticker-show-old-items ()
2856 "Show old items."
2857 (interactive)
2858 (newsticker--buffer-hideshow 'desc-old t)
2859 (newsticker--buffer-hideshow 'item-old t)
2860 (newsticker--buffer-redraw))
2861
2862(defun newsticker-hide-entry ()
2863 "Hide description of entry at point."
2864 (interactive)
2865 (save-excursion
2866 (let* (pos1 pos2
2867 (inhibit-read-only t)
2868 inv-prop org-inv-prop
2869 is-invisible)
2870 (newsticker--buffer-beginning-of-item)
2871 (newsticker--buffer-goto '(desc))
2872 (setq pos1 (max (point-min) (1- (point))))
2873 (newsticker--buffer-goto '(extra feed item))
2874 (setq pos2 (max (point-min) (1- (point))))
2875 (setq inv-prop (get-text-property pos1 'invisible))
2876 (setq org-inv-prop (get-text-property pos1 'org-invisible))
2877 (cond ((eq inv-prop t)
2878 ;; do nothing
2879 )
2880 ((eq org-inv-prop nil)
2881 (add-text-properties pos1 pos2 (list 'invisible t
2882 'org-invisible inv-prop)))
2883 (t
2884 ;; toggle
2885 (add-text-properties pos1 pos2 (list 'invisible org-inv-prop))
2886 (remove-text-properties pos1 pos2 '(org-invisible))))))
2887 (newsticker--buffer-redraw))
2888
2889(defun newsticker-show-entry ()
2890 "Show description of entry at point."
2891 (interactive)
2892 (save-excursion
2893 (let* (pos1 pos2
2894 (inhibit-read-only t)
2895 inv-prop org-inv-prop
2896 is-invisible)
2897 (newsticker--buffer-beginning-of-item)
2898 (newsticker--buffer-goto '(desc))
2899 (setq pos1 (max (point-min) (1- (point))))
2900 (newsticker--buffer-goto '(extra feed item))
2901 (setq pos2 (max (point-min) (1- (point))))
2902 (setq inv-prop (get-text-property pos1 'invisible))
2903 (setq org-inv-prop (get-text-property pos1 'org-invisible))
2904 (cond ((eq org-inv-prop nil)
2905 (add-text-properties pos1 pos2 (list 'invisible nil
2906 'org-invisible inv-prop)))
2907 (t
2908 ;; toggle
2909 (add-text-properties pos1 pos2 (list 'invisible org-inv-prop))
2910 (remove-text-properties pos1 pos2 '(org-invisible))))))
2911 (newsticker--buffer-redraw))
2912
2913(defun newsticker-toggle-auto-narrow-to-feed ()
2914 "Toggle narrowing to current news feed.
2915If auto-narrowing is active, only news item of the current feed
2916are visible."
2917 (interactive)
2918 (newsticker-set-auto-narrow-to-feed (not newsticker--auto-narrow-to-feed)))
2919
2920(defun newsticker-set-auto-narrow-to-feed (value)
2921 "Turn narrowing to current news feed on or off.
2922If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
2923 (interactive)
2924 (setq newsticker--auto-narrow-to-item nil)
2925 (setq newsticker--auto-narrow-to-feed value)
2926 (widen)
2927 (run-hooks 'newsticker-narrow-hook))
2928
2929(defun newsticker-toggle-auto-narrow-to-item ()
2930 "Toggle narrowing to current news item.
2931If auto-narrowing is active, only one item of the current feed
2932is visible."
2933 (interactive)
2934 (newsticker-set-auto-narrow-to-item (not newsticker--auto-narrow-to-item)))
2935
2936(defun newsticker-set-auto-narrow-to-item (value)
2937 "Turn narrowing to current news item on or off.
2938If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
2939 (interactive)
2940 (setq newsticker--auto-narrow-to-feed nil)
2941 (setq newsticker--auto-narrow-to-item value)
2942 (widen)
2943 (run-hooks 'newsticker-narrow-hook))
2944
2945(defun newsticker-customize ()
2946 "Open the newsticker customization group."
2947 (interactive)
2948 (customize-group "newsticker"))
2949
2950(defun newsticker-next-feed-available-p ()
2951 "Return t if position is before last feed, nil otherwise."
2952 (save-excursion
2953 (let ((p (point)))
2954 (newsticker--buffer-goto '(feed))
2955 (not (= p (point))))))
2956
2957(defun newsticker-previous-feed-available-p ()
2958 "Return t if position is behind first feed, nil otherwise."
2959 (save-excursion
2960 (let ((p (point)))
2961 (newsticker--buffer-goto '(feed) nil t)
2962 (not (= p (point))))))
2963
2964(defun newsticker-next-item-available-p ()
2965 "Return t if position is before last feed, nil otherwise."
2966 (save-excursion
2967 (catch 'result
2968 (while (< (point) (point-max))
2969 (unless (newsticker--buffer-goto '(item))
2970 (throw 'result nil))
2971 (unless (newsticker--lists-intersect-p
2972 (get-text-property (point) 'invisible)
2973 buffer-invisibility-spec)
2974 (throw 'result t))))))
2975
2976(defun newsticker-previous-item-available-p ()
2977 "Return t if position is behind first item, nil otherwise."
2978 (save-excursion
2979 (catch 'result
2980 (while (> (point) (point-min))
2981 (unless (newsticker--buffer-goto '(item) nil t)
2982 (throw 'result nil))
2983 (unless (newsticker--lists-intersect-p
2984 (get-text-property (point) 'invisible)
2985 buffer-invisibility-spec)
2986 (throw 'result t))))))
2987
2988(defun newsticker-item-not-old-p ()
2989 "Return t if there is an item at point which is not old, nil otherwise."
2990 (when (get-text-property (point) 'feed)
2991 (save-excursion
2992 (newsticker--buffer-beginning-of-item)
2993 (let ((age (get-text-property (point) 'nt-age)))
2994 (and (memq age '(new immortal obsolete)) t)))))
2995
2996(defun newsticker-item-not-immortal-p ()
2997 "Return t if there is an item at point which is not immortal, nil otherwise."
2998 (when (get-text-property (point) 'feed)
2999 (save-excursion
3000 (newsticker--buffer-beginning-of-item)
3001 (let ((age (get-text-property (point) 'nt-age)))
3002 (and (memq age '(new old obsolete)) t)))))
3003
3004;; ======================================================================
3005;;; local stuff
3006;; ======================================================================
3007(defun newsticker-running-p ()
3008 "Check whether newsticker is running.
3009Return t if newsticker is running, nil otherwise. Newsticker is
3010considered to be running if the newsticker timer list is not empty."
3011 (> (length newsticker--retrieval-timer-list) 0))
3012
3013(defun newsticker-ticker-running-p ()
3014 "Check whether newsticker's actual ticker is running.
3015Return t if ticker is running, nil otherwise. Newsticker is
3016considered to be running if the newsticker timer list is not
3017empty."
3018 (timerp newsticker--display-timer))
3019
3020;; ======================================================================
3021;;; local stuff
3022;; ======================================================================
3023(defun newsticker-get-news (feed-name)
3024 "Get news from the site FEED-NAME and load feed logo.
3025FEED-NAME must be a string which occurs as the label (i.e. the first element)
3026in an element of `newsticker-url-list' or `newsticker-url-list-defaults'."
3027 (newsticker--debug-msg "%s: Getting news for %s"
3028 (format-time-string "%A, %H:%M" (current-time))
3029 feed-name)
3030 (let* ((buffername (concat " *newsticker-wget-" feed-name "*"))
3031 (item (or (assoc feed-name newsticker-url-list)
3032 (assoc feed-name newsticker-url-list-defaults)
3033 (error
3034 "Cannot get news for %s: Check newsticker-url-list"
3035 feed-name)))
3036 (url (cadr item))
3037 (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
3038 newsticker-wget-arguments)))
3039 (save-excursion
3040 (set-buffer (get-buffer-create buffername))
3041 (erase-buffer)
3042 ;; throw an error if there is an old wget-process around
3043 (if (get-process feed-name)
3044 (error "Another wget-process is running for %s" feed-name))
3045 ;; start wget
3046 (let* ((args (append wget-arguments (list url)))
3047 (proc (apply 'start-process feed-name buffername
3048 newsticker-wget-name args)))
3049 (set-process-coding-system proc 'no-conversion 'no-conversion)
3050 (set-process-sentinel proc 'newsticker--sentinel)))))
3051
3052
3053(defun newsticker-mouse-browse-url (event)
3054 "Call `browse-url' for the link of the item at which the EVENT occurred."
3055 (interactive "e")
3056 (save-excursion
3057 (switch-to-buffer (window-buffer (posn-window (event-end event))))
3058 (let ((url (get-text-property (posn-point (event-end event))
3059 'nt-link)))
3060 (when url
3061 (browse-url url)
3062 (save-excursion
3063 (goto-char (posn-point (event-end event)))
3064 (if newsticker-automatically-mark-visited-items-as-old
3065 (newsticker-mark-item-at-point-as-read t)))))))
3066
3067(defun newsticker-browse-url ()
3068 "Call `browse-url' for the link of the item at point."
3069 (interactive)
3070 (let ((url (get-text-property (point) 'nt-link)))
3071 (when url
3072 (browse-url url)
3073 (if newsticker-automatically-mark-visited-items-as-old
3074 (newsticker-mark-item-at-point-as-read t)))))
3075
3076(defvar newsticker-open-url-history
3077 '("wget" "xmms" "realplay")
3078 "...")
3079
3080(defun newsticker-handle-url ()
3081 "Ask for a program to open the link of the item at point."
3082 (interactive)
3083 (let ((url (get-text-property (point) 'nt-link)))
3084 (when url
3085 (let ((prog (read-string "Open url with: " nil
3086 'newsticker-open-url-history)))
3087 (when prog
3088 (message "%s %s" prog url)
3089 (start-process prog prog prog url)
3090 (if newsticker-automatically-mark-visited-items-as-old
3091 (newsticker-mark-item-at-point-as-read t)))))))
3092
3093(defun newsticker--sentinel (process event)
3094 "Sentinel for extracting news titles from an RDF buffer.
3095Argument PROCESS is the process which has just changed its state.
3096Argument EVENT tells what has happened to the process."
3097 (let* ((p-status (process-status process))
3098 (exit-status (process-exit-status process))
3099 (time (current-time))
3100 (name (process-name process))
3101 (name-symbol (intern name))
3102 (something-was-added nil))
3103 ;; catch known errors (zombie processes, rubbish-xml etc.
3104 ;; if an error occurs the news feed is not updated!
3105 (catch 'oops
3106 (unless (and (eq p-status 'exit)
3107 (= exit-status 0))
3108 (setq newsticker--cache
3109 (newsticker--cache-add
3110 newsticker--cache
3111 name-symbol
3112 newsticker--error-headline
3113 (format
3114 (concat "%s: Newsticker could not retrieve news from %s.\n"
3115 "Return status: `%s'\n"
3116 "Command was `%s'")
3117 (format-time-string "%A, %H:%M" (current-time))
3118 name event (process-command process))
3119 ""
3120 (current-time)
3121 'new
3122 0 nil))
3123 (message "%s: Error while retrieving news from %s"
3124 (format-time-string "%A, %H:%M" (current-time))
3125 (process-name process))
3126 (throw 'oops nil))
3127 (let* ((coding-system nil)
3128 (node-list
3129 (save-current-buffer
3130 (set-buffer (process-buffer process))
3131 ;; a very very dirty workaround to overcome the
3132 ;; problems with the newest (20030621) xml.el:
3133 ;; remove all unnecessary whitespace
3134 (goto-char (point-min))
3135 (while (re-search-forward ">[ \t\r\n]+<" nil t)
3136 (replace-match "><" nil t))
3137 ;; and another brutal workaround (20031105)! For some
3138 ;; reason the xml parser does not like the colon in the
3139 ;; doctype name "rdf:RDF"
3140 (goto-char (point-min))
3141 (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t)
3142 (replace-match "<!DOCTYPE rdfColonRDF" nil t))
3143 ;; finally.... ~##^°!!!!!
3144 (goto-char (point-min))
3145 (while (search-forward "\r\n" nil t)
3146 (replace-match "\n" nil t))
3147 ;; still more brutal workarounds (20040309)! The xml
3148 ;; parser does not like doctype rss
3149 (goto-char (point-min))
3150 (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t)
3151 (replace-match "" nil t))
3152 ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18)
3153 ;; Remove comments to avoid this xml-parsing bug:
3154 ;; "XML files can have only one toplevel tag"
3155 (goto-char (point-min))
3156 (while (search-forward "<!--" nil t)
3157 (let ((start (match-beginning 0)))
3158 (unless (search-forward "-->" nil t)
3159 (error "Can't find end of comment"))
3160 (delete-region start (point))))
3161 ;; And another one (20050702)! If description is HTML
3162 ;; encoded and starts with a `<', wrap the whole
3163 ;; description in a CDATA expression. This happened for
3164 ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
3165 (goto-char (point-min))
3166 (while (re-search-forward
3167 "<description>\\(<img.*?\\)</description>" nil t)
3168 (replace-match
3169 "<description><![CDATA[ \\1 ]]></description>"))
3170 ;;
3171 (set-buffer-modified-p nil)
3172 (goto-char (point-min))
3173 (if (re-search-forward "encoding=\"\\([^\"]+\\)\""
3174 nil t)
3175 (setq coding-system (intern
3176 (downcase(match-string 1)))))
3177 (condition-case errordata
3178 ;; The xml parser might fail
3179 ;; or the xml might be bugged
3180 (xml-parse-region (point-min) (point-max))
3181 (error (message "Could not parse %s: %s"
3182 (buffer-name) (cadr errordata))
3183 (throw 'oops nil)))))
3184 (topnode (car node-list))
3185 (channelnode (car (xml-get-children topnode 'channel)))
3186 (imageurl nil)
3187 (position 0))
3188 ;; mark all items as obsolete
3189 (newsticker--cache-replace-age newsticker--cache
3190 name-symbol
3191 'new 'obsolete-new)
3192 (newsticker--cache-replace-age newsticker--cache
3193 name-symbol
3194 'old 'obsolete-old)
3195 (newsticker--cache-replace-age newsticker--cache
3196 name-symbol
3197 'feed 'obsolete-old)
3198 ;; gather the news
3199 (if (eq (xml-node-name topnode) 'rss)
3200 ;; this is RSS 0.91 or something similar
3201 ;; all items are inside the channel node
3202 (setq topnode channelnode))
3203 (setq imageurl
3204 (car (xml-node-children
3205 (car (xml-get-children
3206 (car (xml-get-children
3207 topnode
3208 'image))
3209 'url)))))
3210 (let ((title (or (car (xml-node-children (car (xml-get-children
3211 channelnode 'title))))
3212 "[untitled]"))
3213 (link (or (car (xml-node-children (car (xml-get-children
3214 channelnode 'link))))
3215 ""))
3216 (desc (or (car (xml-node-children (car (xml-get-children
3217 channelnode
3218 'content:encoded))))
3219 (car (xml-node-children (car (xml-get-children
3220 channelnode
3221 'description))))
3222 "[No description available]"))
3223 (old-item nil))
3224 ;; check coding system
3225 (setq coding-system
3226 (condition-case nil
3227 (check-coding-system coding-system)
3228 (coding-system-error
3229 (message "newsticker.el: %s %s %s %s"
3230 "ignoring coding system "
3231 coding-system
3232 " for "
3233 name)
3234 nil)))
3235 ;; apply coding system
3236 (when coding-system
3237 (setq title (newsticker--decode-coding-string title coding-system))
3238 (if desc
3239 (setq desc (newsticker--decode-coding-string desc
3240 coding-system)))
3241 (setq link (newsticker--decode-coding-string link coding-system)))
3242 ;; decode numeric entities
3243 (setq title (newsticker--decode-numeric-entities title))
3244 (setq desc (newsticker--decode-numeric-entities desc))
3245 (setq link (newsticker--decode-numeric-entities link))
3246 ;; remove whitespace from title, desc, and link
3247 (setq title (newsticker--remove-whitespace title))
3248 (setq desc (newsticker--remove-whitespace desc))
3249 (setq link (newsticker--remove-whitespace link))
3250
3251 ;; handle the feed itself
3252 (unless (newsticker--cache-contains newsticker--cache
3253 name-symbol title
3254 desc link 'feed)
3255 (setq something-was-added t))
3256 (setq newsticker--cache
3257 (newsticker--cache-add
3258 newsticker--cache name-symbol
3259 title desc link time 'feed position
3260 (xml-node-children channelnode)
3261 'feed time))
3262 ;; gather all items for this feed
3263 (mapc (lambda (node)
3264 (when (eq (xml-node-name node) 'item)
3265 (setq position (1+ position))
3266 (setq title (or (car (xml-node-children
3267 (car (xml-get-children
3268 node 'title))))
3269 "[untitled]"))
3270 (setq link (or (car (xml-node-children
3271 (car (xml-get-children
3272 node 'link))))
3273 ""))
3274 (setq desc (or
3275 (car (xml-node-children
3276 (car (xml-get-children
3277 node 'content:encoded))))
3278 (car (xml-node-children
3279 (car (xml-get-children
3280 node 'description))))))
3281 ;; use pubDate value if present
3282 (setq time (or (newsticker--decode-rfc822-date
3283 (car (xml-node-children
3284 (car (xml-get-children
3285 node 'pubDate)))))
3286 time))
3287 ;; use dc:date value if present
3288 (setq time (or (newsticker--decode-iso8601-date
3289 (car (xml-node-children
3290 (car (xml-get-children
3291 node 'dc:date)))))
3292 time))
3293 ;; It happened that the title or description
3294 ;; contained evil HTML code that confused the
3295 ;; xml parser. Therefore:
3296 (unless (stringp title)
3297 (setq title (prin1-to-string title)))
3298 (unless (or (stringp desc) (not desc))
3299 (setq desc (prin1-to-string desc)))
3300 ;; ignore items with empty title AND empty desc
3301 (when (or (> (length title) 0)
3302 (> (length desc) 0))
3303 ;; apply coding system
3304 (when coding-system
3305 (setq title (newsticker--decode-coding-string
3306 title coding-system))
3307 (if desc
3308 (setq desc (newsticker--decode-coding-string desc
3309 coding-system)))
3310 (setq link (newsticker--decode-coding-string
3311 link coding-system)))
3312 ;; decode numeric entities
3313 (setq title (newsticker--decode-numeric-entities title))
3314 (when desc
3315 (setq desc (newsticker--decode-numeric-entities desc)))
3316 (setq link (newsticker--decode-numeric-entities link))
3317 ;; remove whitespace from title, desc, and link
3318 (setq title (newsticker--remove-whitespace title))
3319 (setq desc (newsticker--remove-whitespace desc))
3320 (setq link (newsticker--remove-whitespace link))
3321 ;; add data to cache
3322 ;; do we have this item already?
3323 (let* ((tguid (assoc 'guid (xml-node-children node)))
3324 (guid (if (stringp tguid)
3325 tguid
3326 (car (xml-node-children tguid)))))
3327 ;;(message "guid=%s" guid)
3328 (setq old-item
3329 (newsticker--cache-contains newsticker--cache
3330 name-symbol title
3331 desc link nil guid)))
3332 ;; add this item, or mark it as old, or do nothing
3333 (let ((age1 'new)
3334 (age2 'old)
3335 (item-new-p nil))
3336 (if old-item
3337 (let ((prev-age (newsticker--age old-item)))
3338 (unless
3339 newsticker-automatically-mark-items-as-old
3340 (if (eq prev-age 'obsolete-old)
3341 (setq age2 'old)
3342 (setq age2 'new)))
3343 (if (eq prev-age 'immortal)
3344 (setq age2 'immortal)))
3345 ;; item was not there
3346 (setq item-new-p t)
3347 (setq something-was-added t))
3348 (setq newsticker--cache
3349 (newsticker--cache-add
3350 newsticker--cache name-symbol title desc link
3351 time age1 position (xml-node-children node)
3352 age2))
3353 (when item-new-p
3354 (let ((item (newsticker--cache-contains
3355 newsticker--cache
3356 name-symbol title
3357 desc link nil)))
3358 (if newsticker-auto-mark-filter
3359 (newsticker--run-auto-mark-filter name item))
3360 (run-hook-with-args
3361 'newsticker-new-item-functions name item)))))))
3362 (xml-get-children topnode 'item)))
3363 ;; Remove those old items from cache which have been removed from
3364 ;; the feed
3365 (newsticker--cache-replace-age newsticker--cache
3366 name-symbol 'obsolete-old 'deleteme)
3367 (newsticker--cache-remove newsticker--cache name-symbol
3368 'deleteme)
3369 ;; Remove those new items from cache which have been removed from
3370 ;; the feed. Or keep them as `obsolete'
3371 (if (not newsticker-keep-obsolete-items)
3372 (newsticker--cache-remove newsticker--cache
3373 name-symbol 'obsolete-new)
3374 (setq newsticker--cache
3375 (newsticker--cache-mark-expired
3376 newsticker--cache name-symbol 'obsolete 'obsolete-expired
3377 newsticker-obsolete-item-max-age))
3378 (newsticker--cache-remove newsticker--cache
3379 name-symbol 'obsolete-expired)
3380 (newsticker--cache-replace-age newsticker--cache
3381 name-symbol 'obsolete-new
3382 'obsolete))
3383 ;; bring cache data into proper order....
3384 ;; (newsticker--cache-sort)
3385 ;; setup scrollable text
3386 (newsticker--ticker-text-setup)
3387 (setq newsticker--latest-update-time (current-time))
3388 (when something-was-added
3389 ;; FIXME: should we care about removed items as well?
3390 (newsticker--cache-update)
3391 (newsticker--buffer-set-uptodate nil))
3392 ;; kill the process buffer if wanted
3393 (unless newsticker-debug
3394 (kill-buffer (process-buffer process)))
3395 ;; launch retrieval of image
3396 (when (and imageurl
3397 (string-match "%l" newsticker-heading-format))
3398 (newsticker--image-get name imageurl))))))
3399
3400(defun newsticker--display-tick ()
3401 "Called from the display timer.
3402This function calls a display function, according to the variable
3403`newsticker-scroll-smoothly'."
3404 (if newsticker-scroll-smoothly
3405 (newsticker--display-scroll)
3406 (newsticker--display-jump)))
3407
3408(defsubst newsticker--echo-area-clean-p ()
3409 "Check whether somebody is using the echo area / minibuffer.
3410Return t if echo area and minibuffer are unused."
3411 (not (or (active-minibuffer-window)
3412 (and (current-message)
3413 (not (string= (current-message)
3414 newsticker--prev-message))))))
3415
3416(defun newsticker--display-jump ()
3417 "Called from the display timer.
3418This function displays the next ticker item in the echo area, unless
3419there is another message displayed or the minibuffer is active."
3420 (let ((message-log-max nil));; prevents message text from being logged
3421 (when (newsticker--echo-area-clean-p)
3422 (setq newsticker--item-position (1+ newsticker--item-position))
3423 (when (>= newsticker--item-position (length newsticker--item-list))
3424 (setq newsticker--item-position 0))
3425 (setq newsticker--prev-message
3426 (nth newsticker--item-position newsticker--item-list))
3427 (message newsticker--prev-message))))
3428
3429(defun newsticker--display-scroll ()
3430 "Called from the display timer.
3431This function scrolls the ticker items in the echo area, unless
3432there is another message displayed or the minibuffer is active."
3433 (when (newsticker--echo-area-clean-p)
3434 (let* ((width (- (frame-width) 1))
3435 (message-log-max nil);; prevents message text from being logged
3436 (i newsticker--item-position)
3437 subtext
3438 (s-text newsticker--scrollable-text)
3439 (l (length s-text)))
3440 ;; don't show anything if there is nothing to show
3441 (unless (< (length s-text) 1)
3442 ;; repeat the ticker string if it is shorter than frame width
3443 (while (< (length s-text) width)
3444 (setq s-text (concat s-text s-text)))
3445 ;; get the width of the printed string
3446 (setq l (length s-text))
3447 (cond ((< i (- l width))
3448 (setq subtext (substring s-text i (+ i width))))
3449 (t
3450 (setq subtext (concat
3451 (substring s-text i l)
3452 (substring s-text 0 (- width (- l i)))))))
3453 ;; Take care of multibyte strings, for which (string-width) is
3454 ;; larger than (length).
3455 ;; Actually, such strings may be smaller than (frame-width)
3456 ;; because return values of (string-width) are too large:
3457 ;; (string-width "<japanese character>") => 2
3458 (let ((t-width (1- (length subtext))))
3459 (while (> (string-width subtext) width)
3460 (setq subtext (substring subtext 0 t-width))
3461 (setq t-width (1- t-width))))
3462 ;; show the ticker text and save current position
3463 (message subtext)
3464 (setq newsticker--prev-message subtext)
3465 (setq newsticker--item-position (1+ i))
3466 (when (>= newsticker--item-position l)
3467 (setq newsticker--item-position 0))))))
3468
3469;; ======================================================================
3470;;; misc
3471;; ======================================================================
3472(defun newsticker--decode-coding-string (string coding-system)
3473 "Wrapper around `decode-coding-string'.
3474This functions passes the arguments STRING and CODING-SYSTEM to
3475`decode-coding-string'. If the decoding is successful the
3476decoded string is returned, otherwise the unmodified input string
3477is returned."
3478 (condition-case nil
3479 (decode-coding-string string coding-system)
3480 (error
3481 (message "Cannot decode encoded string `%s'" string)
3482 string)))
3483
3484(defun newsticker--decode-numeric-entities (string)
3485 "Decode SGML numeric entities by their respective utf characters.
3486This function replaces numeric entities in the input STRING and
3487returns the modified string. For example \"&#42;\" gets replaced
3488by \"*\"."
3489 (let ((start 0))
3490 (while (string-match "&#\\([0-9]+\\);" string start)
3491 (condition-case nil
3492 (setq string (replace-match
3493 (string (read (substring string (match-beginning 1)
3494 (match-end 1))))
3495 nil nil string))
3496 (error nil))
3497 (setq start (1+ (match-beginning 0))))
3498 string))
3499
3500(defun newsticker--remove-whitespace (string)
3501 "Remove leading and trailing whitespace from STRING."
3502 ;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
3503 ;; endlessly...
3504 (when string
3505 (replace-regexp-in-string
3506 "[ \t\r\n]+$" ""
3507 (replace-regexp-in-string "^[ \t\r\n]+" "" string))))
3508
3509(defun newsticker--do-forget-preformatted (item)
3510 "Forget all cached pre-formatted data.
3511Remove the pre-formatted from `newsticker--cache'."
3512 (if (nthcdr 7 item)
3513 (setcar (nthcdr 7 item) nil))
3514 (if (nthcdr 6 item)
3515 (setcar (nthcdr 6 item) nil)))
3516
3517(defun newsticker--forget-preformatted ()
3518 "Forget all cached pre-formatted data.
3519Remove the pre-formatted from `newsticker--cache'."
3520 (mapc (lambda (feed)
3521 (mapc 'newsticker--do-forget-preformatted
3522 (cdr feed)))
3523 newsticker--cache)
3524 (newsticker--buffer-set-uptodate nil))
3525
3526(defun newsticker--debug-msg (string &rest args)
3527 "Print newsticker debug messages.
3528This function calls `message' with arguments STRING and ARGS, if
3529`newsticker-debug' is non-nil."
3530 (and newsticker-debug
3531 ;;(not (active-minibuffer-window))
3532 ;;(not (current-message))
3533 (apply 'message string args)))
3534
3535(defun newsticker--decode-iso8601-date (iso8601-string)
3536 "Return ISO8601-STRING in format like `decode-time'.
3537Converts from ISO-8601 to Emacs representation. If ISO8601-STRING
3538Examples:
35392004-09-17T05:09:49+00:00
35402004-09-17T05:09+00:00
35412004-09-17T05:09:49
35422004-09-17T05:09
35432004-09-17
35442004-09
35452004"
3546 (if iso8601-string
3547 (when (string-match
3548 (concat
3549 "\\([0-9]\\{4\\}\\)"
3550 "\\(-\\([0-9]\\{2\\}\\)"
3551 "\\(-\\([0-9]\\{2\\}\\)"
3552 "\\(T"
3553 "\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)"
3554 "\\(:\\([0-9]\\{2\\}\\)\\)?"
3555 "\\(\\([-+Z]\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)?"
3556 "\\)?\\)?\\)?")
3557 iso8601-string)
3558 (let ((year (read (match-string 1 iso8601-string)))
3559 (month (read (match-string 3 iso8601-string)))
3560 (day (read (match-string 5 iso8601-string)))
3561 (hour (read (or (match-string 7 iso8601-string)
3562 "0")))
3563 (minute (read (or (match-string 8 iso8601-string)
3564 "0")))
3565 ;;(second (read (or (match-string 10 iso8601-string)
3566 ;; "0")))
3567 (sign (match-string 12 iso8601-string))
3568 (offset-hour (read (or (match-string 14 iso8601-string)
3569 "0")))
3570 (offset-minute (read (or (match-string 15 iso8601-string)
3571 "0")))
3572 (second 0))
3573 (cond ((string= sign "+")
3574 (setq hour (- hour offset-hour))
3575 (setq minute (- minute offset-minute)))
3576 ((string= sign "-")
3577 (setq hour (+ hour offset-hour))
3578 (setq minute (+ minute offset-minute))))
3579 ;; if UTC subtract current-time-zone offset
3580 ;;(setq second (+ (car (current-time-zone)) second)))
3581
3582 (condition-case nil
3583 (encode-time second minute hour day month year t)
3584 (error
3585 (message "Cannot decode \"%s\"" iso8601-string)
3586 nil))))
3587 nil))
3588
3589(defun newsticker--decode-rfc822-date (rfc822-string)
3590 "Return RFC822-STRING in format like `decode-time'.
3591Converts from RFC822 to Emacs representation.
3592Examples:
3593Sat, 07 Sep 2002 00:00:01 GMT
359407 Sep 2002 00:00:01 GMT"
3595 (if rfc822-string
3596 (when (string-match
3597 (concat
3598 "\\s-*"
3599 ;; week day
3600 "\\(\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)\\s-*,?\\)\\s-+"
3601 ;; day
3602 "\\([0-9]\\{1,2\\}\\)\\s-+"
3603 ;; month
3604 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|"
3605 "Sep\\|Oct\\|Nov\\|Dec\\)\\s-+"
3606 ;; year
3607 "\\([0-9]\\{2,4\\}\\)\\s-+"
3608 ;; hour
3609 "\\([0-9]\\{2\\}\\)"
3610 ;; minute
3611 ":\\([0-9]\\{2\\}\\)"
3612 ;; second
3613 "\\(:\\([0-9]\\{2\\}\\)\\)?"
3614 ;; zone -- fixme
3615 "\\(\\s-+.*\\)?")
3616 rfc822-string)
3617 (let ((day (read (match-string 3 rfc822-string)))
3618 (month-name (match-string 4 rfc822-string))
3619 (month 0)
3620 (year (read (match-string 5 rfc822-string)))
3621 (hour (read (match-string 6 rfc822-string)))
3622 (minute (read (match-string 7 rfc822-string)))
3623 (second (read (or (match-string 9 rfc822-string)
3624 "0")))
3625 ;;(zone (match-string 10 rfc822-string))
3626 )
3627 (condition-case error-data
3628 (let ((i 1))
3629 (mapc (lambda (m)
3630 (if (string= month-name m)
3631 (setq month i))
3632 (setq i (1+ i)))
3633 '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
3634 "Sep" "Oct" "Nov" "Dec"))
3635 (encode-time second minute hour day month year t))
3636 (error
3637 (message "Cannot decode \"%s\": %s %s" rfc822-string
3638 (car error-data) (cdr error-data))
3639 nil))))
3640 nil))
3641
3642(defun newsticker--lists-intersect-p (list1 list2)
3643 "Return t if LIST1 and LIST2 share elements."
3644 (let ((result nil))
3645 (mapc (lambda (elt)
3646 (if (memq elt list2)
3647 (setq result t)))
3648 list1)
3649 result))
3650
3651;; ======================================================================
3652;;; images
3653;; ======================================================================
3654(defun newsticker--image-get (feed-name url)
3655 "Get image of the news site FEED-NAME from URL.
3656If the image has been downloaded in the last 24h do nothing."
3657 (let ((image-name (concat newsticker-imagecache-dirname "/"
3658 feed-name)))
3659 (if (and (file-exists-p image-name)
3660 (time-less-p (current-time)
3661 (time-add (nth 5 (file-attributes image-name))
3662 (seconds-to-time 86400))))
3663 (newsticker--debug-msg "%s: Getting image for %s skipped"
3664 (format-time-string "%A, %H:%M" (current-time))
3665 feed-name)
3666 ;; download
3667 (newsticker--debug-msg "%s: Getting image for %s"
3668 (format-time-string "%A, %H:%M" (current-time))
3669 feed-name)
3670 (let* ((buffername (concat " *newsticker-wget-image-" feed-name "*"))
3671 (item (or (assoc feed-name newsticker-url-list)
3672 (assoc feed-name newsticker-url-list-defaults)
3673 (error
3674 "Cannot get news for %s: Check newsticker-url-list"
3675 feed-name)))
3676 (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
3677 newsticker-wget-arguments)))
3678 (save-excursion
3679 (set-buffer (get-buffer-create buffername))
3680 (erase-buffer)
3681 ;; throw an error if there is an old wget-process around
3682 (if (get-process feed-name)
3683 (error "Another wget-process is running for image %s"
3684 feed-name))
3685 ;; start wget
3686 (let* ((args (append wget-arguments (list url)))
3687 (proc (apply 'start-process feed-name buffername
3688 newsticker-wget-name args)))
3689 (set-process-coding-system proc 'no-conversion 'no-conversion)
3690 (set-process-sentinel proc 'newsticker--image-sentinel)))))))
3691
3692(defun newsticker--image-sentinel (process event)
3693 "Sentinel for image-retrieving PROCESS caused by EVENT."
3694 (let* ((p-status (process-status process))
3695 (exit-status (process-exit-status process))
3696 (feed-name (process-name process)))
3697 ;; catch known errors (zombie processes, rubbish-xml etc.
3698 ;; if an error occurs the news feed is not updated!
3699 (catch 'oops
3700 (unless (and (eq p-status 'exit)
3701 (= exit-status 0))
3702 (message "%s: Error while retrieving image from %s"
3703 (format-time-string "%A, %H:%M" (current-time))
3704 feed-name)
3705 (throw 'oops nil))
3706 (let (image-name)
3707 (save-excursion
3708 (set-buffer (process-buffer process))
3709 (setq image-name (concat newsticker-imagecache-dirname "/"
3710 feed-name))
3711 (set-buffer-file-coding-system 'no-conversion)
3712 ;; make sure the cache dir exists
3713 (unless (file-directory-p newsticker-imagecache-dirname)
3714 (make-directory newsticker-imagecache-dirname))
3715 ;; write and close buffer
3716 (let ((require-final-newline nil)
3717 (backup-inhibited t)
3718 (coding-system-for-write 'no-conversion))
3719 (write-region nil nil image-name nil 'quiet))
3720 (set-buffer-modified-p nil)
3721 (kill-buffer (current-buffer)))))))
3722
3723(defun newsticker--image-read (feed-name-symbol disabled)
3724 "Read the cached image for FEED-NAME-SYMBOL from disk.
3725If DISABLED is non-nil the image will be converted to a disabled look
3726\(unless `newsticker-enable-logo-manipulations' is not t\).
3727Return the image."
3728 (let ((image-name (concat newsticker-imagecache-dirname "/"
3729 (symbol-name feed-name-symbol)))
3730 (img nil))
3731 (when (file-exists-p image-name)
3732 (condition-case error-data
3733 (setq img (create-image
3734 image-name nil nil
3735 :conversion (and newsticker-enable-logo-manipulations
3736 disabled
3737 'disabled)
3738 :mask (and newsticker-enable-logo-manipulations
3739 'heuristic)
3740 :ascent 70))
3741 (error
3742 (message "Error: cannot create image: %s"
3743 (cadr error-data)))))
3744 img))
3745
3746;; ======================================================================
3747;;; imenu stuff
3748;; ======================================================================
3749(defun newsticker--imenu-create-index ()
3750 "Scan newsticker buffer and return an index for imenu."
3751 (save-excursion
3752 (goto-char (point-min))
3753 (let ((index-alist nil)
3754 (feed-list nil)
3755 (go-ahead t))
3756 (while go-ahead
3757 (let ((type (get-text-property (point) 'nt-type))
3758 (title (get-text-property (point) 'nt-title)))
3759 (cond ((eq type 'feed)
3760 ;; we're on a feed heading
3761 (when feed-list
3762 (if index-alist
3763 (nconc index-alist (list feed-list))
3764 (setq index-alist (list feed-list))))
3765 (setq feed-list (list title)))
3766 (t
3767 (nconc feed-list
3768 (list (cons title (point)))))))
3769 (setq go-ahead (newsticker--buffer-goto '(item feed))))
3770 (if index-alist
3771 (nconc index-alist (list feed-list))
3772 (setq index-alist (list feed-list)))
3773 index-alist)))
3774
3775(defun newsticker--imenu-goto (name pos &rest args)
3776 "Go item NAME at position POS and show item.
3777ARGS are ignored."
3778 (goto-char pos)
3779 (newsticker-show-entry))
3780
3781;; ======================================================================
3782;;; buffer stuff
3783;; ======================================================================
3784(defun newsticker--buffer-set-uptodate (value)
3785 "Set the uptodate-status of the newsticker buffer to VALUE.
3786The mode-line is changed accordingly."
3787 (setq newsticker--buffer-uptodate-p value)
3788 (let ((b (get-buffer "*newsticker*")))
3789 (when b
3790 (save-excursion
3791 (set-buffer b)
3792 (if value
3793 (setq mode-name "Newsticker -- up to date -- ")
3794 (setq mode-name "Newsticker -- NEED UPDATE -- ")))
3795 (sit-for 0))))
3796
3797(defun newsticker--buffer-redraw ()
3798 "Sometimes (CVS) Emacs forgets to update the window..."
3799 (if (fboundp 'force-window-update)
3800 (force-window-update (current-buffer))
3801 (redraw-frame (selected-frame)))
3802 (run-hooks 'newsticker-buffer-change-hook)
3803 (sit-for 0))
3804
3805(defun newsticker--buffer-insert-all-items ()
3806 "Insert all cached newsticker items into the current buffer.
3807Keeps order of feeds as given in `newsticker-url-list' and
3808`newsticker-url-list-defaults'."
3809 (goto-char (point-min))
3810 (mapc (lambda (url-item)
3811 (let* ((feed-name (car url-item))
3812 (feed-name-symbol (intern feed-name))
3813 (feed (assoc feed-name-symbol newsticker--cache))
3814 (items (cdr feed))
3815 (pos (point)))
3816 (when feed
3817 ;; insert the feed description
3818 (mapc (lambda (item)
3819 (when (eq (newsticker--age item) 'feed)
3820 (newsticker--buffer-insert-item item
3821 feed-name-symbol)))
3822 items)
3823 ;;insert the items
3824 (mapc (lambda (item)
3825 (if (memq (newsticker--age item) '(new immortal old
3826 obsolete))
3827 (newsticker--buffer-insert-item item
3828 feed-name-symbol)))
3829 items)
3830 (put-text-property pos (point) 'feed (car feed))
3831
3832 ;; insert empty line between feeds
3833 (let ((p (point)))
3834 (insert "\n")
3835 (put-text-property p (point) 'hard t)))))
3836 (append newsticker-url-list newsticker-url-list-defaults))
3837
3838 (newsticker--buffer-set-faces (point-min) (point-max))
3839 (newsticker--buffer-set-invisibility (point-min) (point-max))
3840 (goto-char (point-min)))
3841
3842(defun newsticker--buffer-insert-item (item &optional feed-name-symbol)
3843 "Insert a news item in the current buffer.
3844Insert the string PREFIX and a formatted representation of the
3845ITEM. The optional parameter FEED-NAME-SYMBOL determines how the
3846item is formatted and whether the item-retrieval time is added as
3847well."
3848 ;; insert headline
3849 (if (eq (newsticker--age item) 'feed)
3850 (newsticker--buffer-do-insert-text item 'feed feed-name-symbol)
3851 (newsticker--buffer-do-insert-text item 'item feed-name-symbol))
3852 ;; insert the description
3853 (newsticker--buffer-do-insert-text item 'desc feed-name-symbol))
3854
3855(defun newsticker--buffer-do-insert-text (item type feed-name-symbol)
3856 "Actually insert contents of news item, format it, render it and all that.
3857ITEM is a news item, TYPE tells which part of the item shall be inserted,
3858FEED-NAME-SYMBOL tells to which feed this item belongs."
3859 (let* ((pos (point))
3860 (format newsticker-desc-format)
3861 (pos-date-start nil)
3862 (pos-date-end nil)
3863 (pos-stat-start nil)
3864 (pos-stat-end nil)
3865 (pos-text-start nil)
3866 (pos-text-end nil)
3867 (pos-extra-start nil)
3868 (pos-extra-end nil)
3869 (pos-enclosure-start nil)
3870 (pos-enclosure-end nil)
3871 (age (newsticker--age item))
3872 (preformatted-contents (newsticker--preformatted-contents item))
3873 (preformatted-title (newsticker--preformatted-title item)))
3874 (cond ((and preformatted-contents
3875 (not (eq (aref preformatted-contents 0) ?\n));; we must
3876 ;; NOT have a line
3877 ;; break!
3878 (eq type 'desc))
3879 (insert preformatted-contents))
3880 ((and preformatted-title
3881 (not (eq (aref preformatted-title 0) ?\n));; we must NOT have a
3882 ;; line break!
3883 (eq type 'item))
3884 (insert preformatted-title))
3885 (t
3886 ;; item was not formatted before.
3887 ;; Let's go.
3888 (if (eq type 'item)
3889 (setq format newsticker-item-format)
3890 (if (eq type 'feed)
3891 (setq format newsticker-heading-format)))
3892
3893 (while (> (length format) 0)
3894 (let ((prefix (if (> (length format) 1)
3895 (substring format 0 2)
3896 "")))
3897 (cond ((string= "%c" prefix)
3898 ;; contents
3899 (when (newsticker--desc item)
3900 (setq pos-text-start (point-marker))
3901 (insert (newsticker--desc item))
3902 (setq pos-text-end (point-marker)))
3903 (setq format (substring format 2)))
3904 ((string= "%d" prefix)
3905 ;; date
3906 (setq pos-date-start (point-marker))
3907 (if (newsticker--time item)
3908 (insert (format-time-string newsticker-date-format
3909 (newsticker--time item))))
3910 (setq pos-date-end (point-marker))
3911 (setq format (substring format 2)))
3912 ((string= "%l" prefix)
3913 ;; logo
3914 (let ((disabled (cond ((eq (newsticker--age item) 'feed)
3915 (= (newsticker--stat-num-items
3916 feed-name-symbol 'new) 0))
3917 (t
3918 (not (eq (newsticker--age item)
3919 'new))))))
3920 (let ((img (newsticker--image-read feed-name-symbol
3921 disabled)))
3922 (when img
3923 (newsticker--insert-image img (car item)))))
3924 (setq format (substring format 2)))
3925 ((string= "%L" prefix)
3926 ;; logo or title
3927 (let ((disabled (cond ((eq (newsticker--age item) 'feed)
3928 (= (newsticker--stat-num-items
3929 feed-name-symbol 'new) 0))
3930 (t
3931 (not (eq (newsticker--age item)
3932 'new))))))
3933 (let ((img (newsticker--image-read feed-name-symbol
3934 disabled)))
3935 (if img
3936 (newsticker--insert-image img (car item))
3937 (when (car item)
3938 (setq pos-text-start (point-marker))
3939 (if (eq (newsticker--age item) 'feed)
3940 (insert (newsticker--title item))
3941 ;; FIXME: This is not the "real" title!
3942 (insert (format "%s"
3943 (car (newsticker--cache-get-feed
3944 feed-name-symbol)))))
3945 (setq pos-text-end (point-marker))))))
3946 (setq format (substring format 2)))
3947 ((string= "%s" prefix)
3948 ;; statistics
3949 (setq pos-stat-start (point-marker))
3950 (if (eq (newsticker--age item) 'feed)
3951 (insert (newsticker--buffer-statistics
3952 feed-name-symbol)))
3953 (setq pos-stat-end (point-marker))
3954 (setq format (substring format 2)))
3955 ((string= "%t" prefix)
3956 ;; title
3957 (when (car item)
3958 (setq pos-text-start (point-marker))
3959 (insert (car item))
3960 (setq pos-text-end (point-marker)))
3961 (setq format (substring format 2)))
3962 ((string-match "%." prefix)
3963 ;; unknown specifier!
3964 (insert prefix)
3965 (setq format (substring format 2)))
3966 ((string-match "^\\([^%]*\\)\\(.*\\)" format) ;; FIXME!
3967 ;; everything else
3968 (let ((p (point)))
3969 (insert (substring format
3970 (match-beginning 1) (match-end 1)))
3971 ;; in case that the format string contained newlines
3972 (put-text-property p (point) 'hard t))
3973 (setq format (substring format (match-beginning 2)))))))
3974
3975 ;; decode HTML if possible...
3976 (let ((is-rendered-HTML nil))
3977 (when (and newsticker-html-renderer pos-text-start pos-text-end)
3978 (condition-case error-data
3979 (save-excursion
3980 ;; check whether it is necessary to call html renderer
3981 ;; (regexp inspired by htmlr.el)
3982 (goto-char pos-text-start)
3983 (when (re-search-forward
3984 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" pos-text-end t)
3985 ;; (message "%s" (newsticker--title item))
3986 (let ((w3m-fill-column (if newsticker-use-full-width
3987 -1 fill-column))
3988 (w3-maximum-line-length
3989 (if newsticker-use-full-width nil fill-column)))
3990 (save-excursion
3991 (funcall newsticker-html-renderer pos-text-start
3992 pos-text-end)))
3993 ;; FIXME: compiler warning about free variable
3994 ;; w3m-minor-mode-map
3995 (cond ((eq newsticker-html-renderer 'w3m-region)
3996 (add-text-properties pos (point-max)
3997 (list 'keymap
3998 w3m-minor-mode-map)))
3999 ((eq newsticker-html-renderer 'w3-region)
4000 (add-text-properties pos (point-max)
4001 (list 'keymap w3-mode-map))))
4002 (setq is-rendered-HTML t)))
4003 (error
4004 (message "Error: HTML rendering failed: %s, %s"
4005 (car error-data) (cdr error-data)))))
4006 (when (and newsticker-justification
4007 (eq type 'desc)
4008 (not is-rendered-HTML))
4009 (condition-case nil
4010 (let ((use-hard-newlines t))
4011 (fill-region pos (point-max) newsticker-justification))
4012 (error nil))))
4013
4014 ;; remove leading and trailing newlines
4015 (goto-char pos)
4016 (unless (= 0 (skip-chars-forward " \t\r\n"))
4017 (delete-region pos (point)))
4018 (goto-char (point-max))
4019 (let ((end (point)))
4020 (unless (= 0 (skip-chars-backward " \t\r\n" (1+ pos)))
4021 (delete-region (point) end)))
4022 (goto-char (point-max))
4023
4024 ;; closing newline
4025 (unless nil ;;(eq pos (point))
4026 (insert "\n")
4027 (put-text-property (1- (point)) (point) 'hard t))
4028
4029 ;; insert enclosure element
4030 (when (eq type 'desc)
4031 (setq pos-enclosure-start (point))
4032 (newsticker--buffer-insert-enclosure item)
4033 (setq pos-enclosure-end (point)))
4034
4035 ;; show extra elements
4036 (when (eq type 'desc)
4037 (goto-char (point-max))
4038 (setq pos-extra-start (point))
4039 (mapc (lambda (extra-element)
4040 (unless (memq (car extra-element)
4041 '(items link title description
4042 content:encoded
4043 dc:subject dc:date item guid
4044 pubDate
4045 enclosure))
4046 (newsticker--buffer-print-extra-element
4047 extra-element)))
4048 (newsticker--extra item))
4049 (setq pos-extra-end (point)))
4050
4051 ;; text properties
4052 (when (memq type '(feed item))
4053 (add-text-properties pos (1- (point))
4054 (list 'mouse-face 'highlight
4055 'nt-link (newsticker--link item)
4056 'help-echo
4057 (format "mouse-2: visit item (%s)"
4058 (newsticker--link item))
4059 'keymap newsticker--url-keymap))
4060 (add-text-properties pos (point)
4061 (list 'nt-title (newsticker--title item)
4062 'nt-desc (newsticker--desc item))))
4063
4064 (add-text-properties pos (point)
4065 (list 'nt-type type
4066 'nt-face type
4067 'nt-age age
4068 'nt-guid (newsticker--guid item)))
4069 (when (and pos-date-start pos-date-end)
4070 (put-text-property pos-date-start pos-date-end 'nt-face 'date))
4071 (when (and pos-stat-start pos-stat-end)
4072 (put-text-property pos-stat-start pos-stat-end 'nt-face 'stat))
4073 (when (and pos-extra-start pos-extra-end)
4074 (put-text-property pos-extra-start pos-extra-end
4075 'nt-face 'extra)
4076 (put-text-property pos-extra-start pos-extra-end
4077 'nt-type 'extra))
4078 (when (and pos-enclosure-start pos-enclosure-end
4079 (> pos-enclosure-end pos-enclosure-start))
4080 (put-text-property pos-enclosure-start (1- pos-enclosure-end)
4081 'nt-face 'enclosure))
4082
4083 ;; left margin
4084 ;;(unless (memq type '(feed item))
4085 ;;(set-left-margin pos (1- (point)) 1))
4086
4087 ;; save rendered stuff
4088 (cond ((eq type 'desc)
4089 ;; preformatted contents
4090 (newsticker--cache-set-preformatted-contents
4091 item (buffer-substring pos (point))))
4092 ((eq type 'item)
4093 ;; preformatted title
4094 (newsticker--cache-set-preformatted-title
4095 item (buffer-substring pos (point)))))))))
4096
4097(defun newsticker--buffer-print-extra-element (extra-element)
4098 "Insert EXTRA-ELEMENT in a pretty form into the current buffer."
4099 (insert (format "%s:\t" (car extra-element)))
4100 (let (;;(attributes (cadr extra-element)) ;FIXME!!!!
4101 (contents (cddr extra-element)))
4102 (cond ((listp contents)
4103 (mapc (lambda (i)
4104 (if (and (stringp i)
4105 (string-match "^http://.*" i))
4106 (let ((pos (point)))
4107 (insert i " ") ; avoid self-reference from the
4108 ; nt-link thing
4109 (add-text-properties
4110 pos (point)
4111 (list 'mouse-face 'highlight
4112 'nt-link i
4113 'help-echo
4114 (format "mouse-2: visit (%s)" i)
4115 'keymap newsticker--url-keymap)))
4116 (insert (format "%s" i))))
4117 contents))
4118 (t
4119 (insert (format "%s" contents))))
4120 (insert "\n")))
4121
4122(defun newsticker--buffer-insert-enclosure (item)
4123 "Insert enclosure element of an RSS ITEM into the current buffer."
4124 (let ((enclosure (newsticker--enclosure item))
4125 (beg (point)))
4126 (when enclosure
4127 (let ((url (cdr (assoc 'url enclosure)))
4128 (length (cdr (assoc 'length enclosure)))
4129 (type (cdr (assoc 'type enclosure))))
4130 (insert (format "Enclosed file (%s, %1.2f kBytes)" type
4131 (/ (string-to-number length) 1024)))
4132 (add-text-properties beg (point)
4133 (list 'mouse-face 'highlight
4134 'nt-link url
4135 'help-echo (format
4136 "mouse-2: visit (%s)" url)
4137 'keymap newsticker--url-keymap
4138 'nt-face 'enclosure
4139 'nt-type 'desc))
4140 (insert "\n")))))
4141
4142(defun newsticker--buffer-statistics (feed-name-symbol)
4143 "Return a statistic string for the feed given by FEED-NAME-SYMBOL.
4144See `newsticker-statistics-format'."
4145 (let ((case-fold-search nil))
4146 (replace-regexp-in-string
4147 "%a"
4148 (format "%d" (newsticker--stat-num-items feed-name-symbol))
4149 (replace-regexp-in-string
4150 "%i"
4151 (format "%d" (newsticker--stat-num-items feed-name-symbol 'immortal))
4152 (replace-regexp-in-string
4153 "%n"
4154 (format "%d" (newsticker--stat-num-items feed-name-symbol 'new))
4155 (replace-regexp-in-string
4156 "%o"
4157 (format "%d" (newsticker--stat-num-items feed-name-symbol 'old))
4158 (replace-regexp-in-string
4159 "%O"
4160 (format "%d" (newsticker--stat-num-items feed-name-symbol 'obsolete))
4161 newsticker-statistics-format)))))))
4162
4163(defun newsticker--buffer-set-faces (start end)
4164 "Add face properties according to mark property.
4165Scans the buffer between START and END."
4166 (save-excursion
4167 ;;(put-text-property start end 'face 'newsticker-default-face)
4168 (goto-char start)
4169 (let ((pos1 start)
4170 (pos2 1)
4171 (nt-face (get-text-property start 'nt-face))
4172 (nt-age (get-text-property start 'nt-age)))
4173 (when nt-face
4174 (setq pos2 (next-single-property-change (point) 'nt-face))
4175 (newsticker--set-face-properties pos1 pos2 nt-face nt-age)
4176 (setq nt-face (get-text-property pos2 'nt-face))
4177 (setq pos1 pos2))
4178 (while (and (setq pos2 (next-single-property-change pos1 'nt-face))
4179 (<= pos2 end)
4180 (> pos2 pos1))
4181 (newsticker--set-face-properties pos1 pos2 nt-face nt-age)
4182 (setq nt-face (get-text-property pos2 'nt-face))
4183 (setq nt-age (get-text-property pos2 'nt-age))
4184 (setq pos1 pos2)))))
4185
4186(defun newsticker--buffer-set-invisibility (start end)
4187 "Add invisibility properties according to nt-type property.
4188Scans the buffer between START and END. Sets the 'invisible
4189property to '(<nt-type>-<nt-age> <nt-type> <nt-age>)."
4190 (save-excursion
4191 ;; reset invisibility settings
4192 (put-text-property start end 'invisible nil)
4193 ;; let's go
4194 (goto-char start)
4195 (let ((pos1 start)
4196 (pos2 1)
4197 (nt-type (get-text-property start 'nt-type))
4198 (nt-age (get-text-property start 'nt-age)))
4199 (when nt-type
4200 (setq pos2 (next-single-property-change (point) 'nt-type))
4201 (put-text-property (max (point-min) pos1) (1- pos2)
4202 'invisible
4203 (list (intern
4204 (concat
4205 (symbol-name
4206 (if (eq nt-type 'extra) 'desc nt-type))
4207 "-"
4208 (symbol-name nt-age)))
4209 nt-type
4210 nt-age))
4211 (setq nt-type (get-text-property pos2 'nt-type))
4212 (setq pos1 pos2))
4213 (while (and (setq pos2 (next-single-property-change pos1 'nt-type))
4214 (<= pos2 end)
4215 (> pos2 pos1))
4216 ;; must shift one char to the left in order to handle inivisible
4217 ;; newlines, motion in invisible text areas and all that correctly
4218 (put-text-property (1- pos1) (1- pos2)
4219 'invisible
4220 (list (intern
4221 (concat
4222 (symbol-name
4223 (if (eq nt-type 'extra) 'desc nt-type))
4224 "-"
4225 (symbol-name nt-age)))
4226 nt-type
4227 nt-age))
4228 (setq nt-type (get-text-property pos2 'nt-type))
4229 (setq nt-age (get-text-property pos2 'nt-age))
4230 (setq pos1 pos2)))))
4231
4232(defun newsticker--set-face-properties (pos1 pos2 nt-face age)
4233 "Set the face for the text between the positions POS1 and POS2.
4234The face is chosen according the values of NT-FACE and AGE."
4235 (let ((face (cond ((eq nt-face 'feed)
4236 'newsticker-feed-face)
4237 ((eq nt-face 'item)
4238 (cond ((eq age 'new)
4239 'newsticker-new-item-face)
4240 ((eq age 'old)
4241 'newsticker-old-item-face)
4242 ((eq age 'immortal)
4243 'newsticker-immortal-item-face)
4244 ((eq age 'obsolete)
4245 'newsticker-obsolete-item-face)))
4246 ((eq nt-face 'date)
4247 'newsticker-date-face)
4248 ((eq nt-face 'stat)
4249 'newsticker-statistics-face)
4250 ((eq nt-face 'extra)
4251 'newsticker-extra-face)
4252 ((eq nt-face 'enclosure)
4253 'newsticker-enclosure-face))))
4254 (when face
4255 (put-text-property pos1 (max pos1 pos2) 'face face))))
4256
4257(defun newsticker--insert-image (img string)
4258 "Insert IMG with STRING at point.
4259This is a work-around for a strange behavior of Emacs versions before
426021.3.50. Images inserted with `insert-image' vanished after doing
4261`fill-region'."
4262 ;; This should work:
4263 ;;(insert-image img string)
4264 ;; but it does not. Therefore we do this, which should be equivalent!
4265 (let ((pos (point)))
4266 ;;(insert string)
4267 (insert ":-)")
4268 (add-text-properties pos (point) (list 'display img))))
4269
4270;; ======================================================================
4271;;; HTML rendering
4272;; ======================================================================
4273(defun newsticker-htmlr-render (pos1 pos2) ;
4274 "Replacement for `htmlr-render'.
4275Renders the HTML code in the region POS1 to POS2 using htmlr."
4276 (let ((str (buffer-substring-no-properties pos1 pos2)))
4277 (delete-region pos1 pos2)
4278 (insert
4279 (with-temp-buffer
4280 (insert str)
4281 (goto-char (point-min))
4282 ;; begin original htmlr-render
4283 (htmlr-reset)
4284 ;; something omitted here...
4285 (while (< (point) (point-max))
4286 (htmlr-step))
4287 ;; end original htmlr-render
4288 (newsticker--remove-whitespace (buffer-string))))))
4289
4290;; ======================================================================
4291;;; Functions working on the *newsticker* buffer
4292;; ======================================================================
4293(defun newsticker--buffer-make-item-completely-visible ()
4294 "Scroll buffer until current item is completely visible."
4295 (switch-to-buffer (get-buffer-create "*newsticker*"))
4296 (when newsticker--auto-narrow-to-feed
4297 (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-feed))
4298 (point-min)))
4299 (max (or (save-excursion (newsticker--buffer-end-of-feed))
4300 (point-max))))
4301 (narrow-to-region min max)))
4302 (when newsticker--auto-narrow-to-item
4303 (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-item))
4304 (point-min)))
4305 (max (or (save-excursion (newsticker--buffer-end-of-item))
4306 (point-max))))
4307 (narrow-to-region min max)))
4308 (sit-for 0)
4309 ;; do not count lines and stuff because that does not work when images
4310 ;; are displayed. Do it the simple way:
4311 (save-excursion
4312 (newsticker--buffer-end-of-item)
4313 (unless (pos-visible-in-window-p)
4314 (recenter -1)))
4315 (unless (pos-visible-in-window-p)
4316 (recenter 0)))
4317
4318(defun newsticker--buffer-get-feed-title-at-point ()
4319 "Return feed symbol of headline at point."
4320 (format "%s" (or (get-text-property (point) 'feed) " ")))
4321
4322(defun newsticker--buffer-get-item-title-at-point ()
4323 "Return feed symbol of headline at point."
4324 (format "%s" (or (get-text-property (point) 'nt-title) " ")))
4325
4326(defun newsticker--buffer-goto (types &optional age backwards)
4327 "Search next occurrence of TYPES in current buffer.
4328TYPES is a list of symbols. If TYPES is found point is moved, if
4329not point is left unchanged. If optional parameter AGE is not
4330nil, the type AND the age must match. If BACKWARDS is t, search
4331backwards."
4332 (let ((pos (save-excursion
4333 (save-restriction
4334 (widen)
4335 (catch 'found
4336 (let ((tpos (point)))
4337 (while (setq tpos
4338 (if backwards
4339 (if (eq tpos (point-min))
4340 nil
4341 (or (previous-single-property-change
4342 tpos 'nt-type)
4343 (point-min)))
4344 (next-single-property-change
4345 tpos 'nt-type)))
4346 (and (memq (get-text-property tpos 'nt-type) types)
4347 (or (not age)
4348 (eq (get-text-property tpos 'nt-age) age))
4349 (throw 'found tpos)))))))))
4350 (when pos
4351 (goto-char pos))
4352 pos))
4353
4354(defun newsticker--buffer-hideshow (mark-age onoff )
4355 "Hide or show items of type MARK-AGE.
4356If ONOFF is nil the item is hidden, otherwise it is shown."
4357 (if onoff
4358 (remove-from-invisibility-spec mark-age )
4359 (add-to-invisibility-spec mark-age)))
4360
4361(defun newsticker--buffer-beginning-of-item ()
4362 "Move point to the beginning of the item at point.
4363Return new position."
4364 (if (bobp)
4365 (point)
4366 (let ((type (get-text-property (point) 'nt-type))
4367 (typebefore (get-text-property (1- (point)) 'nt-type)))
4368 (if (and (memq type '(item feed))
4369 (not (eq type typebefore)))
4370 (point)
4371 (newsticker--buffer-goto '(item feed) nil t)
4372 (point)))))
4373
4374(defun newsticker--buffer-beginning-of-feed ()
4375 "Move point to the beginning of the feed at point.
4376Return new position."
4377 (if (bobp)
4378 (point)
4379 (let ((type (get-text-property (point) 'nt-type))
4380 (typebefore (get-text-property (1- (point)) 'nt-type)))
4381 (if (and (memq type '(feed))
4382 (not (eq type typebefore)))
4383 (point)
4384 (newsticker--buffer-goto '(feed) nil t)
4385 (point)))))
4386
4387(defun newsticker--buffer-end-of-item ()
4388 "Move point to the end of the item at point.
4389Take care: end of item is at the end of its last line!"
4390 (when (newsticker--buffer-goto '(item feed nil))
4391 (point)))
4392
4393(defun newsticker--buffer-end-of-feed ()
4394 "Move point to the end of the last item of the feed at point.
4395Take care: end of item is at the end of its last line!"
4396 (when (newsticker--buffer-goto '(feed nil))
4397 (backward-char 1)
4398 (point)))
4399
4400;; ======================================================================
4401;;; manipulation of ticker text
4402;; ======================================================================
4403(defun newsticker--ticker-text-setup ()
4404 "Build the ticker text which is scrolled or flashed in the echo area."
4405 ;; reset scrollable text
4406 (setq newsticker--scrollable-text "")
4407 (setq newsticker--item-list nil)
4408 (setq newsticker--item-position 0)
4409 ;; build scrollable text from cache data
4410 (let ((have-something nil))
4411 (mapc
4412 (lambda (feed)
4413 (let ((feed-name (symbol-name (car feed))))
4414 (let ((num-new (newsticker--stat-num-items (car feed) 'new))
4415 (num-old (newsticker--stat-num-items (car feed) 'old))
4416 (num-imm (newsticker--stat-num-items (car feed) 'immortal))
4417 (num-obs (newsticker--stat-num-items (car feed) 'obsolete)))
4418 (when (or (> num-new 0)
4419 (and (> num-old 0)
4420 (not newsticker-hide-old-items-in-echo-area))
4421 (and (> num-imm 0)
4422 (not newsticker-hide-immortal-items-in-echo-area))
4423 (and (> num-obs 0)
4424 (not newsticker-hide-obsolete-items-in-echo-area)))
4425 (setq have-something t)
4426 (mapc
4427 (lambda (item)
4428 (let ((title (replace-regexp-in-string
4429 "[\r\n]+" " "
4430 (newsticker--title item)))
4431 (age (newsticker--age item)))
4432 (unless (string= title newsticker--error-headline)
4433 (when
4434 (or (eq age 'new)
4435 (and (eq age 'old)
4436 (not newsticker-hide-old-items-in-echo-area))
4437 (and (eq age 'obsolete)
4438 (not
4439 newsticker-hide-obsolete-items-in-echo-area))
4440 (and (eq age 'immortal)
4441 (not
4442 newsticker-hide-immortal-items-in-echo-area)))
4443 (setq title (newsticker--remove-whitespace title))
4444 ;; add to flash list
4445 (add-to-list 'newsticker--item-list
4446 (concat feed-name ": " title) t)
4447 ;; and to the scrollable text
4448 (setq newsticker--scrollable-text
4449 (concat newsticker--scrollable-text
4450 " " feed-name ": " title " +++"))))))
4451 (cdr feed))))))
4452 newsticker--cache)
4453 (when have-something
4454 (setq newsticker--scrollable-text
4455 (concat "+++ "
4456 (format-time-string "%A, %H:%M"
4457 newsticker--latest-update-time)
4458 " ++++++" newsticker--scrollable-text)))))
4459
4460(defun newsticker--ticker-text-remove (feed title)
4461 "Remove the item of FEED with TITLE from the ticker text."
4462 ;; reset scrollable text
4463 (setq newsticker--item-position 0)
4464 (let ((feed-name (symbol-name feed))
4465 (t-title (replace-regexp-in-string "[\r\n]+" " " title)))
4466 ;; remove from flash list
4467 (setq newsticker--item-list (remove (concat feed-name ": " t-title)
4468 newsticker--item-list))
4469 ;; and from the scrollable text
4470 (setq newsticker--scrollable-text
4471 (replace-regexp-in-string
4472 (regexp-quote (concat " " feed-name ": " t-title " +++"))
4473 ""
4474 newsticker--scrollable-text))
4475 (if (string-match (concat "^\\+\\+\\+ [A-Z][a-z]+, "
4476 "[012]?[0-9]:[0-9][0-9] \\+\\+\\+\\+\\+\\+$")
4477 newsticker--scrollable-text)
4478 (setq newsticker--scrollable-text ""))))
4479
4480;; ======================================================================
4481;;; manipulation of cached data
4482;; ======================================================================
4483(defun newsticker--cache-set-preformatted-contents (item contents)
4484 "Set preformatted contents of ITEM to CONTENTS."
4485 (if (nthcdr 6 item)
4486 (setcar (nthcdr 6 item) contents)
4487 (setcdr (nthcdr 5 item) (list contents))))
4488
4489(defun newsticker--cache-set-preformatted-title (item title)
4490 "Set preformatted title of ITEM to TITLE."
4491 (if (nthcdr 7 item)
4492 (setcar (nthcdr 7 item) title)
4493 (setcdr (nthcdr 6 item) title)))
4494
4495(defun newsticker--cache-replace-age (data feed old-age new-age)
4496 "Mark all items in DATA in FEED which carry age OLD-AGE with NEW-AGE.
4497If FEED is 'any it applies to all feeds. If OLD-AGE is 'any,
4498all marks are replaced by NEW-AGE. Removes all pre-formatted contents."
4499 (mapc (lambda (a-feed)
4500 (when (or (eq feed 'any)
4501 (eq (car a-feed) feed))
4502 (let ((items (cdr a-feed)))
4503 (mapc (lambda (item)
4504 (when (or (eq old-age 'any)
4505 (eq (newsticker--age item) old-age))
4506 (setcar (nthcdr 4 item) new-age)
4507 (newsticker--do-forget-preformatted item)))
4508 items))))
4509 data)
4510 data)
4511
4512(defun newsticker--cache-mark-expired (data feed old-age new-age time)
4513 "Mark all expired entries.
4514This function sets the age entries in DATA in the feed FEED. If
4515an item's age is OLD-AGE it is set to NEW-AGE if the item is
4516older than TIME."
4517 (mapc
4518 (lambda (a-feed)
4519 (when (or (eq feed 'any)
4520 (eq (car a-feed) feed))
4521 (let ((items (cdr a-feed)))
4522 (mapc
4523 (lambda (item)
4524 (when (eq (newsticker--age item) old-age)
4525 (let ((exp-time (time-add (newsticker--time item)
4526 (seconds-to-time time))))
4527 (when (time-less-p exp-time (current-time))
4528 (newsticker--debug-msg
4529 "Item `%s' from %s has expired on %s"
4530 (newsticker--title item)
4531 (format-time-string "%Y-%02m-%d, %H:%M"
4532 (newsticker--time item))
4533 (format-time-string "%Y-%02m-%d, %H:%M" exp-time))
4534 (setcar (nthcdr 4 item) new-age)))))
4535 items))))
4536 data)
4537 data)
4538
4539(defun newsticker--cache-contains (data feed title desc link age
4540 &optional guid)
4541 "Check DATA whether FEED contains an item with the given properties.
4542This function returns the contained item or nil if it is not
4543contained.
4544The properties which are checked are TITLE, DESC, LINK, AGE, and
4545GUID. In general all properties must match in order to return a
4546certain item, except for the following cases.
4547
4548If AGE equals 'feed the TITLE, DESCription and LINK do not
4549matter. If DESC is nil it is ignored as well. If
4550`newsticker-desc-comp-max' is non-nil, only the first
4551`newsticker-desc-comp-max' characters of DESC are taken into
4552account.
4553
4554If GUID is non-nil it is sufficient to match this value, and the
4555other properties are ignored."
4556 (condition-case nil
4557 (catch 'found
4558 (when (and desc newsticker-desc-comp-max
4559 (> (length desc) newsticker-desc-comp-max))
4560 (setq desc (substring desc 0 newsticker-desc-comp-max)))
4561 (mapc
4562 (lambda (this-feed)
4563 (when (eq (car this-feed) feed)
4564 (mapc (lambda (anitem)
4565 (when (or
4566 ;; global unique id can match
4567 (and guid
4568 (string= guid (newsticker--guid anitem)))
4569 ;; or title, desc, etc.
4570 (and
4571 ;;(or (not (eq age 'feed))
4572 ;; (eq (newsticker--age anitem) 'feed))
4573 (string= (newsticker--title anitem)
4574 title)
4575 (or (not link)
4576 (string= (newsticker--link anitem)
4577 link))
4578 (or (not desc)
4579 (if (and desc newsticker-desc-comp-max
4580 (> (length (newsticker--desc anitem))
4581 newsticker-desc-comp-max))
4582 (string= (substring
4583 (newsticker--desc anitem)
4584 0 newsticker-desc-comp-max)
4585 desc)
4586 (string= (newsticker--desc anitem)
4587 desc)))))
4588 (throw 'found anitem)))
4589 (cdr this-feed))))
4590 data)
4591 nil)
4592 (error nil)))
4593
4594(defun newsticker--cache-add (data feed-name-symbol title desc link time age
4595 position extra-elements
4596 &optional updated-age updated-time
4597 preformatted-contents
4598 preformatted-title)
4599 "Add another item to cache data.
4600Add to DATA in the FEED-NAME-SYMBOL an item with TITLE, DESC,
4601LINK, TIME, AGE, POSITION, and EXTRA-ELEMENTS. If this item is
4602contained already, its mark is set to UPDATED-AGE, its time is
4603set to UPDATED-TIME, and its pre-formatted contents is set to
4604PREFORMATTED-CONTENTS and PREFORMATTED-TITLE. Returns the age
4605which the item got."
4606 (let ((item (newsticker--cache-contains data feed-name-symbol title
4607 desc link age)))
4608 (if item
4609 ;; does exist already -- change age, update time and position
4610 (progn
4611 (if (nthcdr 5 item)
4612 (setcar (nthcdr 5 item) position)
4613 (setcdr (nthcdr 4 item) (list position)))
4614 (setcar (nthcdr 4 item) updated-age)
4615 (if updated-time
4616 (setcar (nthcdr 3 item) updated-time))
4617 ;; replace cached pre-formatted contents
4618 (newsticker--cache-set-preformatted-contents
4619 item preformatted-contents)
4620 (newsticker--cache-set-preformatted-title
4621 item preformatted-title))
4622 ;; did not exist or age equals 'feed-name-symbol
4623 (catch 'found
4624 (mapc (lambda (this-feed)
4625 (when (eq (car this-feed) feed-name-symbol)
4626 (setcdr this-feed (nconc (cdr this-feed)
4627 (list (list title desc link
4628 time age position
4629 preformatted-contents
4630 preformatted-title
4631 extra-elements))))
4632 (throw 'found this-feed)))
4633 data)
4634 ;; the feed is not contained
4635 (add-to-list 'data (list feed-name-symbol
4636 (list title desc link time age position
4637 preformatted-contents
4638 preformatted-title
4639 extra-elements))
4640 t))))
4641 data)
4642
4643(defun newsticker--cache-remove (data feed-symbol age)
4644 "Remove all entries from DATA in the feed FEED-SYMBOL with AGE.
4645FEED-SYMBOL may be 'any. Entries from old feeds, which are no longer in
4646`newsticker-url-list' or `newsticker-url-list-defaults', are removed as
4647well."
4648 (let* ((pos data)
4649 (feed (car pos))
4650 (last-pos nil))
4651 (while feed
4652 (if (or (assoc (symbol-name (car feed)) newsticker-url-list)
4653 (assoc (symbol-name (car feed)) newsticker-url-list-defaults))
4654 ;; feed is still valid=active
4655 ;; (message "Keeping feed %s" (car feed))
4656 (if (or (eq feed-symbol 'any)
4657 (eq feed-symbol (car feed)))
4658 (let* ((item-pos (cdr feed))
4659 (item (car item-pos))
4660 (prev-pos nil))
4661 (while item
4662 ;;(message "%s" (car item))
4663 (if (eq age (newsticker--age item))
4664 ;; remove this item
4665 (progn
4666 ;;(message "Removing item %s" (car item))
4667 (if prev-pos
4668 (setcdr prev-pos (cdr item-pos))
4669 (setcdr feed (cdr item-pos))))
4670 ;;(message "Keeping item %s" (car item))
4671 (setq prev-pos item-pos))
4672 (setq item-pos (cdr item-pos))
4673 (setq item (car item-pos)))))
4674 ;; feed is not active anymore
4675 ;; (message "Removing feed %s" (car feed))
4676 (if last-pos
4677 (setcdr last-pos (cdr pos))
4678 (setq data (cdr pos))))
4679 (setq last-pos pos)
4680 (setq pos (cdr pos))
4681 (setq feed (car pos)))))
4682
4683;; ======================================================================
4684;;; Sorting
4685;; ======================================================================
4686(defun newsticker--cache-item-compare-by-time (item1 item2)
4687 "Compare two news items ITEM1 and ITEM2 by comparing their time values."
4688 (catch 'result
4689 (let ((age1 (newsticker--age item1))
4690 (age2 (newsticker--age item2)))
4691 (if (not (eq age1 age2))
4692 (cond ((eq age1 'obsolete)
4693 (throw 'result nil))
4694 ((eq age2 'obsolete)
4695 (throw 'result t)))))
4696 (let* ((time1 (newsticker--time item1))
4697 (time2 (newsticker--time item2)))
4698 (cond ((< (nth 0 time1) (nth 0 time2))
4699 nil)
4700 ((> (nth 0 time1) (nth 0 time2))
4701 t)
4702 ((< (nth 1 time1) (nth 1 time2))
4703 nil)
4704 ((> (nth 1 time1) (nth 1 time2))
4705 t)
4706 ((< (or (nth 2 time1) 0) (or (nth 2 time2) 0))
4707 nil)
4708 ((> (or (nth 2 time1) 0) (or (nth 2 time2) 0))
4709 t)
4710 (t
4711 nil)))))
4712
4713(defun newsticker--cache-item-compare-by-title (item1 item2)
4714 "Compare ITEM1 and ITEM2 by comparing their titles."
4715 (catch 'result
4716 (let ((age1 (newsticker--age item1))
4717 (age2 (newsticker--age item2)))
4718 (if (not (eq age1 age2))
4719 (cond ((eq age1 'obsolete)
4720 (throw 'result nil))
4721 ((eq age2 'obsolete)
4722 (throw 'result t)))))
4723 (string< (newsticker--title item1) (newsticker--title item2))))
4724
4725(defun newsticker--cache-item-compare-by-position (item1 item2)
4726 "Compare ITEM1 and ITEM2 by comparing their original positions."
4727 (catch 'result
4728 (let ((age1 (newsticker--age item1))
4729 (age2 (newsticker--age item2)))
4730 (if (not (eq age1 age2))
4731 (cond ((eq age1 'obsolete)
4732 (throw 'result nil))
4733 ((eq age2 'obsolete)
4734 (throw 'result t)))))
4735 (< (or (newsticker--pos item1) 0) (or (newsticker--pos item2) 0))))
4736
4737(defun newsticker--cache-sort ()
4738 "Sort the newsticker cache data."
4739 (let ((sort-fun (cond ((eq newsticker-sort-method 'sort-by-time)
4740 'newsticker--cache-item-compare-by-time)
4741 ((eq newsticker-sort-method 'sort-by-title)
4742 'newsticker--cache-item-compare-by-title)
4743 ((eq newsticker-sort-method 'sort-by-original-order)
4744 'newsticker--cache-item-compare-by-position))))
4745 (mapc (lambda (feed-list)
4746 (setcdr feed-list (sort (cdr feed-list)
4747 sort-fun)))
4748 newsticker--cache)))
4749
4750(defun newsticker--cache-update (&optional save)
4751 "Update newsticker cache file.
4752If optional argument SAVE is not nil the cache file is saved to disk."
4753 (save-excursion
4754 (let ((coding-system-for-write 'utf-8)
4755 (buf (find-file-noselect newsticker-cache-filename)))
4756 (when buf
4757 (set-buffer buf)
4758 (setq buffer-undo-list t)
4759 (erase-buffer)
4760 (insert ";; -*- coding: utf-8 -*-\n")
4761 (insert (prin1-to-string newsticker--cache))
4762 (when save
4763 (save-buffer))))))
4764
4765(defun newsticker--cache-get-feed (feed)
4766 "Return the cached data for the feed FEED.
4767FEED is a symbol!"
4768 (assoc feed newsticker--cache))
4769
4770;; ======================================================================
4771;;; Statistics
4772;; ======================================================================
4773(defun newsticker--stat-num-items (feed &optional age)
4774 "Return number of items in the given FEED which have the given AGE.
4775If AGE is nil, the total number items is returned."
4776 (let ((items (cdr (newsticker--cache-get-feed feed)))
4777 (num 0))
4778 (while items
4779 (if age
4780 (if (eq (newsticker--age (car items)) age)
4781 (setq num (1+ num)))
4782 (if (memq (newsticker--age (car items)) '(new old immortal obsolete))
4783 (setq num (1+ num))))
4784 (setq items (cdr items)))
4785 num))
4786
4787;; ======================================================================
4788;;; OPML
4789;; ======================================================================
4790(defun newsticker-opml-export ()
4791 "OPML subscription export.
4792Export subscriptions to a buffer in OPML Format."
4793 (interactive)
4794 (with-current-buffer (get-buffer-create "*OPML Export*")
4795 (set-buffer-file-coding-system 'utf-8)
4796 (insert (concat
4797 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
4798 "<!-- OPML generated by Emacs newsticker.el -->\n"
4799 "<opml version=\"1.0\">\n"
4800 " <head>\n"
4801 " <title>mySubscriptions</title>\n"
4802 " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
4803 "</dateCreated>\n"
4804 " <ownerEmail>" user-mail-address "</ownerEmail>\n"
4805 " <ownerName>" (user-full-name) "</ownerName>\n"
4806 " </head>\n"
4807 " <body>\n"))
4808 (mapc (lambda (sub)
4809 (insert " <outline text=\"")
4810 (insert (newsticker--title sub))
4811 (insert "\" xmlUrl=\"")
4812 (insert (cadr sub))
4813 (insert "\"/>\n"))
4814 (append newsticker-url-list newsticker-url-list-defaults))
4815 (insert " </body>\n</opml>\n"))
4816 (pop-to-buffer "*OPML Export*")
4817 (when (fboundp 'sgml-mode)
4818 (sgml-mode)))
4819
4820(defun newsticker-opml-import (filename)
4821 "Import OPML data from FILENAME."
4822 (interactive "fOPML file: ")
4823 (set-buffer (find-file-noselect filename))
4824 (goto-char (point-min))
4825 (let* ((node-list (xml-parse-region (point-min) (point-max)))
4826 (body (car (xml-get-children (car node-list) 'body)))
4827 (outlines (xml-get-children body 'outline)))
4828 (mapc (lambda (outline)
4829 (let ((name (xml-get-attribute outline 'text))
4830 (url (xml-get-attribute outline 'xmlUrl)))
4831 (add-to-list 'newsticker-url-list
4832 (list name url nil nil nil) t)))
4833 outlines))
4834 (customize-variable 'newsticker-url-list))
4835
4836;; ======================================================================
4837;;; Auto marking
4838;; ======================================================================
4839(defun newsticker--run-auto-mark-filter (feed item)
4840 "Automatically mark an item as old or immortal.
4841This function checks the variable `newsticker-auto-mark-filter'
4842for an entry that matches FEED and ITEM."
4843 (let ((case-fold-search t))
4844 (mapc (lambda (filter)
4845 (let ((filter-feed (car filter))
4846 (old-list (nth 1 filter))
4847 (imm-list (nth 2 filter)))
4848 (when (string-match filter-feed feed)
4849 (newsticker--do-run-auto-mark-filter item 'old old-list)
4850 (newsticker--do-run-auto-mark-filter item 'immortal imm-list))))
4851 newsticker-auto-mark-filter)))
4852
4853(defun newsticker--do-run-auto-mark-filter (item age list)
4854 "Actually compare ITEM AGE LIST against `newsticker-auto-mark-filter'."
4855 (mapc (lambda (pattern)
4856 (when (string-match pattern (newsticker--title item))
4857 (setcar (nthcdr 4 item) age)))
4858 list))
4859
4860
4861;; ======================================================================
4862;;; hook samples
4863;; ======================================================================
4864(defun newsticker-new-item-functions-sample (feed item)
4865 "Demonstrate the use of the `newsticker-new-item-functions' hook.
4866This function just prints out the values of the FEED and title of the ITEM."
4867 (message (concat "newsticker-new-item-functions-sample: feed=`%s', "
4868 "title=`%s'")
4869 feed (newsticker--title item)))
4870
4871(defun newsticker-download-images (feed item)
4872 "Download the first image.
4873If FEED equals \"imagefeed\" download the first image URL found
4874in the description=contents of ITEM to the directory
4875\"~/tmp/newsticker/FEED/TITLE\" where TITLE is the title of the item."
4876 (when (string= feed "imagefeed")
4877 (let ((title (newsticker--title item))
4878 (desc (newsticker--desc item)))
4879 (when (string-match "<img src=\"\\(http://[^ \"]+\\)\"" desc)
4880 (let ((url (substring desc (match-beginning 1) (match-end 1)))
4881 (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
4882 (org-dir default-directory))
4883 (unless (file-directory-p temp-dir)
4884 (make-directory temp-dir t))
4885 (cd temp-dir)
4886 (message "Getting image %s" url)
4887 (apply 'start-process "wget-image"
4888 " *newsticker-wget-download-images*"
4889 newsticker-wget-name
4890 (list url))
4891 (cd org-dir))))))
4892
4893(defun newsticker-download-enclosures (feed item)
4894 "In all FEEDs download the enclosed object of the news ITEM.
4895The object is saved to the directory \"~/tmp/newsticker/FEED/TITLE\", which
4896is created if it does not exist. TITLE is the title of the news
4897item. Argument FEED is ignored.
4898This function is suited for adding it to `newsticker-new-item-functions'."
4899 (let ((title (newsticker--title item))
4900 (enclosure (newsticker--enclosure item)))
4901 (when enclosure
4902 (let ((url (cdr (assoc 'url enclosure)))
4903 (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
4904 (org-dir default-directory))
4905 (unless (file-directory-p temp-dir)
4906 (make-directory temp-dir t))
4907 (cd temp-dir)
4908 (message "Getting enclosure %s" url)
4909 (apply 'start-process "wget-enclosure"
4910 " *newsticker-wget-download-enclosures*"
4911 newsticker-wget-name
4912 (list url))
4913 (cd org-dir)))))
4914
4915
4916(provide 'newsticker)
4917
4918;; arch-tag: ab761dfa-67bc-4207-bc64-4307271dc381
4919;;; newsticker.el ends here
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index f0836cbf2b0..f29051ab0b0 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -307,7 +307,7 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
307(defcustom compilation-error-regexp-alist 307(defcustom compilation-error-regexp-alist
308 (mapcar 'car compilation-error-regexp-alist-alist) 308 (mapcar 'car compilation-error-regexp-alist-alist)
309 "Alist that specifies how to match errors in compiler output. 309 "Alist that specifies how to match errors in compiler output.
310Note that on Unix everything is a valid filename, so these 310On GNU and Unix, any string is a valid filename, so these
311matchers must make some common sense assumptions, which catch 311matchers must make some common sense assumptions, which catch
312normal cases. A shorter list will be lighter on resource usage. 312normal cases. A shorter list will be lighter on resource usage.
313 313
@@ -436,6 +436,7 @@ nil as an element means to try the default directory."
436 (string :tag "Directory"))) 436 (string :tag "Directory")))
437 :group 'compilation) 437 :group 'compilation)
438 438
439;;;###autoload
439(defcustom compile-command "make -k " 440(defcustom compile-command "make -k "
440 "*Last shell command used to do a compilation; default for next compilation. 441 "*Last shell command used to do a compilation; default for next compilation.
441 442
@@ -452,6 +453,7 @@ You might also use mode hooks to specify it in certain modes, like this:
452 :type 'string 453 :type 'string
453 :group 'compilation) 454 :group 'compilation)
454 455
456;;;###autoload
455(defcustom compilation-disable-input nil 457(defcustom compilation-disable-input nil
456 "*If non-nil, send end-of-file as compilation process input. 458 "*If non-nil, send end-of-file as compilation process input.
457This only affects platforms that support asynchronous processes (see 459This only affects platforms that support asynchronous processes (see
@@ -664,24 +666,26 @@ just char-counts."
664 (move-to-column col) 666 (move-to-column col)
665 (goto-char (min (+ (line-beginning-position) col) (line-end-position))))) 667 (goto-char (min (+ (line-beginning-position) col) (line-end-position)))))
666 668
667(defun compilation-internal-error-properties (file line end-line col end-col type fmt) 669(defun compilation-internal-error-properties (file line end-line col end-col type fmts)
668 "Get the meta-info that will be added as text-properties. 670 "Get the meta-info that will be added as text-properties.
669LINE, END-LINE, COL, END-COL are integers or nil. 671LINE, END-LINE, COL, END-COL are integers or nil.
670TYPE can be 0, 1, or 2. 672TYPE can be 0, 1, or 2, meaning error, warning, or just info.
671FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil." 673FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil.
674FMTS is a list of format specs for transforming the file name.
675 (See `compilation-error-regexp-alist'.)"
672 (unless file (setq file '("*unknown*"))) 676 (unless file (setq file '("*unknown*")))
673 (setq file (compilation-get-file-structure file fmt)) 677 (let* ((file-struct (compilation-get-file-structure file fmts))
674 ;; Get first already existing marker (if any has one, all have one). 678 ;; Get first already existing marker (if any has one, all have one).
675 ;; Do this first, as the compilation-assq`s may create new nodes. 679 ;; Do this first, as the compilation-assq`s may create new nodes.
676 (let* ((marker-line (car (cddr file))) ; a line structure 680 (marker-line (car (cddr file-struct))) ; a line structure
677 (marker (nth 3 (cadr marker-line))) ; its marker 681 (marker (nth 3 (cadr marker-line))) ; its marker
678 (compilation-error-screen-columns compilation-error-screen-columns) 682 (compilation-error-screen-columns compilation-error-screen-columns)
679 end-marker loc end-loc) 683 end-marker loc end-loc)
680 (if (not (and marker (marker-buffer marker))) 684 (if (not (and marker (marker-buffer marker)))
681 (setq marker) ; no valid marker for this file 685 (setq marker nil) ; no valid marker for this file
682 (setq loc (or line 1)) ; normalize no linenumber to line 1 686 (setq loc (or line 1)) ; normalize no linenumber to line 1
683 (catch 'marker ; find nearest loc, at least one exists 687 (catch 'marker ; find nearest loc, at least one exists
684 (dolist (x (nthcdr 3 file)) ; loop over remaining lines 688 (dolist (x (nthcdr 3 file-struct)) ; loop over remaining lines
685 (if (> (car x) loc) ; still bigger 689 (if (> (car x) loc) ; still bigger
686 (setq marker-line x) 690 (setq marker-line x)
687 (if (> (- (or (car marker-line) 1) loc) 691 (if (> (- (or (car marker-line) 1) loc)
@@ -710,17 +714,18 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
710 (forward-to-indentation 0)) 714 (forward-to-indentation 0))
711 (setq marker (list (point-marker)))))) 715 (setq marker (list (point-marker))))))
712 716
713 (setq loc (compilation-assq line (cdr file))) 717 (setq loc (compilation-assq line (cdr file-struct)))
714 (if end-line 718 (if end-line
715 (setq end-loc (compilation-assq end-line (cdr file)) 719 (setq end-loc (compilation-assq end-line (cdr file-struct))
716 end-loc (compilation-assq end-col end-loc)) 720 end-loc (compilation-assq end-col end-loc))
717 (if end-col ; use same line element 721 (if end-col ; use same line element
718 (setq end-loc (compilation-assq end-col loc)))) 722 (setq end-loc (compilation-assq end-col loc))))
719 (setq loc (compilation-assq col loc)) 723 (setq loc (compilation-assq col loc))
720 ;; If they are new, make the loc(s) reference the file they point to. 724 ;; If they are new, make the loc(s) reference the file they point to.
721 (or (cdr loc) (setcdr loc `(,line ,file ,@marker))) 725 (or (cdr loc) (setcdr loc `(,line ,file-struct ,@marker)))
722 (if end-loc 726 (if end-loc
723 (or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker)))) 727 (or (cdr end-loc)
728 (setcdr end-loc `(,(or end-line line) ,file-struct ,@end-marker))))
724 729
725 ;; Must start with face 730 ;; Must start with face
726 `(face ,compilation-message-face 731 `(face ,compilation-message-face
@@ -1570,8 +1575,7 @@ This is the value of `next-error-function' in Compilation buffers."
1570 ;; markers for that file. 1575 ;; markers for that file.
1571 (unless (and (nth 3 loc) (marker-buffer (nth 3 loc))) 1576 (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)))
1572 (with-current-buffer (compilation-find-file marker (caar (nth 2 loc)) 1577 (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
1573 (or (cdar (nth 2 loc)) 1578 (cadr (car (nth 2 loc))))
1574 default-directory))
1575 (save-restriction 1579 (save-restriction
1576 (widen) 1580 (widen)
1577 (goto-char (point-min)) 1581 (goto-char (point-min))
@@ -1734,16 +1738,21 @@ and overlay is highlighted between MK and END-MK."
1734 (copy-marker (line-beginning-position)))))) 1738 (copy-marker (line-beginning-position))))))
1735 1739
1736 1740
1737(defun compilation-find-file (marker filename dir &rest formats) 1741(defun compilation-find-file (marker filename directory &rest formats)
1738 "Find a buffer for file FILENAME. 1742 "Find a buffer for file FILENAME.
1739Search the directories in `compilation-search-path'. 1743Search the directories in `compilation-search-path'.
1740A nil in `compilation-search-path' means to try the 1744A nil in `compilation-search-path' means to try the
1741current directory, which is passed in DIR. 1745\"current\" directory, which is passed in DIRECTORY.
1746If DIRECTORY. is relative, it is combined with `default-directory'.
1747If DIRECTORY. is nil, that means use `default-directory'.
1742If FILENAME is not found at all, ask the user where to find it. 1748If FILENAME is not found at all, ask the user where to find it.
1743Pop up the buffer containing MARKER and scroll to MARKER if we ask the user." 1749Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
1744 (or formats (setq formats '("%s"))) 1750 (or formats (setq formats '("%s")))
1745 (save-excursion 1751 (save-excursion
1746 (let ((dirs compilation-search-path) 1752 (let ((dirs compilation-search-path)
1753 (spec-dir (if directory
1754 (expand-file-name directory)
1755 default-directory))
1747 buffer thisdir fmts name) 1756 buffer thisdir fmts name)
1748 (if (file-name-absolute-p filename) 1757 (if (file-name-absolute-p filename)
1749 ;; The file name is absolute. Use its explicit directory as 1758 ;; The file name is absolute. Use its explicit directory as
@@ -1753,7 +1762,7 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
1753 filename (file-name-nondirectory filename))) 1762 filename (file-name-nondirectory filename)))
1754 ;; Now search the path. 1763 ;; Now search the path.
1755 (while (and dirs (null buffer)) 1764 (while (and dirs (null buffer))
1756 (setq thisdir (or (car dirs) dir) 1765 (setq thisdir (or (car dirs) spec-dir)
1757 fmts formats) 1766 fmts formats)
1758 ;; For each directory, try each format string. 1767 ;; For each directory, try each format string.
1759 (while (and fmts (null buffer)) 1768 (while (and fmts (null buffer))
@@ -1771,7 +1780,7 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
1771 (read-file-name 1780 (read-file-name
1772 (format "Find this %s in: (default %s) " 1781 (format "Find this %s in: (default %s) "
1773 compilation-error filename) 1782 compilation-error filename)
1774 dir filename t)))) 1783 spec-dir filename t))))
1775 (if (file-directory-p name) 1784 (if (file-directory-p name)
1776 (setq name (expand-file-name filename name))) 1785 (setq name (expand-file-name filename name)))
1777 (setq buffer (and (file-exists-p name) 1786 (setq buffer (and (file-exists-p name)
@@ -1785,26 +1794,32 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
1785 1794
1786(defun compilation-get-file-structure (file &optional fmt) 1795(defun compilation-get-file-structure (file &optional fmt)
1787 "Retrieve FILE's file-structure or create a new one. 1796 "Retrieve FILE's file-structure or create a new one.
1788FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)." 1797FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
1798In the former case, FILENAME may be relative or absolute.
1789 1799
1800The file-structure looks like this:
1801 (list (list FILENAME [DIR-FROM-PREV-MSG]) FMT LINE-STRUCT...)
1802"
1790 (or (gethash file compilation-locs) 1803 (or (gethash file compilation-locs)
1791 ;; File was not previously encountered, at least not in the form passed. 1804 ;; File was not previously encountered, at least not in the form passed.
1792 ;; Let's normalize it and look again. 1805 ;; Let's normalize it and look again.
1793 (let ((filename (car file)) 1806 (let ((filename (car file))
1794 (default-directory (if (cdr file) 1807 ;; Get the specified directory from FILE.
1795 (file-truename (cdr file)) 1808 (spec-directory (if (cdr file)
1796 default-directory))) 1809 (file-truename (cdr file)))))
1797 1810
1798 ;; Check for a comint-file-name-prefix and prepend it if appropriate. 1811 ;; Check for a comint-file-name-prefix and prepend it if appropriate.
1799 ;; (This is very useful for compilation-minor-mode in an rlogin-mode 1812 ;; (This is very useful for compilation-minor-mode in an rlogin-mode
1800 ;; buffer.) 1813 ;; buffer.)
1801 (if (boundp 'comint-file-name-prefix) 1814 (when (and (boundp 'comint-file-name-prefix)
1802 (if (file-name-absolute-p filename) 1815 (not (equal comint-file-name-prefix "")))
1803 (setq filename 1816 (if (file-name-absolute-p filename)
1804 (concat (with-no-warnings comint-file-name-prefix) filename)) 1817 (setq filename
1805 (setq default-directory 1818 (concat comint-file-name-prefix filename))
1806 (file-truename 1819 (if spec-directory
1807 (concat (with-no-warnings comint-file-name-prefix) default-directory))))) 1820 (setq spec-directory
1821 (file-truename
1822 (concat comint-file-name-prefix spec-directory))))))
1808 1823
1809 ;; If compilation-parse-errors-filename-function is 1824 ;; If compilation-parse-errors-filename-function is
1810 ;; defined, use it to process the filename. 1825 ;; defined, use it to process the filename.
@@ -1820,20 +1835,13 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."
1820 ;; name and fix them. 1835 ;; name and fix them.
1821 (setq filename (command-line-normalize-file-name filename)) 1836 (setq filename (command-line-normalize-file-name filename))
1822 1837
1823 ;; Now eliminate any "..", because find-file would get them wrong.
1824 ;; Make relative and absolute filenames, with or without links, the
1825 ;; same.
1826 (setq filename
1827 (list (abbreviate-file-name
1828 (file-truename (if (cdr file)
1829 (expand-file-name filename)
1830 filename)))))
1831
1832 ;; Store it for the possibly unnormalized name 1838 ;; Store it for the possibly unnormalized name
1833 (puthash file 1839 (puthash file
1834 ;; Retrieve or create file-structure for normalized name 1840 ;; Retrieve or create file-structure for normalized name
1835 (or (gethash filename compilation-locs) 1841 (or (gethash (list filename) compilation-locs)
1836 (puthash filename (list filename fmt) compilation-locs)) 1842 (puthash (list filename)
1843 (list (list filename spec-directory) fmt)
1844 compilation-locs))
1837 compilation-locs)))) 1845 compilation-locs))))
1838 1846
1839(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$") 1847(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index 0f3aeb06895..7020dd0c2b7 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -5,7 +5,7 @@
5 5
6;; This file is part of GNU Emacs. 6;; This file is part of GNU Emacs.
7 7
8;; Maintainer's Time-stamp: <2004-06-13 19:04:36 teirllm> 8;; Maintainer's Time-stamp: <2004-09-25 20:55:35 gildea>
9;; Maintainer: Stephen Gildea <gildea@stop.mail-abuse.org> 9;; Maintainer: Stephen Gildea <gildea@stop.mail-abuse.org>
10;; Keywords: tools 10;; Keywords: tools
11 11
@@ -143,20 +143,26 @@ the first (last) `time-stamp-line-limit' lines of the file for the
143file to be time-stamped by \\[time-stamp]. A value of 0 searches the 143file to be time-stamped by \\[time-stamp]. A value of 0 searches the
144entire buffer (use with care). 144entire buffer (use with care).
145 145
146Do not change `time-stamp-line-limit', `time-stamp-start', or 146This value can also be set with the variable `time-stamp-pattern'.
147`time-stamp-end' for yourself or you will be incompatible 147
148with other people's files! If you must change them for some application, 148Do not change `time-stamp-line-limit', `time-stamp-start',
149do so in the local variables section of the time-stamped file itself.") 149`time-stamp-end', or `time-stamp-pattern' for yourself or you will be
150incompatible with other people's files! If you must change them for some
151application, do so in the local variables section of the time-stamped file
152itself.")
150 153
151 154
152(defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change! 155(defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change!
153 "Regexp after which the time stamp is written by \\[time-stamp]. 156 "Regexp after which the time stamp is written by \\[time-stamp].
154See also the variables `time-stamp-end' and `time-stamp-line-limit'. 157See also the variables `time-stamp-end' and `time-stamp-line-limit'.
155 158
156Do not change `time-stamp-line-limit', `time-stamp-start', or 159This value can also be set with the variable `time-stamp-pattern'.
157`time-stamp-end' for yourself or you will be incompatible 160
158with other people's files! If you must change them for some application, 161Do not change `time-stamp-line-limit', `time-stamp-start',
159do so in the local variables section of the time-stamped file itself.") 162`time-stamp-end', or `time-stamp-pattern' for yourself or you will be
163incompatible with other people's files! If you must change them for some
164application, do so in the local variables section of the time-stamped file
165itself.")
160 166
161 167
162(defvar time-stamp-end "\\\\?[\">]" ;Do not change! 168(defvar time-stamp-end "\\\\?[\">]" ;Do not change!
@@ -165,13 +171,15 @@ do so in the local variables section of the time-stamped file itself.")
165and the following match of `time-stamp-end', then writes the 171and the following match of `time-stamp-end', then writes the
166time stamp specified by `time-stamp-format' between them. 172time stamp specified by `time-stamp-format' between them.
167 173
174This value can also be set with the variable `time-stamp-pattern'.
175
168The end text normally starts on the same line as the start text ends, 176The end text normally starts on the same line as the start text ends,
169but if there are any newlines in `time-stamp-format', the same number 177but if there are any newlines in `time-stamp-format', the same number
170of newlines must separate the start and end. \\[time-stamp] tries 178of newlines must separate the start and end. \\[time-stamp] tries
171to not change the number of lines in the buffer. `time-stamp-inserts-lines' 179to not change the number of lines in the buffer. `time-stamp-inserts-lines'
172controls this behavior. 180controls this behavior.
173 181
174Do not change `time-stamp-line-limit', `time-stamp-start', `time-stamp-end', 182Do not change `time-stamp-start', `time-stamp-end', `time-stamp-pattern',
175or `time-stamp-inserts-lines' for yourself or you will be incompatible 183or `time-stamp-inserts-lines' for yourself or you will be incompatible
176with other people's files! If you must change them for some application, 184with other people's files! If you must change them for some application,
177do so in the local variables section of the time-stamped file itself.") 185do so in the local variables section of the time-stamped file itself.")
@@ -231,9 +239,11 @@ Examples:
231\"@set Time-stamp: %:b %:d, %:y$\" 239\"@set Time-stamp: %:b %:d, %:y$\"
232\"newcommand{\\\\\\\\timestamp}{%%}\" 240\"newcommand{\\\\\\\\timestamp}{%%}\"
233 241
234Do not change `time-stamp-pattern' for yourself or you will be incompatible 242Do not change `time-stamp-pattern' `time-stamp-line-limit',
235with other people's files! Set it only in the local variables section 243`time-stamp-start', or `time-stamp-end' for yourself or you will be
236of the time-stamped file itself.") 244incompatible with other people's files! If you must change them for
245some application, do so only in the local variables section of the
246time-stamped file itself.")
237 247
238 248
239 249
@@ -251,10 +261,11 @@ look like one of the following:
251The time stamp is written between the brackets or quotes: 261The time stamp is written between the brackets or quotes:
252 Time-stamp: <2001-02-18 10:20:51 gildea> 262 Time-stamp: <2001-02-18 10:20:51 gildea>
253The time stamp is updated only if the variable `time-stamp-active' is non-nil. 263The time stamp is updated only if the variable `time-stamp-active' is non-nil.
254The format of the time stamp is set by the variable `time-stamp-format'. 264The format of the time stamp is set by the variable `time-stamp-pattern' or
255The variables `time-stamp-line-limit', `time-stamp-start', `time-stamp-end', 265`time-stamp-format'. The variables `time-stamp-pattern',
256`time-stamp-count', and `time-stamp-inserts-lines' control finding the 266`time-stamp-line-limit', `time-stamp-start', `time-stamp-end',
257template." 267`time-stamp-count', and `time-stamp-inserts-lines' control finding
268the template."
258 (interactive) 269 (interactive)
259 (let ((line-limit time-stamp-line-limit) 270 (let ((line-limit time-stamp-line-limit)
260 (ts-start time-stamp-start) 271 (ts-start time-stamp-start)
@@ -588,6 +599,13 @@ and all `time-stamp-format' compatibility."
588 (user-full-name)) 599 (user-full-name))
589 ((eq cur-char ?h) ;mail host name 600 ((eq cur-char ?h) ;mail host name
590 (time-stamp-mail-host-name)) 601 (time-stamp-mail-host-name))
602 ((eq cur-char ?q) ;(undocumented unqual hostname)
603 (let ((qualname (system-name)))
604 (if (string-match "\\." qualname)
605 (substring qualname 0 (match-beginning 0))
606 qualname)))
607 ((eq cur-char ?Q) ;(undocumented fully-qualified host)
608 (system-name))
591 )) 609 ))
592 (let ((padded-result 610 (let ((padded-result
593 (format (format "%%%s%c" 611 (format (format "%%%s%c"
diff --git a/src/ChangeLog b/src/ChangeLog
index 13f8c409cde..29f3929ccd8 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,40 @@
12005-09-12 Kim F. Storm <storm@cua.dk>
2
3 * composite.c (compose_chars_in_text): Fix setup of `pend'.
4 Unconditionally reload `ptr' and `pend' after eval.
5
6 * xdisp.c (message3): Pass copy of lisp string to message_dolog.
7
8 * print.c (print_error_message): Pass copy of caller name to
9 message_dolog.
10
11 * fileio.c (auto_save_error): Pass copy of lisp string to message2.
12
132005-09-12 Kenichi Handa <handa@m17n.org>
14
15 * xdisp.c (display_mode_element): Be sure to make variables THIS
16 and LISP_STRING point into a string data of ELT.
17
182005-09-12 Kim F. Storm <storm@cua.dk>
19
20 * editfns.c (Ftranslate_region_internal): Reload `tt' after
21 signal_after_change that may have GC'ed.
22 (Fmessage, Fmessage_box, Fmessage_or_box): Doc fix.
23
24 * keymap.c (Fdescribe_buffer_bindings): Reload `translate'
25 after insert while runs signal_after_change.
26
27 * minibuf.c (Fminibuffer_complete_word): Move `completion_string'
28 declaration to where it is used.
29
30 * w32.c (check_windows_init_file): Fix allocation of error buffer.
31
32 * xfns.c (x_encode_text): Declare static. Add FREEP arg.
33 (x_set_name_internal): Call x_encode_text with new FREEP arg to
34 know if xfree is needed instead of guessing.
35
36 * xterm.h (x_encode_text): Remove prototype.
37
12005-09-11 Chris Prince <cprince@gmail.com> (tiny change) 382005-09-11 Chris Prince <cprince@gmail.com> (tiny change)
2 39
3 * w32term.c (x_bitmap_icon): Load small icons too. 40 * w32term.c (x_bitmap_icon): Load small icons too.
diff --git a/src/composite.c b/src/composite.c
index daa6dceb3c6..02abb66e1e5 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -616,7 +616,7 @@ compose_chars_in_text (start, end, string)
616 GCPRO1 (string); 616 GCPRO1 (string);
617 stop = end; 617 stop = end;
618 ptr = SDATA (string) + string_char_to_byte (string, start); 618 ptr = SDATA (string) + string_char_to_byte (string, start);
619 pend = ptr + SBYTES (string); 619 pend = SDATA (string) + SBYTES (string);
620 } 620 }
621 else 621 else
622 { 622 {
@@ -680,10 +680,19 @@ compose_chars_in_text (start, end, string)
680 { 680 {
681 start += XINT (val); 681 start += XINT (val);
682 if (STRINGP (string)) 682 if (STRINGP (string))
683 ptr = SDATA (string) + string_char_to_byte (string, start); 683 {
684 ptr = SDATA (string) + string_char_to_byte (string, start);
685 pend = SDATA (string) + SBYTES (string);
686 }
684 else 687 else
685 ptr = CHAR_POS_ADDR (start); 688 ptr = CHAR_POS_ADDR (start);
686 } 689 }
690 else if (STRINGP (string))
691 {
692 start++;
693 ptr = SDATA (string) + string_char_to_byte (string, start);
694 pend = SDATA (string) + SBYTES (string);
695 }
687 else 696 else
688 { 697 {
689 start++; 698 start++;
diff --git a/src/editfns.c b/src/editfns.c
index a05d2396448..e67e56d2efa 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2857,6 +2857,8 @@ It returns the number of characters changed. */)
2857 { 2857 {
2858 if (tt) 2858 if (tt)
2859 { 2859 {
2860 /* Reload as signal_after_change in last iteration may GC. */
2861 tt = SDATA (table);
2860 if (string_multibyte) 2862 if (string_multibyte)
2861 { 2863 {
2862 str = tt + string_char_to_byte (table, oc); 2864 str = tt + string_char_to_byte (table, oc);
@@ -3118,8 +3120,9 @@ The message also goes into the `*Messages*' buffer.
3118The first argument is a format control string, and the rest are data 3120The first argument is a format control string, and the rest are data
3119to be formatted under control of the string. See `format' for details. 3121to be formatted under control of the string. See `format' for details.
3120 3122
3121If the first argument is nil, the function clears any existing message; 3123If the first argument is nil or the empty string, the function clears
3122this lets the minibuffer contents show. See also `current-message'. 3124any existing message; this lets the minibuffer contents show. See
3125also `current-message'.
3123 3126
3124usage: (message STRING &rest ARGS) */) 3127usage: (message STRING &rest ARGS) */)
3125 (nargs, args) 3128 (nargs, args)
@@ -3148,8 +3151,8 @@ If a dialog box is not available, use the echo area.
3148The first argument is a format control string, and the rest are data 3151The first argument is a format control string, and the rest are data
3149to be formatted under control of the string. See `format' for details. 3152to be formatted under control of the string. See `format' for details.
3150 3153
3151If the first argument is nil, clear any existing message; let the 3154If the first argument is nil or the empty string, clear any existing
3152minibuffer contents show. 3155message; let the minibuffer contents show.
3153 3156
3154usage: (message-box STRING &rest ARGS) */) 3157usage: (message-box STRING &rest ARGS) */)
3155 (nargs, args) 3158 (nargs, args)
@@ -3210,8 +3213,8 @@ Otherwise, use the echo area.
3210The first argument is a format control string, and the rest are data 3213The first argument is a format control string, and the rest are data
3211to be formatted under control of the string. See `format' for details. 3214to be formatted under control of the string. See `format' for details.
3212 3215
3213If the first argument is nil, clear any existing message; let the 3216If the first argument is nil or the empty string, clear any existing
3214minibuffer contents show. 3217message; let the minibuffer contents show.
3215 3218
3216usage: (message-or-box STRING &rest ARGS) */) 3219usage: (message-or-box STRING &rest ARGS) */)
3217 (nargs, args) 3220 (nargs, args)
diff --git a/src/fileio.c b/src/fileio.c
index 53b989f52e2..56557da6a30 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5771,6 +5771,8 @@ auto_save_error (error)
5771 Lisp_Object args[3], msg; 5771 Lisp_Object args[3], msg;
5772 int i, nbytes; 5772 int i, nbytes;
5773 struct gcpro gcpro1; 5773 struct gcpro gcpro1;
5774 char *msgbuf;
5775 USE_SAFE_ALLOCA;
5774 5776
5775 ring_bell (XFRAME (selected_frame)); 5777 ring_bell (XFRAME (selected_frame));
5776 5778
@@ -5780,13 +5782,15 @@ auto_save_error (error)
5780 msg = Fformat (3, args); 5782 msg = Fformat (3, args);
5781 GCPRO1 (msg); 5783 GCPRO1 (msg);
5782 nbytes = SBYTES (msg); 5784 nbytes = SBYTES (msg);
5785 SAFE_ALLOCA (msgbuf, char *, nbytes);
5786 bcopy (SDATA (msg), msgbuf, nbytes);
5783 5787
5784 for (i = 0; i < 3; ++i) 5788 for (i = 0; i < 3; ++i)
5785 { 5789 {
5786 if (i == 0) 5790 if (i == 0)
5787 message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg)); 5791 message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg));
5788 else 5792 else
5789 message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg)); 5793 message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg));
5790 Fsleep_for (make_number (1), Qnil); 5794 Fsleep_for (make_number (1), Qnil);
5791 } 5795 }
5792 5796
diff --git a/src/keymap.c b/src/keymap.c
index 9d67f4400c0..8fa4d91a9c7 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -743,7 +743,7 @@ usage: (map-keymap FUNCTION KEYMAP) */)
743 Fsignal (Qinvalid_function, Fcons (function, Qnil)); 743 Fsignal (Qinvalid_function, Fcons (function, Qnil));
744 if (! NILP (sort_first)) 744 if (! NILP (sort_first))
745 return call3 (intern ("map-keymap-internal"), function, keymap, Qt); 745 return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
746 746
747 map_keymap (keymap, map_keymap_call, function, NULL, 1); 747 map_keymap (keymap, map_keymap_call, function, NULL, 1);
748 return Qnil; 748 return Qnil;
749} 749}
@@ -2837,6 +2837,9 @@ You type Translation\n\
2837 insert (buf, bufend - buf); 2837 insert (buf, bufend - buf);
2838 2838
2839 insert ("\n", 1); 2839 insert ("\n", 1);
2840
2841 /* Insert calls signal_after_change which may GC. */
2842 translate = SDATA (Vkeyboard_translate_table);
2840 } 2843 }
2841 2844
2842 insert ("\n", 1); 2845 insert ("\n", 1);
diff --git a/src/minibuf.c b/src/minibuf.c
index a66d0f8f5c8..34cadfc3e24 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -2164,7 +2164,6 @@ Return nil if there is no valid completion, else t. */)
2164{ 2164{
2165 Lisp_Object completion, tem, tem1; 2165 Lisp_Object completion, tem, tem1;
2166 register int i, i_byte; 2166 register int i, i_byte;
2167 register const unsigned char *completion_string;
2168 struct gcpro gcpro1, gcpro2; 2167 struct gcpro gcpro1, gcpro2;
2169 int prompt_end_charpos = XINT (Fminibuffer_prompt_end ()); 2168 int prompt_end_charpos = XINT (Fminibuffer_prompt_end ());
2170 2169
@@ -2295,7 +2294,7 @@ Return nil if there is no valid completion, else t. */)
2295 { 2294 {
2296 int len, c; 2295 int len, c;
2297 int bytes = SBYTES (completion); 2296 int bytes = SBYTES (completion);
2298 completion_string = SDATA (completion); 2297 register const unsigned char *completion_string = SDATA (completion);
2299 for (; i_byte < SBYTES (completion); i_byte += len, i++) 2298 for (; i_byte < SBYTES (completion); i_byte += len, i++)
2300 { 2299 {
2301 c = STRING_CHAR_AND_LENGTH (completion_string + i_byte, 2300 c = STRING_CHAR_AND_LENGTH (completion_string + i_byte,
diff --git a/src/print.c b/src/print.c
index 65c48b6d82b..2ba749aff44 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1025,7 +1025,9 @@ print_error_message (data, stream, context, caller)
1025 *Messages*. */ 1025 *Messages*. */
1026 if (!NILP (caller) && SYMBOLP (caller)) 1026 if (!NILP (caller) && SYMBOLP (caller))
1027 { 1027 {
1028 const char *name = SDATA (SYMBOL_NAME (caller)); 1028 Lisp_Object cname = SYMBOL_NAME (caller);
1029 char *name = alloca (SBYTES (cname));
1030 bcopy (SDATA (cname), name, SBYTES (cname));
1029 message_dolog (name, strlen (name), 0, 0); 1031 message_dolog (name, strlen (name), 0, 0);
1030 message_dolog (": ", 2, 0, 0); 1032 message_dolog (": ", 2, 0, 0);
1031 } 1033 }
diff --git a/src/w32.c b/src/w32.c
index c7f6e3172f9..9a51233527d 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -3894,7 +3894,9 @@ check_windows_init_file ()
3894 Lisp_Object load_path_print = Fprin1_to_string (full_load_path, Qnil); 3894 Lisp_Object load_path_print = Fprin1_to_string (full_load_path, Qnil);
3895 char *init_file_name = SDATA (init_file); 3895 char *init_file_name = SDATA (init_file);
3896 char *load_path = SDATA (load_path_print); 3896 char *load_path = SDATA (load_path_print);
3897 char *buffer = alloca (1024); 3897 char *buffer = alloca (1024
3898 + strlen (init_file_name)
3899 + strlen (load_path));
3898 3900
3899 sprintf (buffer, 3901 sprintf (buffer,
3900 "The Emacs Windows initialization file \"%s.el\" " 3902 "The Emacs Windows initialization file \"%s.el\" "
diff --git a/src/xdisp.c b/src/xdisp.c
index c8ca187f3df..031260c48ad 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -7048,7 +7048,15 @@ message3 (m, nbytes, multibyte)
7048 /* First flush out any partial line written with print. */ 7048 /* First flush out any partial line written with print. */
7049 message_log_maybe_newline (); 7049 message_log_maybe_newline ();
7050 if (STRINGP (m)) 7050 if (STRINGP (m))
7051 message_dolog (SDATA (m), nbytes, 1, multibyte); 7051 {
7052 char *buffer;
7053 USE_SAFE_ALLOCA;
7054
7055 SAFE_ALLOCA (buffer, char *, nbytes);
7056 bcopy (SDATA (m), buffer, nbytes);
7057 message_dolog (buffer, nbytes, 1, multibyte);
7058 SAFE_FREE ();
7059 }
7052 message3_nolog (m, nbytes, multibyte); 7060 message3_nolog (m, nbytes, multibyte);
7053 7061
7054 UNGCPRO; 7062 UNGCPRO;
@@ -16183,6 +16191,8 @@ display_mode_element (it, depth, field_width, precision, elt, props, risky)
16183 else /* c == 0 */ 16191 else /* c == 0 */
16184 break; 16192 break;
16185 } 16193 }
16194 this += SDATA (elt) - lisp_string;
16195 lisp_string = SDATA (elt);
16186 } 16196 }
16187 } 16197 }
16188 break; 16198 break;
diff --git a/src/xfns.c b/src/xfns.c
index 11f4c2eadb1..84521939ec2 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1524,11 +1524,12 @@ x_set_scroll_bar_background (f, value, oldval)
1524 Otherwise store 0 in *STRINGP, which means that the `encoding' of 1524 Otherwise store 0 in *STRINGP, which means that the `encoding' of
1525 the result should be `COMPOUND_TEXT'. */ 1525 the result should be `COMPOUND_TEXT'. */
1526 1526
1527unsigned char * 1527static unsigned char *
1528x_encode_text (string, coding_system, selectionp, text_bytes, stringp) 1528x_encode_text (string, coding_system, selectionp, text_bytes, stringp, freep)
1529 Lisp_Object string, coding_system; 1529 Lisp_Object string, coding_system;
1530 int *text_bytes, *stringp; 1530 int *text_bytes, *stringp;
1531 int selectionp; 1531 int selectionp;
1532 int *freep;
1532{ 1533{
1533 unsigned char *str = SDATA (string); 1534 unsigned char *str = SDATA (string);
1534 int chars = SCHARS (string); 1535 int chars = SCHARS (string);
@@ -1545,6 +1546,7 @@ x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
1545 /* No multibyte character in OBJ. We need not encode it. */ 1546 /* No multibyte character in OBJ. We need not encode it. */
1546 *text_bytes = bytes; 1547 *text_bytes = bytes;
1547 *stringp = 1; 1548 *stringp = 1;
1549 *freep = 0;
1548 return str; 1550 return str;
1549 } 1551 }
1550 1552
@@ -1572,6 +1574,7 @@ x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
1572 *stringp = (charset_info == 1 1574 *stringp = (charset_info == 1
1573 || (!EQ (coding_system, Qcompound_text) 1575 || (!EQ (coding_system, Qcompound_text)
1574 && !EQ (coding_system, Qcompound_text_with_extensions))); 1576 && !EQ (coding_system, Qcompound_text_with_extensions)));
1577 *freep = 1;
1575 return buf; 1578 return buf;
1576} 1579}
1577 1580
@@ -1610,16 +1613,13 @@ x_set_name_internal (f, name)
1610 in the future which can encode all Unicode characters. 1613 in the future which can encode all Unicode characters.
1611 But, for the moment, there's no way to know that the 1614 But, for the moment, there's no way to know that the
1612 current window manager supports it or not. */ 1615 current window manager supports it or not. */
1613 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp); 1616 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp,
1617 &do_free_text_value);
1614 text.encoding = (stringp ? XA_STRING 1618 text.encoding = (stringp ? XA_STRING
1615 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT); 1619 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1616 text.format = 8; 1620 text.format = 8;
1617 text.nitems = bytes; 1621 text.nitems = bytes;
1618 1622
1619 /* Check early, because ENCODE_UTF_8 below may GC and name may be
1620 relocated. */
1621 do_free_text_value = text.value != SDATA (name);
1622
1623 if (NILP (f->icon_name)) 1623 if (NILP (f->icon_name))
1624 { 1624 {
1625 icon = text; 1625 icon = text;
@@ -1628,12 +1628,11 @@ x_set_name_internal (f, name)
1628 { 1628 {
1629 /* See the above comment "Note: Encoding strategy". */ 1629 /* See the above comment "Note: Encoding strategy". */
1630 icon.value = x_encode_text (f->icon_name, coding_system, 0, 1630 icon.value = x_encode_text (f->icon_name, coding_system, 0,
1631 &bytes, &stringp); 1631 &bytes, &stringp, &do_free_icon_value);
1632 icon.encoding = (stringp ? XA_STRING 1632 icon.encoding = (stringp ? XA_STRING
1633 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT); 1633 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1634 icon.format = 8; 1634 icon.format = 8;
1635 icon.nitems = bytes; 1635 icon.nitems = bytes;
1636 do_free_icon_value = icon.value != SDATA (f->icon_name);
1637 } 1636 }
1638 1637
1639#ifdef USE_GTK 1638#ifdef USE_GTK
@@ -1996,7 +1995,7 @@ xic_create_fontsetname (base_fontname, motif)
1996 - the same but with the family also replaced with -*-*-. */ 1995 - the same but with the family also replaced with -*-*-. */
1997 char *p = base_fontname; 1996 char *p = base_fontname;
1998 int i; 1997 int i;
1999 1998
2000 for (i = 0; *p; p++) 1999 for (i = 0; *p; p++)
2001 if (*p == '-') i++; 2000 if (*p == '-') i++;
2002 if (i != 14) 2001 if (i != 14)
@@ -2020,7 +2019,7 @@ xic_create_fontsetname (base_fontname, motif)
2020 char *allcs = "*-*-*-*-*-*-*"; 2019 char *allcs = "*-*-*-*-*-*-*";
2021 char *allfamilies = "-*-*-"; 2020 char *allfamilies = "-*-*-";
2022 char *all = "*-*-*-*-"; 2021 char *all = "*-*-*-*-";
2023 2022
2024 for (i = 0, p = base_fontname; i < 8; p++) 2023 for (i = 0, p = base_fontname; i < 8; p++)
2025 { 2024 {
2026 if (*p == '-') 2025 if (*p == '-')
diff --git a/src/xterm.h b/src/xterm.h
index aa615d06a17..e2db932a0be 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -1041,8 +1041,6 @@ extern void x_real_positions P_ ((struct frame *, int *, int *));
1041extern int defined_color P_ ((struct frame *, char *, XColor *, int)); 1041extern int defined_color P_ ((struct frame *, char *, XColor *, int));
1042extern void x_set_border_pixel P_ ((struct frame *, int)); 1042extern void x_set_border_pixel P_ ((struct frame *, int));
1043extern void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object)); 1043extern void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
1044extern unsigned char * x_encode_text P_ ((Lisp_Object, Lisp_Object, int,
1045 int *, int *));
1046extern void x_implicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object)); 1044extern void x_implicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
1047extern void xic_free_xfontset P_ ((struct frame *)); 1045extern void xic_free_xfontset P_ ((struct frame *));
1048extern void create_frame_xic P_ ((struct frame *)); 1046extern void create_frame_xic P_ ((struct frame *));
generated by cgit v1.2.1 (git 2.18.0) at 2026-04-23 07:46:14 +0000