;;; Functions to add entries to an HTML activity log. ;;; Copyright (C) 2004 Federico Mena-Quintero ;;; ;;; Author: Federico Mena-Quintero ;;; ;;; 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 of the License, 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, write to the Free Software ;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ;; This code adds a "C-x 4 n" binding to Emacs that will add a new ;; activity log entry in ~/public_html/news.html. ;; ;; These functions assume that you have psgml-mode installed and that ;; it is configured to pick up an HTML 4.0 DTD automatically when you ;; visit an HTML file. You can do this by putting ;; ;; (setq auto-mode-alist ;; (append '(("\\.html$".sgml-mode) ("\\.html.in$".sgml-mode)) auto-mode-alist)) ;; ;; in your .emacs. Editing HTML using psgml-mode is *very* nice! ;; ;; The functions assume that ~/public_html/news.html is the base page ;; for your activity log. They are not very tolerant of HTML that is ;; formatted different than mine, so get a copy of ;; http://www.gnome.org/~federico/news.html in addition to this ;; elisp file and start tweaking from there. (require 'cl) (defstruct al-context path locale language file-base-name blog-url toplevel-url title long-title main go-forward-in-time-to go-backward-in-time-to) (defun al-make-english-context () (make-al-context :locale "en_US.UTF-8" :language "en" :main "Main" :go-forward-in-time-to "Go forward in time to" :go-backward-in-time-to "Go backward in time to")) (defun al-make-spanish-context () (make-al-context :locale "es_MX.UTF-8" :language "es" :main "Principal" :go-forward-in-time-to "Avanzar en el tiempo a" :go-backward-in-time-to "Retroceder en el tiempo a")) (defun al-generate-date (format &optional time) (if (null time) (setq time (current-time))) (cond ((eq format 'full) (format-time-string "%a %Y/%b/%d %T %Z" time)) ((eq format 'normal) (format-time-string "%a %Y/%b/%d" time)) ((eq format 'dashes) (format-time-string "%Y-%m-%d" time)) ((eq format 'year) (format-time-string "%Y" time)) ((eq format 'month-name) (format-time-string "%B" time)) ((eq format 'month) (format-time-string "%m" time)) ((eq format 'day) (format-time-string "%d" time)) ((eq format 'rfc822) (let ((system-time-locale "C")) (format-time-string "%a, %d %b %Y %T %Z" time))) (t (error "al-generate-date expects 'full, 'normal, 'dashes, 'year, 'month-name, 'month, 'day, or 'rfc822")))) (defmacro al-with-system-time-locale (time-locale &rest body) `(let ((system-time-locale ,time-locale)) (progn ,@body))) (defun al-main-basename (context) (format "%s.html" (al-context-file-base-name context))) (defun al-main-filename (context) (format "%s/%s" (al-context-path context) (al-main-basename context))) (defun al-numberify (str-or-num) (if (stringp str-or-num) (string-to-number str-or-num) str-or-num)) (defun al-archive-basename (context year month) (let ((n-year (al-numberify year)) (n-month (al-numberify month))) (format "%s-%04d-%02d.html" (al-context-file-base-name context) n-year n-month))) (defun al-archive-filename (context year month) (format "%s/%s" (al-context-path context) (al-archive-basename context year month))) (defun al-rss-filename (context) (format "%s/%s.xml" (al-context-path context) (al-context-file-base-name context))) (defun al-get-entry-bounds () (let ((entry-start nil) (entry-end nil)) (beginning-of-line) (setq entry-start (point)) (sgml-forward-element) (sgml-forward-element) (forward-line 1) (beginning-of-line) (setq entry-end (point)) (cons entry-start entry-end))) (defmacro al-re-search-next-entry (context year month day hours minutes) `(let* ((file-base-name (al-context-file-base-name ,context)) (regex (format "\\(.*\\)$" file-base-name)) (present (re-search-forward regex nil t))) (when present (progn (setq ,year (match-string 1)) (setq ,month (match-string 2)) (setq ,day (match-string 3)) (let ((tmp (match-string 4))) (with-temp-buffer (insert (or tmp "")) (goto-char (point-min)) (if (re-search-forward "" nil t) (setq ,hours (match-string 1) ,minutes (match-string 2)) (setq ,hours nil ,minutes nil)))))) present)) (defun al-change-modification-date (context) (goto-char (point-min)) (search-forward "
") (forward-line 4) (back-to-indentation) (kill-line) (insert (al-generate-date 'full))) (defun al-month-name (month) (let ((month-num (if (stringp month) (string-to-number month) month))) (al-generate-date 'month-name (encode-time 0 0 0 1 month-num 2013)))) (defun al-create-new-archive-file (context year month archive-filename) (find-file archive-filename) (set-buffer-file-coding-system 'utf-8) (let* ((month-name (al-month-name month)) (short-month-name (substring month-name 0 3)) (prev-month (1- (string-to-number month))) (prev-year (string-to-number year)) (next-month (1+ (string-to-number month))) (next-year (string-to-number year)) (month-and-year)) (if (= 0 prev-month) (progn (setq prev-month 12) (setq prev-year (- prev-year 1)))) (if (= 13 next-month) (progn (setq next-month 1) (setq next-year (1+ next-year)))) (setq month-and-year (format "%s %s" month-name year)) (insert " Federico Mena Quintero - " (al-context-title context) " - " month-and-year "

" (al-context-main context) " :: " (al-context-title context) " :: " month-and-year "

" (al-context-long-title context) " - " month-and-year "

" (al-context-go-forward-in-time-to context) " " (format "%s %s" (al-month-name next-month) next-year) ".

" (al-context-go-backward-in-time-to context) " " (format "%s %s" (al-month-name prev-month) prev-year) ".

Federico Mena-Quintero <federico@gnome.org> " (al-generate-date 'full) "
This is a personal web page and it does not represent the position of my employer.
") (goto-char (point-min)))) (defun al-add-entry-to-file (context year month day archive-filename entry-contents) (find-file archive-filename) (goto-char (point-min)) (let ((matched nil) (n-year (string-to-number year)) (n-month (string-to-number month)) (n-day (string-to-number day)) (entry-year) (entry-month) (entry-day) (entry-hour) (entry-min)) (while (and (not matched) (al-re-search-next-entry context entry-year entry-month entry-day entry-hour entry-min)) ;; Sanity check (if (not (and (equal year entry-year) (equal month entry-month))) (error "An entry for %s contains %s-%s" (al-archive-basename context year month) entry-year entry-month)) ;; If entries match, replace the old one with the new contents (if (equal day entry-day) (let ((entry-bounds (al-get-entry-bounds))) (delete-region (car entry-bounds) (cdr entry-bounds)) (insert entry-contents) (setq matched t)) ;; See if we can insert this entry here; entries are sorted from newest to oldest (if (> n-day (string-to-number entry-day)) (progn (beginning-of-line) (insert "\n") (forward-line -1) (insert entry-contents) (setq matched t))))) ;; If we didn't get a match, just put the entry in. (if (not matched) (progn (goto-char (point-min)) (search-forward "***MARK***") (beginning-of-line) (forward-line 1) (insert "\n") (insert entry-contents))) (save-buffer 0))) (defun al-add-entry-to-archive (context year month day entry-contents) (let ((archive-filename (al-archive-filename context year month))) (save-excursion (if (file-exists-p archive-filename) (al-add-entry-to-file context year month day archive-filename entry-contents) (progn (al-create-new-archive-file context year month archive-filename) (al-add-entry-to-file context year month day archive-filename entry-contents)))))) (defun al-write-rss-header (context buffer) (with-current-buffer buffer (insert " Federico Mena-Quintero - " (al-context-title context) " " (al-context-blog-url context) " " (al-context-long-title context) " " (al-generate-date 'year) " Federico Mena-Quintero federico@gnome.org federico@gnome.org " (al-context-language context) " " (al-generate-date 'rfc822) " "))) (defun al-write-rss-footer (buffer) (with-current-buffer buffer (insert " "))) (defun al-write-rss-file (context buffer) (with-current-buffer buffer (let ((filename (al-rss-filename context))) (write-file filename)))) (defun al-make-links-absolute (context) (while (re-search-forward "\\(src\\|href\\)=\"\\([^\"]*\\)\"" nil t) (let ((uri (match-string 2)) (replacement (format "\\1=\"%s/\\2\"" (al-context-toplevel-url context)))) (when (and (not (string-match "^[a-z]*://" uri)) (not (string-match "^mailto:" uri))) (replace-match replacement t))))) (defun al-add-entry-to-rss (context buffer year month day hours minutes entry-contents) (with-current-buffer buffer (let ((beginning-of-entry (point))) (insert entry-contents) (goto-char beginning-of-entry) (when (re-search-forward "href=\"\\(.*\\)\">\\(.*\\)" nil t) (let* ((reference (match-string 1)) (guid-and-link (concat (al-context-toplevel-url context) "/" reference)) (title-date (match-string 2)) (n-year (string-to-number year)) (n-month (string-to-number month)) (n-day (string-to-number day)) (have-time (and hours minutes)) (n-hours (if have-time (string-to-number hours) 12)) (n-minutes (if have-time (string-to-number minutes) 0)) (pos nil)) ;; Delete the
and
lines (beginning-of-line) (setq pos (point)) (forward-line 2) (delete-region pos (point)) ;; Insert item header (insert " " title-date " " guid-and-link " " guid-and-link " " (al-generate-date 'rfc822 (encode-time 0 n-minutes n-hours n-day n-month n-year)) " line (goto-char (point-max)) (forward-line -1) (delete-region (point) (point-max)) ;; Turn relative links into absolute ones... sigh (save-excursion (goto-char pos) (al-make-links-absolute context)) (insert "]]> ")))))) (defun al-update-activity-log-archive () ;; Here, al-ctx is a buffer-local variable, as set by al-add-activity-log-entry - it is an al-context structure (let ((context al-ctx)) (al-with-system-time-locale (al-context-locale context) (save-window-excursion (save-excursion (al-change-modification-date context) (goto-char (point-min)) (let ((rss-buffer (generate-new-buffer "activity-log-rss")) (year) (month) (day) (hours) (minutes)) (with-current-buffer rss-buffer (set-buffer-file-coding-system 'utf-8)) (al-write-rss-header context rss-buffer) (while (al-re-search-next-entry context year month day hours minutes) (let* ((entry-bounds (al-get-entry-bounds)) (entry-contents (buffer-substring (car entry-bounds) (cdr entry-bounds)))) (al-add-entry-to-archive context year month day entry-contents) (al-add-entry-to-rss context rss-buffer year month day hours minutes entry-contents))) (al-write-rss-footer rss-buffer) (al-write-rss-file context rss-buffer) (kill-buffer rss-buffer)))) nil))) (defun al-add-activity-log-entry (context) "Add a news entry to my web page" (interactive) (al-with-system-time-locale (al-context-locale context) (let ((main-filename (al-main-filename context))) (find-file main-filename) (set (make-local-variable 'al-ctx) context) (if (not (memq 'al-update-activity-log-archive write-contents-hooks)) (progn (add-hook 'write-contents-hooks 'al-update-activity-log-archive))) (goto-char (point-min)) (search-forward "***MARK***") (sgml-down-element) ;; (let* ((year (al-generate-date 'year)) (month (al-generate-date 'month)) (day (al-generate-date 'day)) (date-chunk (format "%s" day (al-archive-basename context year month) day (al-generate-date 'normal))) (time-chunk (concat " "))) (if (looking-at date-chunk) (progn ;; Update the time (sgml-up-element) (if (not (looking-at "$")) ; Is there garbage at the end of the line? (let ((p (point))) (delete-region p (progn (end-of-visible-line) (point))))) (insert time-chunk) ;; Move to the
\n
    and skip to the end of the
      (sgml-down-element) (sgml-down-element) (sgml-end-of-element) (beginning-of-line) (insert "\n" "
    • \n" "

      \n" "\n" "

      \n" "
    • \n") (sgml-indent-line) (previous-line 3) (sgml-indent-line)) (progn ;; Insert a completely new date (beginning-of-line) (insert "
      " date-chunk "
      " time-chunk "\n" "
      \n" "
        \n" "
      • \n" "

        \n" "\n" "

        \n" "
      • \n" "
      \n" "
      " "\n\n") (sgml-indent-line) (previous-line 6) (sgml-indent-line)))))))