;;; getcomics.el -- read Dilbert and Robotman in you Emacs

;; Copyright (C) 1997 Peter Liljenberg

;; $Id: getcomics.el,v 1.6 1997/05/10 01:23:21 petli Exp $

;; Author: Peter Liljenberg <petli@lysator.liu.se>
;; Created: April 1997
;; Keywords: comics www dilbert
;; Availability: http://www.lysator.liu.se/~petli/elisp
;;               /ftp.lysator.liu.se:/pub/emacs

;; LCD Archive Entry:
;; getcomics|Peter Liljenberg|petli@lysator.liu.se|
;; Read Dilbert and Robotman in your Emacs|
;; $Date: 1997/05/10 01:23:21 $|$Revision: 1.6 $|~/misc/getcomics.el.gz|

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

;;; Commentary:

;; When I realised the only thing I used Netscape for was reading Dilbert
;; and Robotman, I thought this was a waste of 8 Mb of memory...

;; This code downloads and displays the strips automagically, without
;; having to touch the Evil WWW.

;; Do M-x get-comic to get the comics. You will be prompted for the
;; comic to get (currently, you can only choose between Dilbert and
;; Robotman because those are the only comics I read. It's easy to add
;; more of unitedmedia's comics, see the documentation of the variable
;; `comics-known-comics'). Press TAB if you don't want to type more
;; than necessary.

;; If you want to see old comics, give a prefix argument for how old
;; comic you want to see: M-1 M-x get-comic will display yesterday's
;; comic, and M-1 M-4 get-comic displays a two week old comic.

;; You might end up with a lot of .gif files after a while. You might
;; like this if you archive the comics, but if you don't like it add
;; this to your .emacs:
;;   (add-hook 'kill-emacs-hook 'clear-comics-files)
;; and the files will be removed when you exit Emacs with C-x C-c.

;; getcomics can, to an extent, handle fire walls. See the variables
;; comics-proxy-server and comics-proxy-port. However, it doesn't know
;; (and doesn't want to know, either) about authentication and similar
;; nasty stuff. Instead I let w3 handle that, see comics-use-w3.
;; Beware, that w3 piggybacking code is *ugly*, and have only been
;; tested with 2.2.26 and the beta 3.0.85 where it seems to work. You
;; can get W3 from http://www.cs.indiana.edu/elisp/w3/docs.html

;; You can easily get fresh comics when you start your Emacs: call
;; get-daily-comic in your .emacs. If you don't want to call it while
;; loading, use run-at-time instead:
;;   (run-at-time 60 nil 'get-daily-comic comic hours)
;; comic and hours are arguments passed to get-daily-comic, and hours
;; may be omitted. This will delay the comic retrieval one minute from
;; the call of run-at-time.

;; If you, on the other hand, always has a Emacs running you want it
;; to get fresh comics every day at, say 8:00 a.m, so you can read
;; while eating breakfast (of course you have Emacs in your kitchen):
;;   (run-at-time "08:00am" (* 24 60 60) 'get-comic "dilbert")

;; If you have several Emacses running you can tell only one of them
;; to get comics (assuming you run them on different hosts)
;;  (if (string-match "hostname" system-name)
;;    (run-at-time "08:00am" (* 24 60 60) 'get-comic "dilbert")

;; If the computer never goes down and your Emacs is running
;; indefinitely, you'll end up with a lot of comic files. This can
;; take up some precious disk space, so do something similar to delete
;; files once every 24 hours:
;;   (run-at-time "07:00am" (* 24 60 60) 'clear-comics-files)

;; If you want to use menus, you can add these lines to get a few new
;; menuitems in the Tools menu:

;;  (define-key-after (lookup-key global-map [menu-bar tools]) [robotman]
;;    (cons "Robotman" '(lambda () (interactive) (get-comic "robotman")))
;;    'calendar)
;;  (define-key-after (lookup-key global-map [menu-bar tools]) [dilbert]
;;    (cons "Dilbert" '(lambda () (interactive) (get-comic "dilbert")))
;;    'calendar)
;;  (define-key-after (lookup-key global-map [menu-bar tools])
;;    [separator-comic]
;;    '("--")
;;    'calendar)

;; On various perverse OS:s you have to tell Emacs to save
;; binary files, instead of text files. getcomics handles this under
;; MS-DOG, but in OS/2 you have to add this to your Emacs:
;;   (emx-add-binary-mode "\\.gif$")
;; Thanks to Saari Anssi <as@cs.tut.fi> for this solution.

;; getcomics.el is almost entirely compliant with checkdoc.el 0.3...

;;; History:

;; 1.6 (10 May 1997)
;;    getcomics.el didn't work with Emacses <= 19.28, as I thought,
;;    since decode-time doesn't exist there. Fixed now.

;; 1.5 (3 May 1997)
;;    Now w3 can be used to get the comics.

;; 1.4 (25 Apr 1997)
;;    Jeff Dwork <dwork@carmel.amd.com> improved the proxy handling by
;;    adding comics-proxy-port. Thorsten Schwander
;;    <schwander@ooo.lanl.gov> told me that case-fold-search CAN be
;;    nil sometimes, and Tom Schutter <schutter@diac.com> fixed that
;;    on M$ platforms the image buffer is thought to be in ASCII.

;; 1.3 (22 Apr 1997)
;;    Arnon Kanfi <arnon@microtal.com> fixed problems with crypt++.el,
;;    and with firewalls. Bengt Andersson <bengt.andersson@telelogic.se>
;;    fixed require-final-newline when saving.

;; 1.2 (14 April 1997)
;;    Generates new buffers on every access (don't worry, they'll be
;;    removed when they're not needed anymore). When this wasn't done
;;    two close accesses could mess up the images.
;;    Now works with Emaces older than 19.29. How much older, I don't
;;    know.

;; 1.1 (8 April 1997)
;;   Added get-daily-comic (suggested by Francois Felix Ingrand
;;   <felix@laas.fr>).

;; 1.0 (4 April 1997
;;   First release. Was preceded by 0.1 and 0.2, however.


;;; Code:

(defvar comics-filedir "/tmp/"
  "*The directory to store the downloaded images in.

The file names will just be appended, so this should include a
trailing slash or whatever your system uses for directory separator.

If you don't call clear-comics-file the files will stay there until
you delete them manually. This makes archiving strips easy: set
`comics-filedir' to the strips resting place and never call
clear-comics-files.")

(defvar comics-use-w3 nil
  "*If non-nil, http will be done by w3, otherwise by getcomics itself.

The advantage of using w3 is that it can handle a lot of messy
stuff like firewalls, authentication and getting web pages via
email. getcomics can handle proxy servers by itself (see
`comics-proxy-server' and `comics-proxy-port'), but not the rest.
The disadvantage is that getcomics will be synchronous when using w3,
i.e. you can't do anything else while the comics are downloaded.")

(defvar comics-proxy-server nil
  "*The name of the http proxy server (TIS FWTK).")

(defvar comics-proxy-port 80
  "*The port of the http proxy server.")

(defvar comics-viewer "xv"
  "*The command to invoke to display the image.

It will get one argument, the image file.")

(defvar comics-daily-file-base "~/.daily-"
  "The base of the dummy files used by 'get-daily-comic'.")

(defvar comics-known '(("dilbert") ("robotman"))
  "A list of lists of a string of comics you want to read.

Remember, only comics at unitedmedia works!")

(defvar comics-collected-files nil
  "All downloaded image files so far.

Is used by clear-comics-files.")

(defvar comics-today nil
  "Todays comic 'today'.

A form like (day month year), where
1 <= day <= days-of-month, 1 <= month <= 12 and 0 <= year <= 99.")

(defvar comics-http-server "www.unitedmedia.com"
  "*The host to contact at unitedmedia.

If you get the message 'Unknown host \"www.unitedmedia.com\"' your
computer can't lookup the name. Try to replace this with the IP
number: 207.121.184.84 (the machine's name is dilbert...). But
remember that this number may be changed; www.unitedmedia.com is
merely a nickname for the http server, which may be called something
entirely different.")

(defconst comics-version
  "$Id: getcomics.el,v 1.6 1997/05/10 01:23:21 petli Exp $"
  "Version of getcomics.")

(defun get-comic (comic &optional day)
  "Display the strip of COMIC for DAY.

If DAY is nil or is omitted, today's comic will be displayed.
Otherwise it should be a non-negative integer, and is how old strip
\(in number of days) to display. If called interactively, you will be
prompted for COMIC, and DAY will be taken from the prefix.

Note: this code only works for comics at www.unitedmedia.com, and may break
if they change the pages layout..."

  (interactive
   (list (completing-read "Comic: " comics-known nil t)
	 current-prefix-arg))

  (if (not (assoc comic comics-known))
      (error "Unknown comic %s" comic))

  (message "Contacting %s..." comics-http-server)
  (comics-http-request comics-http-server
		       (if day
			   (concat "/comics/" comic "/archive/"
				   comic (get-comics-date-str day) ".html")
			 (concat "/comics/" comic "/index.html"))
		       (generate-new-buffer-name "get-comics")
		       'get-comics-page-sentinel)
    )

(defun clear-comics-files ()
  "Delete all stored comic strips.

You may want to add this function to the functions called when you exit
Emacs: (add-hook 'kill-emacs-hook 'clear-comics-files)"

  (interactive)
  (mapcar '(lambda (file)
	     (condition-case nil
		 (delete-file file)
	       (file-error nil)))
	  comics-collected-files)
  (setq comics-collected-files nil))


(defun get-daily-comic (comic &optional hours)
  "Get today's strip of COMIC if you haven't seen it yet.

'Yet' in the above sentence means the last HOURS hours, or last 12
hours in case it is nil or omitted. It will do nothing if called on a
Sunday. (The guys at unitedmedia doesn't update the site on
Sundays. Lazy bunch, aren't they :)

This function should typically be called at the end of .emacs, after
get-comics.el has been loaded. It will use a dummy file to store the
last time `get-daily-comic' got the strip. This file's name will be
constructed by appending COMIC to the value of
comics-daily-file-base."
  (let* ((now (current-time))
	 (day (nth 6 (decode-time now))))

    (if (= day 0)
	(message "Sorry, no fresh comics on Sundays :(")

      (let* ((file (concat comics-daily-file-base comic))
	     (then (nth 5 (file-attributes file))))
	(if (or (not then) (> (time-diff now then)
			      (* (if hours hours 12) 3600)))
	    (progn
	      (get-comic comic)
	      (write-region "getcomics.el get-daily-comic dummy file.
Please don't touch(1) me!
"
			    nil file)))))))


;;; Implementation functions:

(defun get-comics-page-sentinel (proc str)
  "Find the comic image file name for http query PROC.
STR is ignored."
  (save-excursion
    (let ((crypt-never-ever-decrypt t))
      (if proc
	  ;; We do http by ourselfs here
	  (progn
	    (set-buffer (process-buffer proc))
	    (http-okay-htmlp (current-buffer))
	    ))
      (goto-char (point-min))
      (let ((case-fold-search t))
	(if (not (re-search-forward "src=\"?\\(/comics/[^/]+/archive/images/\\([a-z0-9_]*.gif\\)\\)\"?" nil t))
	    (error "Can't find comic URL, unitedmedia might have changed their layout"))
	)
      (message "Downloading comic strip...")
      (comics-http-request comics-http-server
			   (match-string 1)
			   (buffer-name (find-file-noselect
					 (concat comics-filedir
						 (match-string 2))))
			   'get-comics-image-sentinel)
      (kill-buffer nil)
      )))

(defun get-comics-image-sentinel (proc str)
  "Save and display the gif image for the comic strip.
PROC is the http request, STR is ignored."
  (save-excursion
    (let ((crypt-never-ever-decrypt t))
      (message "Downloading comic strip...done")

      (if proc
	  ;; We do http by ourselfs here
	  (progn
	    (set-buffer (process-buffer proc))
	    (http-okay-htmlp (current-buffer))
	    (goto-char (point-min))
	    (search-forward "\r\n\r\n")
	    (delete-region (point-min) (point))
	    ))
      (let ((require-final-newline nil)
	    (buffer-file-type t))
	(save-buffer 0))
      (setq comics-collected-files
	    (cons (buffer-file-name) comics-collected-files))
      (start-process "comics-viewer" "comics-viewer"
		     comics-viewer (buffer-file-name))
      (kill-buffer nil)
      )))

(defun get-comics-date-str (offset)
  "Return a string of \"yymmdd\", where OFFSET is days before comics-today."
  (if (or (not (integerp offset))
	  (< offset 0))
      (error "Bad day offset %S" offset))

  (if (not comics-today)
      (get-comics-today))

  (let ((ndate (get-comics-date-offset comics-today offset)))
    (format "%02d%02d%02d"
	    (car (cdr (cdr ndate)))
	    (car (cdr ndate))
	    (car ndate)))
  )

(defun get-comics-date-offset (date offset)
  "Subtracts OFFSET days from DATE (which is a (dd mm yy))
and returns the resulting date."
  (let ((day (car date))
	(mon (car (cdr date)))
	(year (car (cdr (cdr date)))))

    (while (< (setq day (- day offset)) 1)
      (if (< (setq mon (1- mon)) 1)
	    (setq mon 12
		  year (1- year)))
      (setq offset (- day))
      (setq day (month-days mon)))

    (list day mon year)))


(defun get-comics-today ()
  "Figure out what day it is in comic land."
  (let* ((tlist (decode-time (current-time)))
	 (date (list (nth 3 tlist) (nth 4 tlist) (- (nth 5 tlist) 1900))))
    (setq comics-today (get-comics-date-offset date 7))
    ))


(defvar comics-url-version nil
  "3 for w3 v3, 1 otherwise.")

(defun comics-get-url-version ()
  "Return the correct retrieval function"
  (if comics-url-version
      comics-url-version

    ;; Why isn't there autoload on variables...
    (if (not (featurep 'url))
	(progn
	  (load "w3-sysdp")
	  (load "url")))

    ;; Try to se if we're using the the latest w3
    (setq comics-url-version (if (string-match "3\\." url-version) 3 1))
    ))
	
(defun comics-http-request (host path query-name sentinel)
  "Send a http request to HOST for the page PATH.

`http-send-request' will be used if comics-use-w3 is nil, otherwise
`url-retrieve' will be used. Output will always be put in the buffer
named QUERY-NAME, but if `url-retrieve' is used, only the data will
remain. SENTINEL is called when all the data is downloaded. It should
be a normal sentinel, with the exception that the first argument (the
process) will be nil when `url-retrieve' is used."

  (if comics-use-w3
      (save-excursion
	(set-buffer (get-buffer-create query-name))
	(erase-buffer)

	;; url-retrieve and url-insert-file-contents change the
	;; buffers file name, which we don't want it to do with the
	;; image buffer.
	(let ((fname buffer-file-name))
	  (if (= (comics-get-url-version) 3)
	      ;; url-insert-file-contents is better to use in w3 3.0,
	      ;; since url-retrieve isn't synchronous
	      (url-insert-file-contents (concat "http://" host path))

	    ;; In <= 2.25 url-retrieve is synchronous, but we have to
	    ;; copy the data by ourselves.
	    (url-retrieve (concat "http://" host path))
	    (set-buffer query-name)
	    (insert-buffer url-working-buffer))

	  ;; Restore buffer file name
	  (setq buffer-file-name fname)
	  )
	(funcall sentinel nil "url-retrieve complete.")
	)
    (http-send-request host path query-name sentinel)
    ))

(defun http-send-request (host path query-name sentinel)
  "Send a http request to HOST for the page PATH.
Output will be put in the buffer named QUERY-NAME (which will be
created if it doesn't exist already), and SENTINEL (an process
sentinel function) will be called when the retrieval is complete."
  (let ((http (open-network-stream
	       query-name query-name
	       (if comics-proxy-server comics-proxy-server host)
		   comics-proxy-port)))
    (save-excursion
      (set-buffer query-name)
      (erase-buffer))
    (set-process-sentinel http sentinel)
    (if comics-proxy-server
	(process-send-string
	 http (concat "GET http://" host path " HTTP/1.0\r\n\r\n"))
      (process-send-string http (concat "GET " path " HTTP/1.0\r\n\r\n"))))
  )
  

(defun http-okay-htmlp (buf)
  "Test if we got a good http response in BUF."
  (save-excursion
    (set-buffer buf)
    (goto-char (point-min))
    (if (looking-at "HTTP/.\\.. 200")
	t
      (end-of-line)
      (error "http request failed: %s" (buffer-substring (point-min)
							 (1- (point))))
      )))


(defconst *month-data*
  '((jan 1 31) (feb 2 28) (mar 3 31)
    (apr 4 30) (may 5 31) (jun 6 30)
    (jul 7 31) (aug 8 31) (sep 9 30)
    (oct 10 31) (nov 11 30) (dec 12 31))

  "Data for month functions.")

(defun month-data (month)
  "Get the month data for MONTH.

MONTH is an integer (1..12), or a string or a symbol, in which case
the first three downcased letters will be used as the month name
abbreviation in *month-data*"

  (if (integerp month)
      (nth (1- month) *month-data*)
    (if (symbolp month)
	(setq month (symbol-name month)))
    (setq month (intern (substring (downcase month) 0 3)))
    (let ((md (assq month *month-data*)))
      (if md md
	(error "Bad month name %s" month)))
    ))

(defun month-number (month)
  "Return the month number (1..12) for MONTH (see `month-data')."
  (car (cdr (month-data month))))

(defun month-days (month)
  "Return the number of days in MONTH (see `month-data')."
  (car (cdr (cdr (month-data month)))))

(defun time-diff (new old)
  "Return the difference between two times.

NEW and OLD should be lists with (at least) two elements, which should
be integers. A good place to get these lists is `current-time' or
`file-attributes'. An integer, the difference in seconds, is returned"

  (let ((nh (car new))
	(nl (car (cdr new)))
	(oh (car old))
	(ol (car (cdr old))))
    (if (< nl ol)
	(setq nl (+ nl 65536)
	      nh (- nh 1)))
    (+ (lsh (- nh oh) 16) (- nl ol))))

;; Thanks to Per Persson pp@swip.se for this patch to Emacses <= 19.28
(if (not (fboundp 'match-string))
    (defun match-string (n &optional s)
      "Return string matched by last search.
N specifies the nth parenthesized expression in the last regexp.
N=0 means the entire text matched by the whole regexp or whole string.
S should be given if the last search was by `string-match' on string S.

Return value is nil if there is no Nth match."
      (and (match-beginning n)
	   (if s
	       (substring s (match-beginning n) (match-end n))
	     (buffer-substring (match-beginning n) (match-end n)))))
  )

;; decode-time didn't exist until 19.29
(if (not (fboundp 'decode-time))
    (defun decode-time (time)
      "Decode the time TIME.
You'd typically get TIME from `current-time' or from
`file-attributes'.
Returns a list:
\(SECONDS MINUTES HOUR DAY MONTH YEAR DAY-OF-WEEK nil TIME-ZONE)"
      (let ((s (current-time-string time)))
	(list (read (substring s 17 19))
	      (read (substring s 14 16))
	      (read (substring s 11 13))
	      (read (substring s 8 10))
	      (month-number (substring s 4 7))
	      (read (substring s 20 24))
	      (cdr (assoc (substring s 0 3)
			  '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
			    ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))))
	      nil
	      (car (current-time-zone time)))
	))
  )


(provide 'getcomics)
;;; getcomics ends here