;;; -*- Mode: Emacs-Lisp -*-
;;; Copyright © 2002-2009 Jamie Zawinski <jwz@jwz.org>.
;;;
;;; Permission to use, copy, modify, distribute, and sell this software and its
;;; documentation for any purpose is hereby granted without fee, provided that
;;; the above copyright notice appear in all copies and that both that
;;; copyright notice and this permission notice appear in supporting
;;; documentation.  No representations are made about the suitability of this
;;; software for any purpose.  It is provided "as is" without express or 
;;; implied warranty.
;;;
;;; Created: 27-May-2002.
;;;
;;; Makes it easy for me to forward messages and URLs on to mail to a
;;; mailing list I run; while also sending those messages to my LiveJournal
;;; account.
;;;
;;; Interesting commands:
;;;
;;;    M-x monkeybutter  Fill in the fields, edit the body.
;;;                      If there is a selection in some other program when
;;;                      this command is run, the text of that selection will
;;;                      be auto-pasted, and re-wrapped to 72 columns.
;;;                      If the window that owned the selection will tell us
;;;                      what URL it's looking at, that is pasted as well
;;;                      (This works for Netscape 3 and 4, but not Mozilla 1.)
;;;
;;;   M-x monkeybutter-preview    Save the HTML version to a temp file and
;;;                               send it to a web browser to see what it will
;;;                               look like in LJ.
;;;
;;;   C-c C-c            If the buffer doesn't contain HTML, convert it.
;;;                      If the buffer does contain HTML, post it to LJ and
;;;                      mail it (as HTML) to monkeybutter.
;;;
;;; Or, alternate (older) binding of C-c C-c:
;;;
;;;   C-c C-c            Send the plain-text version to the mailing list.
;;;
;;;                      Send an HTML version (with reasonable paragraph 
;;;                      flowing) to LiveJournal.  If the body containa a ^L,
;;;                      insert an <LJ-CUT> tag there.
;;;

(require 'jwz-lj)

(defvar monkeybutter-recipients nil "*The mailing list.")
(defvar monkeybutter-bcc nil "*The sender's copy.")
(defvar monkeybutter-fcc nil "*The sender's copy.")

(defvar monkeybutter-mirror-images-p t
  "*Whether to make local copies of posted inline images.
If this has the value `mirror-only', then copies will be made, but the
original URLs will be posted.  If any other non-nil value, then URLs
to the copied images will be inserted instead.")
(defvar monkeybutter-mirror-images-directory nil
  "*The local directory where mirrored images should be written.")
(defvar monkeybutter-mirror-images-url nil
  "*The URL prefix by which mirrored images should be referenced.")
(defvar monkeybutter-mirror-images-command "cd ..; make -s dist-images"
  "*A shell command to execute after images have been mirrored
into `monkeybutter-mirror-images-directory' (presumably, a command needed
to push them out to the web site refered to by
`monkeybutter-mirror-images-url').")
(defvar monkeybutter-tag-mirrored-images-p t
  "*Whether to give mirrored images the same tags as the post
using `exiftool'.")

(defvar monkeybutter-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-name map 'monkeybutter-mode-map)
    ;(define-key map "\C-c\C-c" 'monkeybutter-submit)
    (define-key map "\C-c\C-c" 'monkeybutter-convert-or-submit)
    map))


(defvar monkeybutter-font-lock-keywords
  (list

   ;; tags
   '("<[^!>]+>" 0 font-lock-function-name-face t)

   ;; character entities
   '("&[^ \t\n;]+;" . font-lock-keyword-face)

   ;; SGML things like <!DOCTYPE ...> with possible <!ENTITY...> inside.
   '("\\(<![a-z]+\\>[^<>]*\\(<[^>]*>[^<>]*\\)*>\\)"
     1 font-lock-comment-face t)

   ;; urls
   '("\\b\\(ftp\\|https?\\|mailto\\):[^ \t\n]+" 0 bold t)

   ;; dangerous characters
   '("[<>&\000-\010\013-\037\177-\377]" 0 font-lock-warning-face t)
   ))

(defun 72ify ()
  "Re-wraps all the lines in the buffer at 72 columns,
and converts certain hateful Windows characters to ASCII."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (while (search-forward "\222" nil t) (delete-char -1) (insert "'"))
    (goto-char (point-min))
    (while (search-forward "\205" nil t) (delete-char -1) (insert " --"))
    (goto-char (point-min))
    (while (search-forward "\226" nil t) (delete-char -1) (insert "-"))
    (goto-char (point-min))
    (while (search-forward "\227" nil t) (delete-char -1) (insert " --"))
    (goto-char (point-min))
    (while (search-forward "\223" nil t) (delete-char -1) (insert "``"))
    (goto-char (point-min))
    (while (search-forward "\224" nil t) (delete-char -1) (insert "''"))
    (goto-char (point-min))
    (while (search-forward "\024" nil t) (delete-char -1) (insert " -- "))
;    (asciify)
    (goto-char (point-min))
    (while (not (eobp))
      (and (looking-at "[ \t]+") (delete-region (point) (match-end 0)))
      (forward-line 1))
    (let ((fill-column 71))
      (condition-case ()
          (fill-region (point-min) (point-max))
        (error nil)))

    (goto-char (point-min))
    (if (re-search-forward "[^\t\n -~\241-\377]" nil t)
        (error "binary character here: \\%o (%c)"
               (preceding-char) (preceding-char)))
    ))


(defun monkeybutter-mode ()
  (interactive)
  (kill-all-local-variables)
  (use-local-map monkeybutter-mode-map)
  (setq mode-name "Monkeybutter")
  (setq major-mode 'monkeybutter-mode)
  (auto-fill-mode)
  (auto-save-mode auto-save-default)
  (run-hooks 'monkeybutter-mode-hook))


(defun monkeybutter ()
  (interactive)

  (let ((name "*monkeybutter*")
        b)
    (cond ((setq b (get-buffer name))
           (save-excursion
             (switch-to-buffer name)
             (if (y-or-n-p "Monkeybutter in progress; delete it? ")
                 (kill-buffer b)))))

    (switch-to-buffer (generate-new-buffer name)))

  (erase-buffer)

  (let ((fn (condition-case ()
                (get-selection 'PRIMARY 'FILE_NAME)
              (t "")))
        (bd (condition-case ()
                (get-selection 'PRIMARY 'STRING)
              (t ""))))
    (when fn (insert fn "\n\n"))
    (when bd (insert bd "\n"))
    (if (fboundp 'de-unicoddle) (de-unicoddle))
    (72ify)
    nil)

;  (delete-other-windows)

  (goto-char (point-min))
  (insert "Subject: \n"
          "Tags:   \n"
          "Text:    \n"
          "URL:     \n"
          "Thumb:   \n"
          "Image:   \n"
          "Music:   \n"
;          "Twitter: yes\n"
          "HTML:    no\n"
          "\n")
  (let ((p (point)))
    (skip-chars-forward "\n")
    (delete-region p (point)))
  (push-mark (point-max))
  (goto-char (point-min))
  (end-of-line)

  (monkeybutter-mode)

  (cond ((and buffer-auto-save-file-name
              (file-exists-p buffer-auto-save-file-name)
              (yes-or-no-p (format "Recover auto save file %s? "
                                   buffer-auto-save-file-name)))
         (erase-buffer)
         (insert-file-contents buffer-auto-save-file-name nil)))
  nil)


(defun monkeybutter-parse ()
  (let ((case-fold-search t)
        subject tags community text url imgs thumbs music prev htmlp twit body)
    (save-excursion
      (goto-char (point-min))
      (if (re-search-forward "^Subject:[ \t]*\\(.*\\)$" nil t)
          (setq subject (match-string 1))
        (error "no subject?"))

      (if (equal subject "") (error "no subject!"))

      (goto-char (point-min))
      (if (re-search-forward "^Tags:[ \t]*\\(.*\\)$" nil t)
          (setq tags (match-string 1)))

      (goto-char (point-min))
      (if (re-search-forward "^Community:[ \t]*\\(.*\\)$" nil t)
          (setq community (match-string 1)))

      (goto-char (point-min))
      (if (re-search-forward "^Text:[ \t]*\\(.*\\)$" nil t)
          (setq text (match-string 1))
        ;(error "no text?")
        )

      (goto-char (point-min))
      (if (re-search-forward "^URL:[ \t]*\\(.*\\)$" nil t)
          (setq url (monkeybutter-rewrite-url (match-string 1)))
        ;(error "no URL?")
        )

      (goto-char (point-min))
      (while (re-search-forward "^Image:[ \t]*\\(.*\\)$" nil t)
        (let ((i (match-string 1)))
          (if (and i (not (equal i "")))
              (setq imgs (nconc imgs (list (monkeybutter-rewrite-url i)))))))

      (goto-char (point-min))
      (while (re-search-forward "^Thumb:[ \t]*\\(.*\\)$" nil t)
        (let ((i (match-string 1)))
          (if (and i (not (equal i "")))
              (setq thumbs (nconc thumbs
                                  (list (monkeybutter-rewrite-url i)))))))

      (goto-char (point-min))
      (if (re-search-forward "^Music:[ \t]*\\(.*\\)$" nil t)
          (setq music (match-string 1)))

      (goto-char (point-min))
      (if (re-search-forward "^Previously:[ \t]*\\(.*\\)$" nil t)
          (setq prev (match-string 1)))

      (goto-char (point-min))
      (if (re-search-forward "^Twitter:[ \t]*\\(.*\\)$" nil t)
          (setq twit (match-string 1)))

      (goto-char (point-min))
      (if (re-search-forward "^HTML:[ \t]*\\(.*\\)$" nil t)
          (let ((s (match-string 1)))
            (setq htmlp (cond ((string-match "\\`[ \t]*yes[ \t]*\\'" s) t)
                              ((string-match "\\`[ \t]*no[ \t]*\\'" s) nil)
                              (t (error "HTML is not yes or no" s))))))

      (goto-char (point-min))
      (or (re-search-forward "\n\n" nil t) (error "no end of headers?"))
      (skip-chars-forward " \t\n")
      (skip-chars-backward " \t")
      (setq body (buffer-substring (point) (point-max)))
      )

    (if prev (setq prev (split-string prev "[ \t\n]+" t)))

    (if (and htmlp text)   (error "can't specify Text when HTML is yes"))
    (if (and htmlp url)    (error "can't specify URL when HTML is yes"))
    (if (and htmlp imgs)   (error "can't specify Image when HTML is yes"))
    (if (and htmlp thumbs) (error "can't specify Thumb when HTML is yes"))
    (if (and htmlp prev)   (error "can't specify Previously when HTML is yes"))

    (if htmlp (jwz-lj-validate))
    (list subject tags community text url imgs thumbs music htmlp body
          prev twit)))


;; Do some rewriting of dumb URLs.
;;
(defun monkeybutter-rewrite-url (url)
  (let (b)
    (save-excursion
      (unwind-protect
          (let ((case-fold-search t))
            (setq b (get-buffer-create " *url-monkeybuffer*"))
            (set-buffer b)
            (erase-buffer)
            (insert url)
            (goto-char (point-min))
            ;;
            ;; If the URL contains an encoded URL inside of it, use that.
            ;; Unless it's Youtube.
            ;;
            (cond ((and (not (looking-at "^http://www\\.youtube\\.com/"))
                        (re-search-forward "http%3A%2F%2F[^?& \t\r\n\"\']+" 
                                           nil t))
                   (delete-region (match-end 0) (point-max))
                   (delete-region (point-min) (match-beginning 0))
                   
                   (goto-char (point-min))
                   (while (re-search-forward "%[0-9A-Fa-f][0-9A-Fa-f]" nil t)
                     (goto-char (match-beginning 0))
                     (delete-char 1)
                     (insert (string-to-int
                              (buffer-substring (point) (+ (point) 2))
                              16))
                     (delete-char 2))
                   )
                  ((looking-at 
           "^\\(http://www\\.youtube\\.com/\\).*/watch%3Fv%3D\\(.*?\\)%26.*$")
                   (delete-region (match-end 2) (match-end 0))
                   (delete-region (match-end 1) (match-beginning 2))
                   (goto-char (match-end 1))
                   (insert "v/"))
                  )
            ;;
            ;; If the URL has crud after the extension, lose it.
            ;; Unless it's Tumblr.
            ;;
            (cond ((and (not (looking-at ".*data\\.tumblr\\.com"))
                        (re-search-forward "\\.jpg\\(\\?.*\\)$" nil t))
                   (delete-region (match-beginning 1) (match-end 1))))
            ;;
            ;; De-searchify YouTube
            ;;
            (cond ((and (or (looking-at "^http://www\.youtube\.com/")
                            (looking-at "^http://video\.google\.com/"))
                        (search-forward "&" nil t))
                   (delete-region (match-beginning 0) (point-max))))

            (buffer-string))
        (if b (kill-buffer b))))))


(defun monkeybutter-convert-buffer-to-html ()
  (interactive)
  (let* ((val (monkeybutter-parse))
         ;(subject   (nth 0 val))
         (tags       (nth 1 val))
         ;(community (nth 2 val))
         (text       (nth 3 val))
         (url        (nth 4 val))
         (imgs       (nth 5 val))
         (thumbs     (nth 6 val))
         ;(music     (nth 7 val))
         (htmlp      (nth 8 val))
         (body       (nth 9 val))
         (prev       (nth 10 val))
         ;(twit      (nth 11 val))
         )

    (if htmlp (error "buffer is already HTML?"))

    (goto-char (point-min))
    (or (search-forward "\n\n" nil t) (error "can't find end of headers"))
    (setq body (buffer-substring (point) (point-max)))
    (setq body (monkeybutter-htmlize url text imgs thumbs prev tags body htmlp))

    (goto-char (point-min))
    (or (re-search-forward "^HTML:[ \t]*\\(.*\\)$" nil t)
        (error "can't find HTML header"))
    (goto-char (match-beginning 1))
    (delete-region (point) (match-end 1))
    (insert "yes")

    (goto-char (point-min))
    (or (search-forward "\n\n" nil t) (error "can't find end of headers"))
    (delete-region (point) (point-max))

    ;; delete the headers that we have emitted HTML for.
    (while (progn
             (goto-char (point-min))
             (re-search-forward 
              "^\\(Text\\|URL\\|Thumb\\|Image\\|Previously\\):.*\n"
              nil t))
      (delete-region (match-beginning 0) (match-end 0)))

    (goto-char (point-max))
    (insert body)
    nil))


(defun monkeybutter-submit ()
  "Posts to LiveJournal and mails to monkeybutter."
  (interactive)
  (let* ((recipient monkeybutter-recipients)
         (bcc monkeybutter-bcc)
         (fcc monkeybutter-fcc)

         (val (monkeybutter-parse))
         (subject    (nth 0 val))
         (tags       (nth 1 val))
         (community  (nth 2 val))
         ;(text       (nth 3 val))
         ;(url        (nth 4 val))
         ;(imgs       (nth 5 val))
         ;(thumbs     (nth 6 val))
         (music      (nth 7 val))
         (htmlp      (nth 8 val))
         (body       (nth 9 val))
         ;(prev      (nth 10 val))
         (twit       (nth 11 val))
         lj-body
         mail-body
         new-url)

    (if (not htmlp) (error "buffer is not yet HTML"))

    (setq lj-body   (jwz-lj-html-clean body t   nil))   ; unwrap for lj
    (setq mail-body (jwz-lj-html-clean body nil nil)) ; no unwrap for mail

    (or (yes-or-no-p "Subit to LiveJournal and Monkeybutter now? ")
        (error ""))

    (setq lj-body (monkeybutter-mirror-images lj-body tags))
    (setq mail-body (monkeybutter-mirror-images mail-body tags))

    (message "Submitting to LiveJournal (%s)..." subject)

    ;;
    ;; 1) Post to LJ...
    ;;
    (let ((id (jwz-lj-post subject
                           lj-body
                           nil            ; security
                           tags           ; tags
                           community      ; community
                           nil            ; auto-format-p
                           nil            ; disallow-comments-p
                           nil            ; current-mood
                           music          ; current-music
                           )))
      (or id (error "no ID for post"))
      (setq new-url (format "http://%s.livejournal.com/%s.html"
                            jwz-lj-lj-user-name id)))

    ;;
    ;; 2) Save to file...
    ;;
    (if (and fcc (not (equal fcc "")))
        (jwz-lj-do-fcc fcc
                       (jwz-lj-html-clean body nil t)
                       subject new-url))
    ;;
    ;; 3) Send mail.
    ;;
    (if (and bcc (not recipient))
        (setq recipient bcc
              bcc nil))

    (if recipient
        (save-excursion
          (message "Composing mail (%s)..." subject)
          (mail)
          (mail-to)      (insert recipient)
          (mail-bcc)     (insert (or bcc ""))
          (mail-subject) (insert subject)

          (goto-char (point-min))
          (search-forward (concat "\n" mail-header-separator "\n"))
          (delete-region (point) (point-max))
          (save-excursion
            (goto-char (match-beginning 0))
            (insert "\nMIME-Version: 1.0\n"
                    "Content-Type: text/html"
                    "\nX-URL: " new-url)
            )
          (insert "<A HREF=\"" new-url "\">" new-url "</A><P>\n")
          (insert mail-body "<P>\n")
          (message "Sending mail (%s)..." subject)
          (mail-send-and-exit nil)
          ))

    (jwz-lj-do-twitter twit subject new-url)

    ;; If buffer has no file, mark it as unmodified and delete autosave.
    (cond ((or (not buffer-file-name)
               (not (buffer-modified-p)))
           (set-buffer-modified-p nil)
           (delete-auto-save-file-if-necessary t))
          ((or noninteractive
               (y-or-n-p (format "Save file %s? " buffer-file-name)))
           (save-buffer)))

    (kill-buffer (current-buffer))))


(defun monkeybutter-convert-or-submit ()
  "If the buffer is not HTML, converts it (for futher editing.)
If it is already HTML, posts it to LiveJournal and mails it to monkeybutter."
  (interactive)
  (let* ((val (monkeybutter-parse))
         (htmlp (nth 8 val)))
    (if htmlp
        (monkeybutter-submit)
      (monkeybutter-convert-buffer-to-html))))


(defun monkeybutter-text-to-html (&optional start end)
  "Converts plain-text in the selected region to an HTML equivalent."
  (interactive)
  (save-excursion
    (save-restriction
      (or start (setq start (if (region-active-p)
                                (region-beginning)
                              (point-min))))
      (or end (setq end (if (region-active-p)
                            (region-end)
                          (point-max))))
      (narrow-to-region start end)

      ;; convert &
      (goto-char (point-min))
      (while (search-forward "&" nil t) (insert "amp;"))
      ;; convert <
      (goto-char (point-min))
      (while (search-forward "<" nil t) (replace-match "&lt;"))
      ;; convert >
      (goto-char (point-min))
      (while (search-forward ">" nil t) (replace-match "&gt;"))

      ;; convert ^L to LJ-CUT
      (save-excursion
        (goto-char (point-min))
        (if (search-forward "\^L" nil t)
            (delete-char -1))
        (unless (or (= (point) (point-min))
                    (= (point) (point-max)))
          (when (re-search-backward "\n\n+" nil t)
            (goto-char (match-end 0))
            (let* ((pct (round (/ (* 100.0 (point)) (point-max))))
                   (txt (format " --More--(%2d%%) " pct)))
              (insert "<LJ-CUT text=\"" txt "\">\n\n")))))

      ;; convert blank lines to paragraphs
      (goto-char (point-min))
      (while (re-search-forward "\n[ \t]*\n+" nil t)
        (replace-match "\n\n<P> "))

      ;; convert URLs to HREFs around the hostname
      (goto-char (point-min))
      (while (re-search-forward
              "\\(https?\\|ftp\\):/+\\([^/:@]+\\)[^ \t\n<>]+" nil t)
        (skip-chars-backward "-.,;!?<>()")
        (let ((u (buffer-substring (match-beginning 0) (point))))
          (delete-region (match-beginning 0) (point))
          (insert "<A HREF=\"" u "\">\n"
                  (monkeybutter-url-anchor u)
                  "</A>")
          ))
      )))


(defun monkeybutter-htmlize (url url-text imgs thumbs prev tags body htmlp)
  (if (equal url "")      (setq url nil))
  (if (equal url-text "") (setq url-text nil))

  (let (b)
    (save-excursion
      (unwind-protect
          (let ((case-fold-search t)
                (divp nil)
                p)
            (setq b (get-buffer-create " *monkeybuffer*"))
            (set-buffer b)
            (erase-buffer)

            (setq p (point))
            (insert body)
            (cond ((not htmlp)
                   (monkeybutter-text-to-html)
                   (if (> (point) (+ p 2))
                       (monkeybutter-blockquote p (point)))))
            (goto-char (point-min))

            (if (and url                                ; there is a url
                 (null imgs)                        ; there is not an img
                 (string-match "\\.\\(jpe?g\\|gif\\|png\\)\\'" url)  ; url is img
                     (y-or-n-p "Inline the image? ")) ; ask user
                (setq imgs (list url)
                      url (if url-text
                              url
                            nil)))

            ;; if we're inlining an image, center everything
            ;;
            (cond (imgs (insert "<DIV ALIGN=CENTER>\n") (setq divp t)))

            ;; open the HREF
            ;;
            (if url (insert "<A HREF=\"" url "\">\n"))

            ;; insert the flush-right thumbnail, if any
            ;;
            (while thumbs
              (let ((thumb (pop thumbs)))
                (or (string-match "\\.\\(jpe?g\\|gif\\|png\\)\\b" thumb)
                    (error "Thumb not an image? " thumb))
                (monkeybutter-insert-image thumb nil t)))

            ;; insert the anchor text
            (if url (insert (or url-text 
                                (if imgs "" (monkeybutter-url-anchor url)))))

            ;; insert the inlined image, if any
            ;;
            (let ((nimgs (length imgs))
                  (n 0))

              ;; only do the table thing for "a/b"
              (if (not (string-match "\\ba/b\\b" tags))
                  (setq nimgs 1))

              (if (> nimgs 1)
                  (insert "</A>\n" 
                          "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>\n"
                          " <TR>\n"))
              (if (= nimgs 2)
                  (insert "  <TD ALIGN=CENTER VALIGN=TOP>\n"
                          "   "
                          (if url (concat "<A HREF=\"" url "\">") "")
                          "<B>Exhibit A:</B>"
                          (if url "</A>" "")
                          "</TD>\n"
                          "  <TD ALIGN=CENTER VALIGN=TOP>\n"
                          "   "
                          (if url (concat "<A HREF=\"" url "\">") "")
                          "<B>Exhibit B:</B>"
                          (if url "</A>" "") 
                          "</TD>\n"
                          " </TR><TR>\n"))
              (while imgs
                (if (> nimgs 1)
                    (insert "  <TD ALIGN=" 
                            (if (= 0 (logand n 1)) "RIGHT" "LEFT")
                            " VALIGN=TOP>\n"
                            "   "
                            (if url (concat "<A HREF=\"" url "\">") "")))
                (let ((img (pop imgs)))
                  (cond
                   ((or (string-match "^http://[^.]*\\.?youtube\\.com/" img)
                        (string-match "^http://video\.google\\.com/" img)
                        (string-match "^http://[^.]*\\.?vimeo\\.com/" img)
                        (string-match "\\.\\(mov\\|mp4\\)$" img))
                    (if url
                        (insert "</A>\n<P>\n"))
                    (setq url nil)
                    (jwz-lj-youtube img))
                   ((string-match "\\.\\(jpe?g\\|gif\\|png\\)\\b" img)
                    (if url-text (insert "<P>\n"))
                    (setq url-text nil)
                    (monkeybutter-insert-image img nil))
                   (t (error "Image not an image? " img))))
                (cond ((> nimgs 1)
                       (delete-region
                        (save-excursion (skip-chars-backward " \t\n") (point))
                        (point))
                       (if url (insert "</A>"))
                       (insert "</TD>\n")))
                (setq n (1+ n))
                )
              (if (> nimgs 1)
                  (insert " </TR>\n</TABLE>\n"))

              ;; close the HREF
              (while (= (preceding-char) ?\n) (delete-char -1))
              (if (and url (<= nimgs 1)) (insert "</A>\n"))
              )

            (if divp (insert "</DIV>\n"))

            (if prev
                (let ((done nil))
                  (goto-char (point-max))
                  (insert "\n<P>\n")
                  (while prev
                    (insert "<A HREF=\"" (car prev) "\">"
                            (if done "previously" "Previously") "</A>"
                            (if (cdr prev) "," ".")
                            "\n")
                    (setq done t prev (cdr prev)))))

            (goto-char (point-min))
            (while (re-search-forward "\\(</OBJECT>\n\\)\\(<OBJECT\\)" nil t)
              (replace-match "\\1\n<P>\\2"))

            (buffer-string))
        (if b (kill-buffer b))))))


(defun monkeybutter-textize (subject url url-text imgs thumbs body)
  (if (equal subject url-text)
      (setq url-text nil))
  (let (b)
    (save-excursion
      (unwind-protect
          (progn
            (setq b (get-buffer-create " *monkeybuffer-text*"))
            (set-buffer b)
            (erase-buffer)

            (if url-text
                (let ((fill-column 71)
                      (p (point)))
                  (insert url-text "\n")
                  (fill-region p (point))
                  (insert "\n\n")))

            (if url
               (insert "    " url "\n"))
            (while imgs
              (insert "    " (pop imgs) "\n"))
            (insert "\n")
            (insert body)

            (goto-char (point-min))
            (while (search-forward "\^L" nil t)
              (delete-region (match-beginning 0) (match-end 0)))
            (goto-char (point-min))
            (while (re-search-forward "^[ \t]+$" nil t)  ; trailing whitespace
              (delete-region (match-beginning 0) (match-end 0)))
            (goto-char (point-min))
            (while (re-search-forward "\n\n\\(\n+\\)" nil t) ; blank lines
              (delete-region (match-beginning 1) (match-end 1)))
            (goto-char (point-min))
            (while (looking-at "^[ \t]*$") (forward-line 1))
            (delete-region (point-min) (point))

            (buffer-string (point-min) (point-max)))
        (if b (kill-buffer b))))))


(defun monkeybutter-insert-image (img &optional url thumb-p)
  (interactive "sImage URL: ")
  (let ((case-fold-search t)
        (cmd (concat "wget -qO- '" img "'")))
    (cond ((string-match "\\.jpe?g\\b" img)
           (setq cmd (concat cmd " | djpeg")))
          ((string-match "\\.png\\b" img)
           (setq cmd (concat cmd " | pngtopnm")))
          ((string-match "\\.gif\\b" img)
           (setq cmd (concat cmd " | giftopnm")))
          (t (error "not a jpg/png/gif?" img)))
    (setq cmd (concat cmd "| head -2 | tail -1"))
    (let ((result (shell-command-to-string cmd)))
      (or (string-match "^\\([0-9]+\\) \\([0-9]+\\)$" result)
          (error "unable to get image size: %s - " img result))
      (let* ((w (match-string 1 result))
             (h (match-string 2 result)))
        (setq img (replace-in-string img "&" "&amp;"))
        (insert (if url (concat "<A HREF=\"" url "\">") "")
                "<IMG SRC=\"" img "\"\n     STYLE=\""
                (if thumb-p "width:30%; " "width:90%; ")
                "height:auto; max-width:" w "px; max-height:" h "px; "
                "border:1px solid; margin:2px;"
                (if thumb-p " float:right; clear:right;" "")
                "\">"
                (if url "</A>" "")
                "\n"
                )))))


(defun monkeybutter-shrink-image ()
  "Looks for an IMG tag near the cursor, and divides width/height in half."
  (interactive)
  (save-excursion
    (save-restriction
      (let ((case-fold-search t)
            p w h)
        (search-forward ">" nil t)
        (re-search-backward "<\\(IMG\\|EMBED\\|OBJECT\\)\\b")
        (setq p (point))
        (search-forward ">")
        (narrow-to-region p (point))
        (goto-char p)
        (or (re-search-forward "\\bWIDTH=\\([0-9]+\\)\\b" nil t)
            (error "no width in IMG?"))
        (setq w (string-to-int (match-string 1)))
        (goto-char p)
        (or (re-search-forward "\\bHEIGHT=\\([0-9]+\\)\\b" nil t)
            (error "no height in IMG?"))
        (setq h (string-to-int (match-string 1)))
        (setq w (/ w 2)
              h (/ h 2))
        (goto-char p)
        (search-forward "WIDTH=")
        (setq p (point))
        (forward-word 1)
        (delete-region p (point))
        (insert (int-to-string w))
        (goto-char (point-min))
        (search-forward "HEIGHT=")
        (setq p (point))
        (forward-word 1)
        (delete-region p (point))
        (insert (int-to-string h))
        nil))))


(defun monkeybutter-image-width-height-1 (width-p new-size)
  (save-excursion
    (save-restriction
      (let ((case-fold-search t)
            (field  (if width-p "width" "height"))
            (field2 (if width-p "height" "width"))
            p op w h)
        (search-forward ">" nil t)
        (re-search-backward "<\\(IMG\\|EMBED\\|OBJECT\\)\\b")
        (setq p (point))

        ;; If we're inside an <OBJECT>, set the region to be the entire
        ;; OBJECT, not just the IMG or EMBED that point might have been in.
        ;;
        (cond ((not (looking-at "<OBJECT"))
               (while (and (search-backward "<" nil t)
                           (looking-at "<\\(A\\|PARAM\\)\\b"))
                 (setq op p 
                       p (point)))))
        (if (not (looking-at "<OBJECT"))
            (goto-char (or op p)))
        (setq p (point))

        (search-forward (if (looking-at "<OBJECT") "</OBJECT>" ">"))

        (narrow-to-region p (point))
        (goto-char p)
        (or (re-search-forward (concat "\\b" field "=\"?\\([0-9]+\\)\\b") 
                               nil t)
            (error (concat "no " field " in IMG?")))
        (if width-p
            (setq w (string-to-int (match-string 1)))
          (setq h (string-to-int (match-string 1))))
        (goto-char p)
        (or (re-search-forward (concat "\\b" field2 "=\"?\\([0-9]+\\)\\b") 
                               nil t)
            (error "no " field2 " in IMG?"))
        (if width-p
            (setq h (string-to-int (match-string 1)))
          (setq w (string-to-int (match-string 1))))

        (if width-p
            (setq h (round (* h (/ (float new-size) w)))
                  w new-size)
          (setq w (round (* w (/ (float new-size) h)))
                h new-size))

        ;; Overwrite all WIDTH= and HEIGHT= params in the region.

        (goto-char (point-min))
        (while (search-forward (concat field "=") nil t)
          (setq p (point))
          (forward-word 1)
          (if (looking-at "\"") (delete-char 1))
          (delete-region p (point))
          (insert (int-to-string (if width-p w h))))

        (goto-char (point-min))
        (while (search-forward (concat field2 "=") nil t)
          (setq p (point))
          (forward-word 1)
          (if (looking-at "\"") (delete-char 1))
          (delete-region p (point))
          (insert (int-to-string (if width-p h w))))
        nil))))


(defun monkeybutter-image-width (new-width)
  "Finds an IMG or OBJECT tag near point and scales it to the given width."
  (interactive "nWidth: ")
  (monkeybutter-image-width-height-1 t new-width))

(defun monkeybutter-image-height (new-height)
  "Finds an IMG or OBJECT tag near point and scales it to the given height."
  (interactive "nHeight: ")
  (monkeybutter-image-width-height-1 nil new-height))


(defun monkeybutter-url-anchor (url)
  "Returns a string to use as the anchor text of the URL."
  (let ((host (and (string-match "^\\(https?\\|ftp\\):/+\\([^/:@]+\\)" url)
                   (match-string 2 url))))
    (if (and (string-match "livejournal" host)
             (or (string-match "journal=\\([^&=./]+\\)" url)
                 (string-match "/users/\\([^&=./]+\\)" url)
                 (string-match "\?user=\\([^&=./]+\\)" url)
                 (string-match "/\\([^/&=.]+\\)\\.livejournal\\.com" url)))
        (match-string 1 url)
      host)))


(defun monkeybutter-preview ()
  "Sends the body of the current post to Mozilla to view it."
  (interactive)
  (let ((file "/tmp/ljtmp.html")
        div-point
        body)

    (let* ((val (monkeybutter-parse))
           (subject    (nth 0 val))
           (tags       (nth 1 val))
           (community  (nth 2 val))
           (text       (nth 3 val))
           (url        (nth 4 val))
           (imgs       (nth 5 val))
           (thumbs     (nth 6 val))
           (music      (nth 7 val))
           (htmlp      (nth 8 val))
           (rbody      (nth 9 val))
           (prev       (nth 10 val))
           ;(twit      (nth 11 val))
           )

      (if (not htmlp) (error "buffer is not yet HTML"))

      (setq body (monkeybutter-htmlize url text imgs thumbs prev tags
                                       rbody htmlp))
      (setq body (concat "<TITLE>Monkeybutter Preview</TITLE>\n"
                         "<body bgcolor=\"#C0C0C0\">\n"
                         "<B>Subject: " subject "</B><BR>\n"
                         "<B>Tags: " (jwz-lj-tags-to-html tags) "</B><BR>\n"
                         (if community
                             (concat "<B>Community: " community "</B><BR>\n")
                           "")
                         "<B>Music: " music "</B><BR>\n"
                         "<P>"
                         body))
      (setq body (monkeybutter-mirror-images body tags))
      (setq body (jwz-lj-html-clean body t t))
      (setq div-point (length body))
      (let (b)
        (save-excursion
          (unwind-protect
              (progn
                (setq b (get-buffer-create " *monkeybutter-preview*"))
                (set-buffer b)
                (erase-buffer)
                (insert body)
                (monkeybutter-mirror-images nil tags)
                (jwz-lj-entify (point-min) div-point)
                (write-region (point-min) (point-max) file))
            (if b (kill-buffer b))))))

    (browse-url file)))



;;; make local copies of images that I post

(defconst monkeybutter-recently-mirrored-urls '()
  "We don't re-download the same URL in a single session.")

(defun monkeybutter-mirror-images-1 (tags)
  (let* ((case-fold-search t)
         (myhost (if (string-match "^[a-z]+://\\([^/]+\\)"
                                   monkeybutter-mirror-images-url)
                     (match-string 1 monkeybutter-mirror-images-url)
                   (error "monkeybutter-mirror-images-url unparsable")))
         (any-changes-p nil))
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward
              "<IMG\\b[^<>]*SRC[ \t]*=[ \t]*\"\\([^\"]+\\)\"[^<>]*>"
              nil t)
        (let* ((ustart (match-beginning 1))
               (uend (match-end 1))
               (url (buffer-substring ustart uend)))
          (cond
           ((string-match "^[a-z]+://\\([^/]+\\).*/\\([^/]+\\)$" url)
            (let ((host (match-string 1 url))
                  (file (match-string 2 url)))
              (cond
               ((not (string-match "\\.\\(jpe?g\\|gif\\|png\\)\\b" file))
                (error "weird img src: %S" url))
               ((and (not (equal host myhost))
                     (not
                      (string-match "www\.livejournal\.com$" host)) ; userinfo
                     (not
                      (string-match "img\.youtube\.com$" host)) ; keyframes
                     )
                (let ((new-url (monkeybutter-mirror-image 
                                (replace-in-string url "&amp;" "&")
                                tags)))
                  (cond ((and new-url
                              monkeybutter-mirror-images-p
                              (not (eq monkeybutter-mirror-images-p
                                       'mirror-only)))
                         (goto-char ustart)
                         (delete-region ustart uend)
                         (insert new-url)
                         (setq any-changes-p t)))))))))))
      (cond
       (any-changes-p
        (message "Running %s..." monkeybutter-mirror-images-command)
        (let ((default-directory monkeybutter-mirror-images-directory))
          (shell-command-on-region (point) (point)
                                   monkeybutter-mirror-images-command))))
      any-changes-p)))

(defun monkeybutter-mirror-images (&optional html-string tags)
  "Make local mirrors of all images refered to in the HTML in the buffer,
if monkeybutter-mirror-images-p is true.
If HTML-STRING is provided, modify/return that instead of the current buffer.
Copies each non-local <IMG> URL to the local disk, being clever about file
names.  Updates the URL in the current buffer, then runs
monkeybutter-mirror-images-command to push the changes out to the web
site."
  (interactive)
  (cond
   ((not monkeybutter-mirror-images-p)
    html-string)
   ((not html-string)
    (monkeybutter-mirror-images-1 tags))
   (t
    (let (b)
      (save-excursion
        (unwind-protect
            (progn
              (setq b (get-buffer-create " *monkeybuffer-mirror*"))
              (set-buffer b)
              (erase-buffer)
              (insert html-string)
              (monkeybutter-mirror-images-1 tags)
              (buffer-string))
          (if b (kill-buffer b))))))))


(defun monkeybutter-clean-filename (string)
  "Removes bogus characters from the string: whitespace, %20, etc."
  (let (b)
    (save-excursion
      (unwind-protect
          (progn
            (setq b (get-buffer-create " *monkeybuffer-clean*"))
            (set-buffer b)
            (erase-buffer)
            (insert string)
            ;;
            ;; Lose search terms
            ;;
            (goto-char (point-min))
            (if (search-forward "?" nil t)
                (delete-region (1- (point)) (point-max)))
            ;;
            ;; undo any %XX URL encoding.
            ;;
            (goto-char (point-min))
            (while (re-search-forward "%[0-9A-Fa-f][0-9A-Fa-f]" nil t)
              (goto-char (match-beginning 0))
              (delete-char 1)
              (insert (string-to-int
                       (buffer-substring (point) (+ (point) 2))
                       16))
              (delete-char 2))
            ;;
            ;; convert any remaining troublesome characters to underscores.
            ;;
            (goto-char (point-min))
            (while (re-search-forward "[^-a-zA-Z0-9_.,]" nil t)
              (delete-char -1)
              (insert "_"))

            ;; lose underscore before/after dots
            (goto-char (point-min))
            (while (re-search-forward "\\(_+\\.\\|\\._+\\|\\.\\.+\\)" nil t)
              (delete-region (match-beginning 0) (match-end 0))
              (insert ".")
              (forward-char -1))

            ;; compress consecutive underscores, spaces, dots
            (goto-char (point-min))
            (while (re-search-forward "\\([-_.]\\)\\1+" nil t)
              (delete-region (match-end 1) (match-end 0)))

            (buffer-string))
        (if b (kill-buffer b))))))


(defun monkeybutter-mirror-image (url &optional tags)
  "Copy the URL to the local disk, being clever about file names.
Returns the URL of the mirrored file.
Applies the given list of tag-strings to the image if
`monkeybutter-tag-mirrored-images-p' is true."
  (or (string-match "^[a-z]+://\\([^/]+\\).*/\\([^/]+\\)$" url)
      (error "unparsable URL" url))
  (let* ((case-fold-search t)
         (file (match-string 2 url))
         (existing-file nil)
         (target-file (expand-file-name
                       (monkeybutter-clean-filename file)
                       monkeybutter-mirror-images-directory))
         (download-p t))

    ;; if a file of this name exists already, append numbers until we
    ;; find a non-conflicting one.
    (cond ((file-exists-p target-file)
           (setq existing-file target-file)
           (or (string-match "\\.\\([^.]+\\)$" file)
               (error "unparsable file name" file))
           (let ((name (substring file 0 (1- (match-beginning 1))))
                 (ext  (substring file (match-beginning 1)))
                 (n 2))
             (while (file-exists-p
                     (setq file (format "%s-%s.%s" name n ext)
                           target-file
                             (expand-file-name
                              file monkeybutter-mirror-images-directory)))
               (setq existing-file target-file
                     n (1+ n))))

           (setq download-p
                 (if (member url monkeybutter-recently-mirrored-urls)
                     nil
                   (yes-or-no-p (format "File exists: re-download as %s? "
                                        file))))))

    (cond (download-p
           ;; download it.
           (message "Mirroring %s (%s)..." target-file url)
           (shell-command-on-region (point) (point)
            (format "wget -qO '%s' '%s'" target-file url))
           (or (file-exists-p target-file)
               (error "failed to download" target-file))
           (setq monkeybutter-recently-mirrored-urls
                 (cons url monkeybutter-recently-mirrored-urls))
           (setq existing-file target-file)))

    (or (string-match "/\\([^/]+\\)$" existing-file)
        (error "unparsable file" existing-file))
    (setq file (match-string 1 existing-file))

    (if (and monkeybutter-tag-mirrored-images-p tags)
        (monkeybutter-tag-image existing-file tags))

    (concat monkeybutter-mirror-images-url file)))


(defun monkeybutter-tag-image (file tags)
  (if (stringp tags)
      (let ((s tags))
        (setq tags nil)
        (while (string-match 
                "\\`\\(.*?\\)[ \t\n]*,[ \t\n]*\\(.*\\)\\'"
                s)
          (setq tags (cons (match-string 1 s) tags)
                s (match-string 2 s)))
        (setq tags (cons s tags))
        (setq tags (nreverse tags))))
  (let ((cmd "exiftool")
        (tmp-file (concat file "_original")) ; stupid exiftool.
        b)
    (while tags
      (setq cmd (concat cmd " -keywords='" (car tags) "'"))
      (setq tags (cdr tags)))
    (setq cmd (concat cmd " '" file "'"))
    (save-excursion
      (unwind-protect
          (let ((case-fold-search t))
            (setq b (get-buffer-create " *tag-monkeybuffer*"))
            (set-buffer b)
            (erase-buffer)
            (shell-command-on-region (point) (point) cmd nil t)
            (goto-char (point-min))
            (if (search-forward "error" nil t)
                (error (buffer-string)))
            (delete-region (point-min) (point-max))
            )
        (if (file-exists-p tmp-file) (delete-file tmp-file))
        (if b (kill-buffer b)))))
  file)



(defun monkeybutter-blockquote (from to &optional box-p)
  "*Inserts a stylized <BLOCKQUOTE> tag around the selected text, and indents."
  (interactive "r")
  (if (interactive-p) (setq box-p current-prefix-arg))
  (save-excursion
    (goto-char to)
    (setq to (point-marker))
    (insert "</BLOCKQUOTE>\n")
    (goto-char from)
    (insert "<BLOCKQUOTE ")
    (if box-p
        (insert "STYLE=\"margin:1em;"
                "border:1px solid;"
                "padding:1em\"")
      (insert "STYLE=\"margin-left:1em;"
              "border-left:2px solid;"
              "padding-left:1em\""))
    (insert ">\n")
    (if (looking-at "[ \t\r\n]*<[pP]>[ \t\r\n]*")
        (delete-region (match-beginning 0) (match-end 0)))
    (setq from (point))
    (indent-rigidly from to 1))
  nil)



(defun monkeybutter-safari-get-quote ()
  "Runs some AppleScript to get text and URLs from Safari
and returns a list of: URL, Title, and currently-highlighted text
\(or the plain-text of the whole document)."
  (let* ((applescript
          (concat 
           "tell application \"Safari\"\n"
           "  set theDoc to front document\n"
           "  set theURL to URL of theDoc\n"
           "  set theText to text of theDoc\n"
           "  set theTitle to name of theDoc\n"
           "  set theSelected to do JavaScript "
           "    \"window.getSelection()\" in theDoc\n"
           "  if theSelected is not \"\" then\n"
           "    set theText to theSelected\n"
           "  end if\n"
           "  set theResult to theURL & \"\n\" & theTitle & \"\n\" & theText\n"
           "  return theResult\n"
           "end tell\n"))
         b url title body)
    (save-excursion
      (unwind-protect
          (let (p)
            (setq b (get-buffer-create " *applescript*"))
            (set-buffer b)
            (erase-buffer)
            (insert applescript)
            (shell-command-on-region (point-min) (point-max) "osascript"
                                     (current-buffer))
            (goto-char (point-min))
            (goto-char (point-max))
            (skip-chars-backward " \t\r\n")
            (delete-region (point) (point-max))
            (goto-char (point-min))
            (setq p (point))
            (forward-line 1)
            (setq url (buffer-substring p (1- (point))))
            (setq p (point))
            (forward-line 1)
            (setq title (buffer-substring p (1- (point))))
            (delete-region (point-min) (point))
            (setq p (point))
            (while (search-forward "\n" nil t) (insert "\n"))
            (condition-case ()
                (de-unicoddle)
              (t nil))
            (fill-region p (point-max))
            (setq body (buffer-substring p (point-max)))
            )
        (if b (kill-buffer b))))
    (list url title body)))

(defun monkeybutter-auto-paste-quote ()
  "Runs some AppleScript to get text and URLs from Safari
and insert them into the right fields in the current buffer.
If you're on a Mac, put this on `monkeybutter-mode-hook'."
  (let* ((result (monkeybutter-safari-get-quote))
         (url (nth 0 result))
         (title (nth 1 result))
         (body (nth 2 result))
         (img nil))

    (if (or (string-match "^http://www\.youtube\.com/" url)
            (string-match "^http://video\.google\.com/" url)
            (string-match "^http://www\.vimeo\.com/" url))
        (setq body ""
              img url
              url nil))

    (save-excursion
      (cond (url
             (goto-char (point-min))
             (re-search-forward "^URL:[ \t]*")
             (insert url)))
      (cond (img
             (goto-char (point-min))
             (re-search-forward "^Image:[ \t]*")
             (insert img)))
      (cond (title
             (goto-char (point-min))
             (re-search-forward "^Text:[ \t]*")
             (insert title)))
      (cond (body
             (goto-char (point-max))
             (insert body)))
      ))
  nil)

(defun monkeybutter-paste-quote ()
  "Inserts a cited blockquote of the text/url currently highlighted in Safari."
  (interactive)
  (let* ((result (monkeybutter-safari-get-quote))
         (url (nth 0 result))
         (title (nth 1 result))
         (body (nth 2 result))
         p)
    (insert "<P>\n<A HREF=\"" url "\">\n"
            " " title "</A>\n")
    (setq p (point))
    (insert body "\n")
    (save-window-excursion
      (save-excursion
        (save-restriction
          (narrow-to-region p (point))
          ;;(goto-char (point-min))
          ;;(while (re-search-forward "\n" nil t) (insert "\n"))
          (goto-char (point-min))
          (while (re-search-forward "^[ \t]+" nil t)
            (delete-region (match-beginning 0) (match-end 0)))
          (goto-char (point-min))
          (while (re-search-forward "^[ \t]*\\(\n[ \t]*\\)+" nil t)
            (delete-region (match-beginning 0) (match-end 0))
            (insert "\n"))
          (goto-char (point-min))
          (fill-region (point-min) (point-max))
          (goto-char (point-max))
          (while (= ?\n (preceding-char))
            (delete-char -1))
          (goto-char (point-min))
          (while (search-forward "\n\n" nil t)
            (insert "<P> "))
          (goto-char (point-max))
          (insert "\n")
          (monkeybutter-blockquote (point-min) (point-max))
          ))))
  nil)


;;; shortcuts

(fset 'mb  'monkeybutter)
(fset 'mbp 'monkeybutter-preview)

(fset 'bq 'monkeybutter-blockquote)
(fset 'pq 'monkeybutter-paste-quote)

(provide 'monkeybutter)