;;; linkfarm-mode --- mode for maintaining consistent links across a website

;; This is gross, and disgusting, and many other things besides. It's
;; what I use to maintain the links on my website in a roughly
;; consistent fashion. It's not automatic, because I'm too lazy to
;; figure out how to do that in a way that doesn't kill performance;
;; what it does is when triggered, it tries to find appropriate
;; linkage for the word ahead of point. It patches relative URLs where
;; necessary, and generally tries to do the right thing.

;; You'll need linker.pl to support this; it should be available from
;; wherever you got this file. Hopefully at
;; http://www.waider.ie/hacks/emacs/

;; Suggested invocation:
;; (add-hook 'html-mode-hook 'linkfarm-mode)
;; or whatever. This ain't VB.

;; Things you may wish to mess with.
(defvar linkfarm-filename (expand-file-name "~/public_html/.linkfarm"))
(defvar linkfarm-web-dir (expand-file-name "~/public_html/"))
(defvar linkfarm-exe (expand-file-name "~/src/perl/linker.pl"))

;; Things I'd rather you didn't mess with, since they're for internal
;; use.
(defvar linkfarm-load-time nil)
(defvar linkfarm-alist nil)

;;; Why do I have to write crap like this?
(defun linkfarm-newer(t1 t2)
  "Compare two times, return T1 newer than T2.
Doesn't deal with the miniscule third component, handles nil values."
  (if t1 (if t2 (if (> (nth 0 t1) (nth 0 t2)) t
                  (if (= (nth 0 t1) (nth 0 t2))
                      (if (> (nth 1 t1) (nth 1 t2)) t nil)
                    nil)) t) nil))

;;; Load the linkfarm if necessary (or forced)
(defun linkfarm-load( &optional force )
  "(Re)Load the linkfarm file, optionally using FORCE.
Checks the file date vs. last read time if you don't force it."
  (let ((buf (get-buffer-create " *linkfarm*")))
    (save-excursion
      (set-buffer buf)
      (goto-char (point-min))
      (if (or force (eobp))
          (setq linkfarm-load-time nil))
      (if (linkfarm-newer linkfarm-load-time
                          (nth 5 (file-attributes linkfarm-filename))) ()
        (setq linkfarm-alist nil)
        (erase-buffer)
        (message "Loading linkfarm...")
        (call-process
         (concat (expand-file-name linkfarm-exe)) nil buf nil "-e")
        (setq linkfarm-load-time (current-time))
        (message "Loading linkfarm...done")
        (goto-char (point-min))
        (message "Parsing linkfarm...")
        (setq linkfarm-alist (read buf))

        (message "Parsing linkfarm...done")))))

;; Check the word preceeding point for a match in the linkfarm.
;; FIXME:
;; filter text from current page as per the linker.pl script
;;   (i.e. collapse whitespace)
;; match only on word boundaries
(defun linkfarm-check-words ()
  "Try to find an appropriate link for the word(s) before point."
  (delete nil (mapcar (function
                       (lambda( linkdata )
                         (let* ((linkwords (car linkdata))
                                (linkurls (cdr linkdata))
                                (cur-point (point))
                                (backtrack (length linkwords))
                                (checkwords (buffer-substring
                                             (if (>= backtrack cur-point) 1
                                               (- cur-point backtrack))
                                             cur-point))
                                (case-fold-search t))
                           (if (string-match (regexp-quote linkwords)
                                             checkwords)
                               linkdata
                             nil)))) linkfarm-alist)))

;; this is the actual command to call the above.
(defun linkfarm-check-words-quietly ()
  "Command to check for linkable words."
  (interactive)
  (linkfarm-load) ;; refresh linkwords list
  (let* ((linklist (linkfarm-check-words))
         (linkitem (car linklist))
         (linklength (length (car linkitem))))
    (if (> (length linklist) 0)
        ;; find the longest link
        (mapcar (function (lambda( li )
                            (if (> (length (car li)) linklength)
                                (setq linkitem li
                                      linklength (length (car li))))))
                linklist))
    (if linkitem
        (let* ((linkword (car linkitem))
               (backtrack (length linkword))
               (url (nth 1 linkitem)))
          ;; patch the URL if it's relative.
          (if (string-match "^\\w+:" url)
              () ;; looks absolute, bugger it.
            (let ((here buffer-file-name))
              (if (or (null here)
                      (not (string-match (concat "^" linkfarm-web-dir) here)))
                  (progn
                    (message (if (null here)
                                 "No filename to work with!"
                               (concat here " not in web tree!")))
                    (sit-for 2))
                (setq here (file-name-directory
                            (substring here (length linkfarm-web-dir)))
                      url (file-relative-name url here)))))
          (save-excursion
            (forward-char (- backtrack))
            (insert (concat "<a href=\"" url "\">")))
          (insert "</a>")))))

;; much faster version, without substring matching
(defun linkfarm-frob-word (word)
  (and (try-completion word linkfarm-alist)
       (let ((url (nth 1 (assoc word linkfarm-alist))))
         (concat "<a href=\"" url "\">" word "</a>"))))

;; Hacked self-insert-command which calls the above command before
;; inserting.
(defun linkfarm-self-insert-command(n)
  (interactive "p")
  (linkfarm-check-words-quietly)
  (self-insert-command n))

;; Hook function for file-writing
(defun linkfarm-update()
  "Hook function (optionally a command) to update the linkfarm.

Only updates if it can find a buffer-file-name and that
buffer-file-name is in the linkfarm-web-dir (which see)."
  (interactive)
  (if (and (buffer-file-name)
           (string-match (concat "^" linkfarm-web-dir) (buffer-file-name)))
      (progn
        (message "Updating linkfarm...")
        (shell-command (concat (expand-file-name linkfarm-exe) " -q "
                               (buffer-file-name)))
        (message "Updating linkfarm...done.")))
  ;; return nil so that the file will actually get written. Yes, I had
  ;; to RTFM.
  nil)

;; Not really a mode, but gives you a focal point...
;;;###autoload
(defun linkfarm-mode ()
  "Define the linkfarm keymap, such as it is."
  (interactive)
  (let ((keymap (copy-keymap (current-local-map))))
    (define-key keymap "\C-c?" 'linkfarm-check-words-quietly)
;; uncommenting the following might /just/ work if you have some sort
;; of supercomputer once your linkfarm file gets any way big.
;;    (substitute-key-definition 'self-insert-command
;;                               'linkfarm-self-insert-command
;;                               keymap global-map)
;; this is slightly less harsh, but still hurts.
;;    (define-key keymap " " 'linkfarm-self-insert-command)
    (use-local-map keymap)
    (add-hook 'local-write-file-hooks 'linkfarm-update)))