;;; diary helper stuff
;;; Things to do
;;; format-diary-template or similar, which will take the place of all
;;; the messy format hacks and deal with the boilerplate strings in a
;;; sane fashion
;;;
;;; Reinvestigate the fill-out-missing-days code and do it more sanely
;;;
;;; The work balance between M-x diary and C-o needs to be adjusted
;;; somewhat.
;;;
;;;
(require 'imdb)
(require 'calendar)
(require 'jwz-html-mode)
(defvar diary-header "
Hacker's Diary : %s %s
" "Index of current year")
;;;###autoload
(defun diary-maybe-hook()
"Check to see if we should add the diary-helper stuff to the current buffer"
(if (string-match "public_html.*diary.*" (or (buffer-file-name) ""))
(progn
(local-set-key "\C-o" 'diary-entry)
(message "Enabling diary hooks")
(add-hook 'local-write-file-hooks 'diary-helper-write-file-hook))))
;; oog. there must be a nicer way to do this. I HATE EMACS TIME.
(defun seconds-ago( sec &optional tm)
"Return a time-list corresponding to TM + SEC. TM is an optional
time-list, defaulting to (current-time)"
(and (null tm) (setq tm (current-time)))
(let* ((d (/ sec 65536))
(e (% sec 65536))
(a (nth 0 tm))
(b (nth 1 tm))
(c (nth 2 tm)))
(if (> e b)
(setq a (- a 1)
b (+ 65536 b)))
(setq a (- a d)
b (- b e))
(list a b c)))
(defun seconds-after( sec &optional tm )
"Return a time-list corresponding to TM + SEC. TM is an optional
time-list, defaulting to (current-time)"
(and (null tm) (setq tm (current-time)))
(let* ((d (/ sec 65536))
(e (% sec 65536))
(a (+ (nth 0 tm) d))
(b (+ (nth 1 tm) e))
(c (nth 2 tm)))
(if (> b 65536)
(setq a (+ 1 a)
b (% b 65536)))
(list a b c)))
(defun diary-entry( &optional header )
"Create a diary entry for HEADER.
HEADER is used as the \"caption\" for the entry. If it's unspecified, a
suitable value will be guessed at."
(interactive)
(beginning-of-line);; just in case you're on the
line.
(let* ((insertion-point (point))
(need-header-p t)
(useful-stuff (diary-useful-stuff header))
(date (car useful-stuff))) ;; numeric date, yay
;; verify that we're in a good place
(if (re-search-backward "
" (point-min) t)
;; fine for now XXX check if the supplied HEADER fits?
()
;; look forward for the dl
(if (re-search-forward "
" (point-max) t)
(progn
(forward-line 1);; make sure we're on the next line
(setq insertion-point (point)))
(message "This doesn't look to be a diary file!")
(sit-for 5)))
(goto-char insertion-point)
(beginning-of-line)
(save-excursion
(if header
()
(if (re-search-forward
"
\\(\\w+\\) \\([0-9]+\\)" (point-max) t)
;; try and guess an appropriate date value
;; really, we should check for overrun, but I'm far too lazy.
(progn
(let ((month (match-string 1)))
(setq date (+ (string-to-number (match-string 2)) 1)
header (format "%s %d" month date))
))
;; no existing diary entries, so just go with the default.
;; we could check the name of the file to see what month it
;; is, and also do a force-feed of dates for that month, but
;; that's getting way out of hand.
(setq header (format "%s %d" (nth 1 useful-stuff) date)))))
;; Let's see if we're in a diary entry!
(setq insertion-point (point))
(if (diary-helper-in-diary-entry-p)
(save-excursion
(re-search-forward "" (point-max) t)
(setq need-header-p nil)
(forward-char -15) ;; step back over the and the two
(insert " \n \n ")
(setq insertion-point (point))))
(goto-char insertion-point)
(setq useful-stuff (diary-useful-stuff header))
(if (null need-header-p)
()
(insert (format "
%s
\n" date header))
(insert "
")
(save-excursion
(insert "
\n\n")
;; is it Sunday? We need a break if it is!
(if (string= "7" (nth 7 useful-stuff))
(if (save-excursion (re-search-forward "
" (point-max) t))
(insert "
\n\n\n\n
\n")))))))
(defun diary-write()
(interactive)
(let ((useful-stuff (diary-useful-stuff))
newfile)
;; set up some useful variables
(setq today (nth 0 useful-stuff);; current day number
this-month (nth 1 useful-stuff)
this-year (nth 2 useful-stuff)
last-month (nth 3 useful-stuff)
;; year matching previous month, as opposed to actual previous year
last-year (if (string= last-month "December")
(- this-year 1)
this-year)
next-month (nth 5 useful-stuff)
;; year matching next-month
next-year (if (string= next-month "January")
(+ this-year 1)
this-year))
;; make sure there's a directory for this year (added Jan 01 2002!)
(or (file-exists-p (format "%s/public_html/hacks/diary/%s"
(getenv "HOME")
(format "%d" this-year)))
(make-directory (format "%s/public_html/hacks/diary/%s"
(getenv "HOME")
(format "%d" this-year)) t))
(setq newfile
(not (file-exists-p (format "%s/public_html/hacks/diary/%s/%s.html"
(getenv "HOME")
(format "%d" this-year)
(downcase this-month)))))
;; find appropriate file
(find-file (format "%s/public_html/hacks/diary/%s/%s.html"
(getenv "HOME")
(format "%d" this-year)
(downcase this-month)))
(goto-char 0);; not sure about DWIM here.
;; see if there's anything in it
(if newfile
(progn
(insert (format diary-header
this-month this-year
this-year
(downcase last-month) last-month
(downcase next-month) next-month
this-month this-year
(downcase last-month) (downcase next-month)))
(save-excursion
(insert
(format diary-trailer
(downcase last-month)
(downcase next-month)
(read-string "Something witty for this month: "))))
;; fix up month-rollover stuff
;; 1. .htaccess file
(save-excursion
(find-file (format "%s/public_html/hacks/.htaccess" (getenv
"HOME")))
(goto-char (point-min))
;; this is a bit vague, but hey.
(if (re-search-forward "RewriteRule hacking.html.*$" (point-max) t)
(replace-match
(format "RewriteRule hacking.html diary/%s/%s.html [R]"
this-year (downcase this-month)))
(insert
(format "RewriteRule hacking.html diary/%s/%s.html [R]"
this-year (downcase this-month))))
(save-buffer)
(kill-buffer (current-buffer))
;; 2. Relevant index page, for people who get lost
(find-file (format "%s/public_html/hacks/diary/%s/index.html"
(getenv "HOME") this-year))
(if (= 0 (buffer-size));; file is empty (start of year)
(insert (format-time-string diary-year-index)))
(goto-char (point-min))
(re-search-forward "
\n "
(downcase this-month) this-month))
(save-buffer)
(kill-buffer (current-buffer))
;; 2.5 Year index
(find-file (format "%s/public_html/hacks/diary/index.html"
(getenv "HOME")))
(if (= 0 (buffer-size));; starting from fresh
(insert "
hacker's diary
Here's an approximate diary of what I've been at hacking-wise
since August 2000. Occasional mentions of books, movies, Formula 1
races, and drinking are also included.
\n "
this-year this-year))
(save-buffer))
(kill-buffer (current-buffer))
;; 3. Previous month's "next month" link
(if (file-exists-p (format "%s/public_html/hacks/diary/%s/%s.html"
(getenv "HOME") last-year
(downcase last-month)))
(progn
(find-file (format "%s/public_html/hacks/diary/%s/%s.html"
(getenv "HOME") last-year
(downcase last-month)))
(goto-char (point-max))
(while (re-search-backward "" (point-max) t)
(replace-match "")
))))
(save-buffer)
(kill-buffer (current-buffer)))
;; end of save-excursion
)
;; end of dealing with new file
))
;; find the first diary entry. this is still a bit broken: it
;; doesn't backfill over previous months, and it seems to get
;; confused about day order sometimes.
(let ((last 0) l p)
(if (re-search-forward "
\\w+ \\([0-9]+\\)"
(point-max) t)
(setq last (string-to-number
(buffer-substring (match-beginning 1)
(match-end 1)))))
(while (> today last)
(setq last (+ last 1))
(setq l (append l (list (format "%s %d" this-month last)))))
(mapcar (function (lambda(x) (save-excursion (diary-entry x)
(setq p (point)))))
(reverse l))
(if p;; if this is unset, we didn't insert anything, so we need
;; to append to the current diary entry.
(goto-char p)
(and (re-search-forward
"\\(
\\)?\\(
\\)"
(point-max) t);; magic!
(goto-char (match-beginning 2))
(or (match-beginning 1)
(insert " \n \n ")))))))
(defun diary-helper-in-diary-entry-p(&optional where)
"Is WHERE (or point, if where isn't specified) in a diary entry?
Currently, can be faked out by being in one of the 'key zones',
i.e. the first and last sections of the markup per entry."
(or where (setq where (point)))
(save-excursion
(let ((start (if (re-search-backward "
"
(point-min) t)
(point)
;; if there's no diary entry above us, we can't
;; be in one, right?
(point-max)))
(end (if (re-search-forward "
"
(point-max) t)
(point)
(point-min)))) ;; ditto
(and (>= where start)
(<= where end)))))
;;;###autoload
(defun diary-helper-write-file-hook()
(save-excursion
(message "untabifying...")
(untabify (point-min) (point-max))
(message "untabifying...done.")
nil))
(defun diary-useful-stuff(&optional date)
"Return a list of useful data based on the supplied DATE: date of
month, current month name, current year, previous month, previous
year, next month, next year. DATE is of the form '(DD Month YYYY), and
defaults to current-time."
;; if date is unset, default it
(if (null date)
(setq date (current-time))
;; otherwise convert DD Month YYYY to a time string
(if (listp date)
()
;; if the date isn't a list then I'm still being a lazy tosser
(string-match "^\\([^ ]+\\) \\(.*\\)$" date)
(setq date
(list (string-to-number (substring date (match-beginning 2) (match-end 2)))
(substring date (match-beginning 1) (match-end 1))
(string-to-number (format-time-string "%Y"))))) ;; XXX assumes current year
;; We need to convert Month to MM
(let ((m 0))
(while (and (< m 12)
(not (string= (nth 1 date)
(aref calendar-month-name-array
m))))
(setq m (+ 1 m)))
;; if we get to 12, we've not found a match
(if (= 12 m)
(error "Can't make sense of '%s'!" (nth 1 date)))
;; calendar functions are 1-based, not zero-based.
(setq m (+ 1 m))
;; Unix Epoch = 719163 in Gregorian calendar
;; (calendar-absolute-from-gregorian '(1 1 1970))
(setq date (- (calendar-absolute-from-gregorian
(list m (nth 0 date)
(nth 2 date)))
719163))
;; now convert to seconds. 28 bits isn't enough for a simple
;; (setq date (* 60 60 24 date)), though
;; The / 65536 part is easy. The % part is trickier.
(let* ((e (/ (* 675 date) 512)) ;; factors and stuff
(m (* 128 (- (* 675 date) (* 512 e))))) ;; stuff
(setq date (list e m 0 0)))))
(let ((monthday (string-to-number (format-time-string "%-d" date)))
(month (format-time-string "%B" date))
(year (string-to-number (format-time-string "%Y" date)))
(yearday (string-to-number (format-time-string "%j" date)))
;; Might be handy to have the day of the week, too
(day (format-time-string "%u" date))
last-month next-month last-year next-year
i)
;; skip back a month by winding back days of the month so far
(setq last-month (format-time-string "%B" (seconds-ago
(* 60 60 24 monthday)
date)))
(setq last-year (- year 1))
(setq next-year (+ year 1))
;; This beats using math to figure out leap days etc.
(setq next-month month
i date)
(while (string= next-month month)
(setq i (seconds-after (* 60 60 24) i)
next-month (format-time-string "%B" i)))
;; return our data
(list monthday month year last-month last-year next-month
next-year day)))
(provide 'diary-helper)