1 ;; lj.el --- LiveJournal meets SXEmacs -*- Emacs-Lisp -*-
3 ;; Copyright (C) 2008, 2009 Steve Youngs
5 ;; Author: Steve Youngs <steve@sxemacs.org>
6 ;; Maintainer: Steve Youngs <steve@sxemacs.org>
7 ;; Created: <2008-06-15>
8 ;; Based On: jwz-lj.el by Jamie Zawinski <jwz@jwz.org>
9 ;; Keywords: blog, lj, livejournal
10 ;; Homepage: <http://www.sxemacs.org/~steve/lj/lj.el>
12 ;; This file is part of SLH (Steve's Lisp Hacks).
14 ;; Redistribution and use in source and binary forms, with or without
15 ;; modification, are permitted provided that the following conditions
18 ;; 1. Redistributions of source code must retain the above copyright
19 ;; notice, this list of conditions and the following disclaimer.
21 ;; 2. Redistributions in binary form must reproduce the above copyright
22 ;; notice, this list of conditions and the following disclaimer in the
23 ;; documentation and/or other materials provided with the distribution.
25 ;; 3. Neither the name of the author nor the names of any contributors
26 ;; may be used to endorse or promote products derived from this
27 ;; software without specific prior written permission.
29 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
30 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
31 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
32 ;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
33 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
34 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
35 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
36 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
37 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
38 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
39 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
43 ;; First up, let me say that this would not have been possible if
44 ;; it weren't for JWZ's jwz-lj.el. In fact, large portions of
45 ;; lj.el were lifted directly from jwz-lj.el. So, thank you very
48 ;;; *** IMPORTANT BIT ***
50 ;; You MUST compose your LJ posts in raw HTML (XHTML 1.0 Transitional
51 ;; if you plan on validating the markup before you submit the post).
52 ;; Don't bitch and complain about how hard or inconvenient that is.
53 ;; I'm not listening. The buffer where you write your posts is in a
54 ;; derivative of html-mode so you've got everything you need right at
55 ;; your fingertips. And anyway, writing your LJ posts in raw HTML
56 ;; gives you much more control over what the finished post will look
59 ;; Another important step before you can use lj.el is to log into
60 ;; your LiveJournal a/c with your web browser and check the "remember
61 ;; me" box on the login page. This is the only way to have your
62 ;; password stored in your cookies. Don't worry, it is encrypted.
66 ;; Whack this lib into your load-path somewhere and...
68 ;; (setq lj-user-id "your_lj_id")
70 ;; When you want to compose a new LJ entry... M-x lj RET
72 ;; There's nothing hard or overly complicated here. Take a look at
73 ;; describe-mode (`C-h m') which will show you the keybindings
74 ;; available. All of the "lj-mode specific" interactive commands
75 ;; have a binding. There are 3 "global" commands that don't...
81 ;; The only reason they don't have keybindings is that I think it'd
82 ;; be bad form on my part to set global keys for you. Assign them
83 ;; to keys if you want.
85 ;; All of the "headers" have completion too. A couple of tips
86 ;; about the completion...
88 ;; - By default iso-left-tab (that's shift-tab for the clueless)
89 ;; will cycle backwards.
91 ;; - The trick to getting multiple tags is to type a comma (`,')
92 ;; plus the first letter or two of the next tag you wanna use
93 ;; after the last inserted tag.
97 ;; You can optionally post the subject header of your blog entry as
98 ;; a status update to Twitter, along with a URL to the entry on
99 ;; livejournal.com. To do so, you must set...
102 ;; `lj-twitter-username'
103 ;; `lj-twitter-password'
105 ;; The down side to this is that your twitter username and password
106 ;; are stored in clear text. I'll work on a way to make that safer
113 ;; o Make "Writer's Block" a bit friendlier. Add the ability to
114 ;; choose different qotd's after one has been selected. Also, be
115 ;; able to view older qotd's.
117 ;; o Find a way to pre-fill the subject header properly for writer's
120 ;; o Find a better way than clear text to store twitter username/passwd.
125 ;; I've tried to make this compatible with XEmacs 21.5 and 21.4,
126 ;; but I don't have either of those installed so I'm not 100%
127 ;; certain. As for GNU/Emacs... absolutely no idea, but I'd doubt
128 ;; that this is anywhere near compatible.
136 (defconst lj-version 1.23
137 "Version number of SXEmacs/LJ.")
141 (autoload #'html-mode "psgml-html" nil t)
142 (autoload #'executable-find "executable")
143 (autoload #'completing-read-multiple "crm")
144 (autoload #'sgml-indent-or-tab "psgml" nil t)
145 (autoload #'sgml-parse-prolog "psgml-parse" nil t)
146 (autoload #'sgml-validate "psgml" nil t)
147 (autoload #'sgml-default-validate-command "psgml")
148 (autoload #'browse-url-of-buffer "browse-url" nil t)
149 (autoload #'customize-apropos "cus-edit" nil t)
150 (autoload #'customize-group "cus-edit" nil t)
151 (autoload #'regexp-opt "regexp-opt")
152 (autoload #'sqlite-open "ffi-sqlite")
153 (autoload #'sqlite-rows "ffi-sqlite")
154 (autoload #'sqlite-close "ffi-sqlite")
155 (autoload #'url-cookie-retrieve "url-cookie")
156 (autoload #'url-cookie-name "url-cookie")
157 (autoload #'url-cookie-value "url-cookie")
158 (defvar sxemacs-codename)
159 (defvar xemacs-codename)
160 (defvar url-cookie-secure-storage)
161 (defvar url-cookie-file))
164 (require 'hm--html-configuration)
165 (require 'psgml-html)
167 (unless (fboundp #'when-fboundp)
169 (autoload #'mm-url-insert "mm-url"))
174 :link '(url-link "http://www.livejournal.com/")
177 (defgroup lj-twitter nil
178 "LiveJournal meets Twitter"
179 :prefix "lj-twitter-"
180 :link '(url-link "http://www.livejournal.com/")
181 :link '(url-link "http://twitter.com/")
184 (defun lj-customise-faces ()
185 "Customise the lj.el faces."
187 (customize-apropos "^lj-" 'faces))
189 (defun lj-customise-group ()
190 "Customise lj.el user options."
192 (customize-group "lj"))
194 (defcustom lj-user-id (user-login-name)
199 (defcustom lj-cookie-flavour 'auto
200 "*The default cookie flavour \(browser\) to search for cookies."
202 (symbol :tag "Automatic" :value auto)
203 (symbol :tag "Chrome" :value chrome)
204 (symbol :tag "Firefox" :value firefox)
205 (symbol :tag "Seamonkey" :value seamonkey)
206 (symbol :tag "Mozilla" :value mozilla)
207 (symbol :tag "Galeon" :value galeon)
208 (symbol :tag "Safari" :value safari)
209 (symbol :tag "Netscape" :value netscape)
210 (symbol :tag "Midori" :value midori)
211 (symbol :tag "Emacs-W3" :value w3))
214 (defcustom lj-default-security-level "public"
215 "*The default security level LJ posts will have."
217 (string :tag "Public" :value "public")
218 (string :tag "Private" :value "private")
219 (string :tag "All Friends" :value "usemask")
220 (string :tag "Group..."))
223 (defcustom lj-directory (paths-construct-path
224 (list (user-home-directory) ".lj"))
225 "*Directory for storing tags and archiving posts."
229 (defcustom lj-tags-file (expand-file-name "ljtags" lj-directory)
230 "*File to store list of LJ tags."
234 (defcustom lj-groups-file (expand-file-name "ljgrps" lj-directory)
235 "*File to store list of LJ friends groups."
239 (defcustom lj-moods-file (expand-file-name "ljmoods" lj-directory)
240 "*File to store list of LJ \"moods\"."
244 (defcustom lj-pickws-file (expand-file-name "pickws" lj-directory)
245 "*File to store list of LJ user picture keywords."
249 (defcustom lj-userpic-directory
250 (file-name-as-directory
251 (expand-file-name "images" lj-directory))
252 "*Directory to store LJ userpic files."
256 (defcustom lj-drafts-directory
257 (file-name-as-directory
258 (expand-file-name "drafts" lj-directory))
259 "*Directory where post drafts are stored."
264 "A list of LJ tags.")
266 (defvar lj-groups nil
267 "A list of LJ friends groups.")
270 "LiveJournal \"moods\".")
272 (defvar lj-pickws nil
273 "A list of LJ userpic keywords.")
275 (defvar lj-default-pickw nil
276 "The default LJ userpic keyword.")
278 ;; See mpd.el in the same repo as lj.el
279 (defvar **mpd-var-Title* nil)
280 (defvar **mpd-var-Artist* nil)
281 (defun lj-music-mpd ()
282 "Return the current song title/artist from mpd."
283 (let ((song (if **mpd-var-Title*
284 (format "%s --- [%s]"
287 "The Sounds of Silence --- [Marcel Marceau]")))
290 (defcustom lj-music (and (featurep 'mpd) #'lj-music-mpd)
291 "*A function to retrieve current song for LJ music header.
292 This function should return a formatted string, or nil."
296 (defcustom lj-archive-posts nil
297 "*Keep an archive copy of LJ posts when non-nil."
301 (defcustom lj-archive-directory
302 (file-name-as-directory
303 (expand-file-name "archive" lj-directory))
304 "*Directory where LJ posts are archived."
308 (defcustom lj-bcc-address nil
309 "*Email address to send a copy of LJ posts to.
310 Set to nil to disable."
314 (defcustom lj-default-location nil
315 "*Default for the Location header."
319 (defcustom lj-before-preview-hook nil
320 "*Hook run before previewing a post."
324 (defcustom lj-after-preview-hook nil
325 "*Hook run as the last thing from `lj-preview'."
329 (defcustom lj-before-validate-hook nil
330 "*Hook run before validating a post."
334 (defcustom lj-after-validate-hook nil
335 "*Hook run as the last thing from `lj-validate'."
339 (defcustom lj-init-hook nil
340 "*Hook run before anything else is done when starting lj."
344 (defcustom lj-before-post-hook nil
345 "*Hook run before posting."
349 (defcustom lj-after-post-hook nil
350 "*Hook run after posting."
354 (defcustom lj-cut-hook nil
355 "*Hooks run after inserting an LJ-CUT."
359 (defcustom lj-poll-hook nil
360 "*Hooks run after inserting a LJ Poll."
364 (defcustom lj-journal-hook nil
365 "*Hooks run after inserting a LJ Journal link."
369 (defcustom lj-youtube-hook nil
370 "*Hooks run after inserting a youtube/google video."
374 (defcustom lj-twitter-flag nil
375 "*Non-nil means to update your twitter status.
377 The subject header and a URL to the last blog entry is posted to
378 twitter as a status update if this is set."
382 (defcustom lj-twitter-username (user-login-name)
383 "*Your twitter username."
387 (defcustom lj-twitter-password "secret"
388 "*Your twitter password."
392 (defconst lj-clientversion
393 (concat (when (featurep 'sxemacs) "S")
395 emacs-program-version
396 (format "/LJ: %.2f" lj-version))
397 "Client version string.")
399 (defconst lj-useragent
401 (when (featurep 'sxemacs) "S")
403 emacs-program-version
404 (format " [%s]:LJ-%.2f; steve@sxemacs.org)"
405 (if (featurep 'sxemacs)
409 "Useragent string sent to livejournal.com.")
411 (defconst lj-validate-header
412 "<?xml version=\"1.0\" encoding=\"utf-8\"?>
413 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
414 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
416 <html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
418 <title>LJ Post Preview</title>
420 <style type=\"text/css\">
422 background: rgb(204,204,255);
426 font-family: times new roman, verdana, helvetica, sans-serif;
431 background: rgb(255,235,205);
451 "Header used to construct HTML doc for previewing and validating LJ posts.")
453 (defconst lj-validate-footer
458 <!-- Leave this comment at the end of this file
460 sgml-validate-command:\"onsgmls -E0 -wall -wfully-tagged -wfully-declared -s %s %s\"
463 sgml-namecase-general:nil
464 sgml-general-insert-case:lower
465 sgml-minimize-attributes:nil
466 sgml-always-quote-attributes:t
469 sgml-parent-document:nil
470 sgml-exposed-tags:nil
471 sgml-local-catalogs:nil
472 sgml-local-ecat-files:nil
476 "Footer used to construct HTML doc for previewing and validating LJ posts.")
478 (defconst lj-base-url
479 "http://www.livejournal.com/interface/flat"
480 "The base URL where LJ posts are submitted etc.")
482 (defvar lj-last-entry-btime nil
483 "The date/time of the last posted entry as a big integer.")
485 (defun lj-parse-time-string (string)
486 "Parse a time STRING of the format \"YYYY-MM-DD HH:MM:SS\".
488 The seconds field can be ommitted and in that case 0 is used.
490 Returns a list suitable for passing to `encode-time' or `encode-btime'."
491 (let ((regexp (concat "^\\([12][0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-"
492 "\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?$")))
493 (if (string-match regexp string)
494 (let ((year (string-to-int (substring string
497 (month (string-to-int (substring string
500 (day (string-to-int (substring string
503 (hour (string-to-int (substring string
506 (min (string-to-int (substring string
509 (sec (if (eq (length string) 19)
510 (string-to-int (substring string (match-beginning 7)
513 (unless (and (>= year 1970)
515 (error 'invalid-argument year))
516 (unless (and (>= month 1)
518 (error 'invalid-argument month))
519 (unless (and (>= day 1)
521 (error 'invalid-argument day))
522 (unless (and (>= hour 0)
524 (error 'invalid-argument hour))
525 (unless (and (>= min 0)
527 (error 'invalid-argument min))
528 (unless (and (>= sec 0)
530 (error 'invalid-argument sec))
531 (list sec min hour day month year))
532 (error 'invalid-argument string))))
534 ;; Probably should set up a proper prefix
536 (let ((map (make-sparse-keymap)))
537 (set-keymap-name map 'lj-mode-map)
538 (define-key map [(control ?c) (control return)] #'lj-post)
539 (define-key map [(control ?c) ?F] #'lj-customise-faces)
540 (define-key map [(control ?c) ?G] #'lj-customise-group)
541 (define-key map [(control ?c) ?P] #'lj-insert-poll)
542 (define-key map [(control ?c) ?c] #'lj-cut-region)
543 (define-key map [(control ?c) ?j] #'lj-insert-journal)
544 (define-key map [(control ?c) ?p] #'lj-preview)
545 (define-key map [(control ?c) ?w] #'lj-writers-block)
546 (define-key map [(control ?c) ?y] #'lj-insert-youtube)
547 (define-key map [(control ?c) (control ?f) ?M] #'lj-goto-mood)
548 (define-key map [(control ?c) (control ?f) ?S] #'lj-goto-security)
549 (define-key map [(control ?c) (control ?f) ?b] #'lj-goto-bcc)
550 (define-key map [(control ?c) (control ?f) ?c] #'lj-goto-community)
551 (define-key map [(control ?c) (control ?f) ?f] #'lj-goto-fcc)
552 (define-key map [(control ?c) (control ?f) ?l] #'lj-goto-location)
553 (define-key map [(control ?c) (control ?f) ?m] #'lj-goto-music)
554 (define-key map [(control ?c) (control ?f) ?s] #'lj-goto-subject)
555 (define-key map [(control ?c) (control ?f) ?t] #'lj-goto-tags)
556 (define-key map [(control ?c) (control ?f) ?u] #'lj-goto-userpic)
557 (define-key map [(control ?c) (control ?b)] #'lj-goto-body)
558 (define-key map [(control meta ?v)] #'lj-validate)
559 (define-key map [tab] #'lj-sgml-indent-tab-or-complete)
560 (define-key map [iso-left-tab] #'lj-complete-header-backwards)
563 (defvar lj-header-separator "--text follows this line--"
564 "Text to denote the end of the headers and beginning of the message.")
566 ;; Faces (defaults are probably crap for a light background)
567 (defun lj-face-p (face)
568 "Call facep on FACE."
569 (facep (find-face face)))
571 (make-face 'lj-header-name "Face used for LJ headers.")
572 (set-face-parent 'lj-header-name (or (and (lj-face-p 'message-header-name)
573 'message-header-name)
574 (and (lj-face-p 'message-header-name-face)
575 'message-header-name-face)
578 (make-face 'lj-header-subject "Face used for LJ Subject header content.")
579 (set-face-parent 'lj-header-subject
580 (or (and (lj-face-p 'message-header-subject)
581 'message-header-subject)
582 (and (lj-face-p 'message-header-subject-face)
583 'message-header-subject-face)
586 (make-face 'lj-header-fcc "Face used for LJ FCC header content.")
587 (set-face-parent 'lj-header-fcc 'font-lock-comment-face)
588 (make-face 'lj-header-bcc "Face used for LJ BCC header content.")
589 (set-face-parent 'lj-header-bcc (or (and (lj-face-p 'message-header-cc)
591 (and (lj-face-p 'message-header-cc-face)
592 'message-header-cc-face)
595 (make-face 'lj-header-security "Face used for LJ Security header content.")
596 (set-face-parent 'lj-header-security 'font-lock-warning-face)
598 (make-face 'lj-header-music "Face used for LJ Music header content.")
599 (set-face-parent 'lj-header-music
600 (or (and (lj-face-p 'message-header-xheader)
601 'message-header-xheader)
602 (and (lj-face-p 'message-header-xheader-face)
603 'message-header-xheader-face)
604 'font-lock-builtin-face))
606 (make-face 'lj-header-mood "Face used for LJ Mood header content.")
607 (set-face-parent 'lj-header-mood
608 (or (and (lj-face-p 'message-header-other)
609 'message-header-other)
610 (and (lj-face-p 'message-header-other-face)
611 'message-header-other-face)
612 'font-lock-function-name-face))
614 (make-face 'lj-header-userpic "Face used for LJ Userpic header content.")
615 (set-face-parent 'lj-header-userpic
616 (or (and (lj-face-p 'message-header-other)
617 'message-header-other)
618 (and (lj-face-p 'message-header-other-face)
619 'message-header-other-face)
620 'font-lock-function-name-face))
622 (make-face 'lj-header-tags "Face used for LJ Tags header content.")
623 (set-face-parent 'lj-header-tags
624 (or (and (lj-face-p 'message-header-newsgroups)
625 'message-header-newsgroups)
626 (and (lj-face-p 'message-header-newsgroups-face)
627 'message-header-newsgroups-face)
628 'font-lock-keyword-face))
630 (make-face 'lj-header-community "Face used for LJ Community header content.")
631 (set-face-parent 'lj-header-community 'lj-header-userpic)
633 (make-face 'lj-header-location "Face used for LJ Location header content.")
634 (set-face-parent 'lj-header-location 'lj-header-userpic)
636 (make-face 'lj-separator "Face used for the LJ header separator.")
637 (copy-face 'bold 'lj-separator)
638 (set-face-foreground 'lj-separator "red")
640 ;; compatibility hoohar
641 (unless (featurep 'sxemacs)
642 (fset #'defregexp #'defvar))
644 (defun lj-utf-emacs-p ()
645 "Return non-nil if this S?XEmacs has utf-8 coding-system."
646 (and (featurep 'mule)
647 (declare-fboundp (find-coding-system 'utf-8))))
649 (defregexp lj-header-regexp
650 (let ((headers '("Subject" "FCC" "BCC" "Security" "Community"
651 "Location" "Mood" "Music" "Userpic" "Tags")))
652 (concat (regexp-opt headers t) ":"))
653 "Regular expression matching LJ headers.")
655 (defvar lj-font-lock-keywords
657 `((,lj-header-regexp 0 lj-header-name)
658 ("^Subject: \\(.*$\\)" 1 lj-header-subject)
659 ("^FCC: \\(.*$\\)" 1 lj-header-fcc)
660 ("^BCC: \\(.*$\\)" 1 lj-header-bcc)
661 ("^Security: \\(.*$\\)" 1 lj-header-security)
662 ("^Community: \\(.*$\\)" 1 lj-header-community)
663 ("^Music: \\(.*$\\)" 1 lj-header-music)
664 ("^Mood: \\(.*$\\)" 1 lj-header-mood)
665 ("^Location: \\(.*$\\)" 1 lj-header-location)
666 ("^Userpic: \\(.*$\\)" 1 lj-header-userpic)
667 ("^Tags: \\(.*$\\)" 1 lj-header-tags)
668 (,(regexp-quote lj-header-separator) 0 lj-separator))
669 hm--html-font-lock-keywords
670 html-font-lock-keywords)
671 "Font lock keywords for `lj-mode'.")
673 ;; kill/yank'd from jwz-lj.el
674 (defconst lj-entity-table
675 '(("iexcl" . ?\¡) ("cent" . ?\¢) ("pound" . ?\£) ("euro" . ?\~)
676 ("curren" . ?\¤) ("yen" . ?\¥) ("brvbar" . ?\¦) ("sect" . ?\§)
677 ("uml" . ?\¨) ("copy" . ?\©) ("ordf" . ?\ª) ("laquo" . ?\«)
678 ("not" . ?\¬) ("shy" . ?\) ("reg" . ?\®) ("macr" . ?\¯)
679 ("deg" . ?\°) ("plusmn" . ?\±) ("sup2" . ?\²) ("sup3" . ?\³)
680 ("acute" . ?\´) ("micro" . ?\µ) ("para" . ?\¶) ("middot" . ?\·)
681 ("cedil" . ?\¸) ("sup1" . ?\¹) ("ordm" . ?\º) ("raquo" . ?\»)
682 ("frac14" . ?\¼) ("frac12" . ?\½) ("frac34" . ?\¾) ("iquest" . ?\¿)
683 ("Agrave" . ?\À) ("Aacute" . ?\Á) ("Acirc" . ?\Â) ("Atilde" . ?\Ã)
684 ("Auml" . ?\Ä) ("Aring" . ?\Å) ("AElig" . ?\Æ) ("Ccedil" . ?\Ç)
685 ("Egrave" . ?\È) ("Eacute" . ?\É) ("Ecirc" . ?\Ê) ("Euml" . ?\Ë)
686 ("Igrave" . ?\Ì) ("Iacute" . ?\Í) ("Icirc" . ?\Î) ("Iuml" . ?\Ï)
687 ("ETH" . ?\Ð) ("Ntilde" . ?\Ñ) ("Ograve" . ?\Ò) ("Oacute" . ?\Ó)
688 ("Ocirc" . ?\Ô) ("Otilde" . ?\Õ) ("Ouml" . ?\Ö) ("times" . ?\×)
689 ("Oslash" . ?\Ø) ("Ugrave" . ?\Ù) ("Uacute" . ?\Ú) ("Ucirc" . ?\Û)
690 ("Uuml" . ?\Ü) ("Yacute" . ?\Ý) ("THORN" . ?\Þ) ("szlig" . ?\ß)
691 ("agrave" . ?\à) ("aacute" . ?\á) ("acirc" . ?\â) ("atilde" . ?\ã)
692 ("auml" . ?\ä) ("aring" . ?\å) ("aelig" . ?\æ) ("ccedil" . ?\ç)
693 ("egrave" . ?\è) ("eacute" . ?\é) ("ecirc" . ?\ê) ("euml" . ?\ë)
694 ("igrave" . ?\ì) ("iacute" . ?\í) ("icirc" . ?\î) ("iuml" . ?\ï)
695 ("eth" . ?\ð) ("ntilde" . ?\ñ) ("ograve" . ?\ò) ("oacute" . ?\ó)
696 ("ocirc" . ?\ô) ("otilde" . ?\õ) ("ouml" . ?\ö) ("divide" . ?\÷)
697 ("oslash" . ?\ø) ("ugrave" . ?\ù) ("uacute" . ?\ú) ("ucirc" . ?\û)
698 ("uuml" . ?\ü) ("yacute" . ?\ý) ("thorn" . ?\þ) ("yuml" . ?\ÿ)
700 "HTML entities to Latin1 characters.")
702 ;; adapted from jwz-lj.el
703 (defun lj-entify-region (beg end)
704 "Convert non-ASCII chars in the region BEG - END to HTML entities."
705 (let ((regex (if (featurep 'sxemacs)
707 ;; ho-hum, life would be simpler if XEmacs enabled
709 (concat "[" (mapconcat
711 (make-string 1 (cdr c)))
714 (case-fold-search nil))
717 (setq end (copy-marker end))
718 (while (re-search-forward regex end t)
719 (let* ((char (preceding-char))
720 (entity (or (car (rassq char lj-entity-table))
721 (error "No entity %c" char))))
723 (insert-before-markers "&" entity ";")))))
724 (and-fboundp #'charsets-in-region
725 (delq 'ascii (charsets-in-region beg end))
726 (error "Non-ASCII characters exist in this buffer")))
728 (defconst lj-unreserved-chars
729 '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
730 ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
731 ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M
732 ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
733 ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
734 ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
735 "A list of characters that are _NOT_ reserved in the URL spec.
736 This is taken from RFC 2396.")
738 (defun lj-hexify-string (str &optional http-entify)
739 "Escape characters STR so STR can be used in a URL.
741 With non-nil HTTP-ENTIFY, convert non-ASCII characters to HTTP
746 (lj-entify-region (point-min) (point-max)))
749 (if (not (memq char lj-unreserved-chars))
751 (format "%%0%X" char)
753 (error "Hexifying multibyte character %s" str))
754 (format "%%%X" char))
755 (char-to-string char)))
756 (buffer-string) "")))
758 (when-fboundp #'ffi-defun
760 (require 'ffi-sqlite)
761 (require 'ffi-curl)))
763 ;; adapted from jwz-lj.el
764 (defun lj-extract-sql-cookies (file chromep)
765 "Extract LJ cookie data from SQL cookies FILE.
767 Non-nil CHROMEP forces a Google Chrome compatible sql query."
768 (let ((sql (if chromep
769 ;; chrome sql cookies
770 (concat "SELECT name,value FROM cookies "
771 "WHERE host_key=\".www.livejournal.com\" "
772 "OR host_key=\".livejournal.com\"")
773 ;; mozilla based sql cookies
774 (concat "SELECT name,value FROM moz_cookies "
775 "WHERE host=\".www.livejournal.com\" "
776 "OR host=\".livejournal.com\""))))
777 (if (featurep 'ffi-sqlite)
778 ;; Try SXEmacs' sexy ffi-sqlite if it's available
779 (let* ((db (sqlite-open file))
780 (rows (sqlite-rows db sql)))
786 (concat (car c) "=" (cadr c)))
789 ;; The old fashioned way
790 (unless (executable-find "sqlite3")
791 (error "Can't find sqlite3"))
792 (let* ((sql (shell-command-to-string
793 (concat "sqlite3 " file "'" sql ";'")))
795 (split-string-by-char
796 (replace-regexp-in-string "\n" "|" sql) ?|)))
799 (push (cons (car slist) (cadr slist)) cookies)
800 (setq slist (cddr slist)))
805 (concat (car c) "=" (cdr c)))
806 (reverse cookies) "; ")
809 ;;; FIXME: redo this with #'xml-parse-file. Just as soon as I can get
810 ;; me grubby little hands on one of these xml cookie files.
811 ;; kill/yank'd from jwz-lj.el
812 ;;; FIXME: this will now be broken!
813 (defun lj-extract-xml-cookies (file)
814 "Extract LJ data from XML cookies FILE."
817 (narrow-to-region (point) (point))
818 (insert-file-contents file nil nil nil t)
819 (goto-char (point-min))
820 (search-forward "<dict>")
824 domain path name value)
825 (while (search-forward "</dict>" nil t)
829 ((search-forward "livejournal.com" end t) ; bail fast
832 (re-search-forward (concat "<key>Domain</key>[ \t\n\r]*"
833 "<string>\\([^<>]+\\)</string>")
835 (setq domain (match-string 1))
837 (re-search-forward (concat "<key>Path</key>[ \t\n\r]*"
838 "<string>\\([^<>]+\\)</string>")
840 (setq path (match-string 1))
842 (re-search-forward (concat "<key>Name</key>[ \t\n\r]*"
843 "<string>\\([^<>]+\\)</string>")
845 (setq name (match-string 1))
847 (re-search-forward (concat "<key>Value</key>[ \t\n\r]*"
848 "<string>\\([^<>]+\\)</string>")
850 (setq value (match-string 1))
851 (if (string-match "\\blivejournal\\.com$" domain)
853 (concat domain "\tTRUE\t" path "\tFALSE\t0\t"
858 (delete-region (point-min) (point-max))
862 (defun lj-extract-text-cookies (file)
863 "Extract LJ data from text based cookies FILE."
864 (let ((host-match "\\.livejournal\\.com$")
867 (insert-file-contents-literally file)
868 (goto-char (point-min))
870 (when (looking-at (concat "^\\([^\t\r\n]+\\)\t" ; 1 host
871 "\\([^\t\r\n]+\\)\t" ; 2 bool
872 "\\([^\t\r\n]+\\)\t" ; 3 path
873 "\\([^\t\r\n]+\\)\t" ; 4 bool
874 "\\([^\t\r\n]+\\)\t" ; 5 time_t
875 "\\([^\t\r\n]+\\)\t" ; 6 key
876 "\\([^\t\r\n]+\\)$")) ; 7 val
877 (let ((host (match-string 1))
878 (key (match-string 6))
879 (val (match-string 7)))
880 (when (and (string-match host-match host)
881 (not (assoc key cookies)))
882 (setq cookies (cons (cons key val) cookies))))
888 (concat (car c) "=" (cdr c)))
889 (nreverse cookies) "; ")
892 (defun lj-extract-w3-cookies ()
893 "Extract LJ cookie data from Emacs-W3 cookies."
894 (let* ((secure (and url-cookie-secure-storage t))
895 (w3cookies (remove-duplicates
896 (append (url-cookie-retrieve
897 "www.livejournal.com" "/" secure)
899 ".livejournal.com" "/" secure))
902 (replace-regexp-in-string
907 (unless (string-equal (url-cookie-name c) "HttpOnly")
908 (concat (url-cookie-name c) "=" (url-cookie-value c))))
909 (nreverse w3cookies) "; ")
912 ;; adapted from jwz-lj.el, but rewritten from scratch
913 (defun lj-get-cookies (flavour)
914 "Return a string of LJ cookie data suitable for HTTP POST'ing.
916 Argument FLAVOUR specifies which browser's cookies to check. If it is
917 the symbol `auto' \(the default\) all browsers will be searched in the
920 Google Chrome, Firefox, SeaMonkey, Mozilla, Galeon, Safari, Nescape,
921 Midori, and Emacs-W3 for cookie data."
926 (when (or (eq flavour 'chrome)
928 (let ((dir (paths-construct-path
929 '(".config" "google-chrome" "Default")
930 (user-home-directory))))
931 (and (file-exists-p (expand-file-name "Cookies" dir))
932 (setq cookies (lj-extract-sql-cookies
933 (expand-file-name "Cookies" dir) t))))
935 (throw 'found cookies)
936 (lj-get-cookies 'auto)))
938 ;; Firefox 1-3 (works for sqlite cookies, plain text cookies are
940 (when (or (eq flavour 'firefox)
942 (let ((d1 (paths-construct-path
943 '("Library" "Application Support" "Firefox" "Profiles")
944 (user-home-directory)))
945 (d2 (paths-construct-path
946 '(".mozilla" "firefox") (user-home-directory)))
948 (if (file-directory-p d1)
949 (setq dir (car (directory-files d1 t "\\.default$" nil 'dirs)))
950 (setq dir (car (directory-files d2 t "\\.default$" nil 'dirs))))
951 (or (and (file-exists-p (expand-file-name "cookies.txt" dir))
952 (setq cookies (lj-extract-text-cookies
953 (expand-file-name "cookies.txt" dir))))
954 (and (file-exists-p (expand-file-name "cookies.sqlite" dir))
955 (setq cookies (lj-extract-sql-cookies
956 (expand-file-name "cookies.sqlite" dir) nil)))))
958 (throw 'found cookies)
959 (lj-get-cookies 'auto)))
961 ;; SeaMonkey (untested)
962 (when (or (eq flavour 'seamonkey)
964 (when (file-directory-p (expand-file-name ".mozilla/seamonkey"
965 (user-home-directory)))
966 (let ((dir (car (directory-files "~/.mozilla/seamonkey"
967 t "\\.default$" nil 'dirs))))
968 (or (and (file-exists-p (expand-file-name "cookies.txt" dir))
969 (setq cookies (lj-extract-text-cookies
970 (expand-file-name "cookies.txt" dir))))
971 (and (file-exists-p (expand-file-name "cookies.sqlite" dir))
972 (setq cookies (lj-extract-sql-cookies
973 (expand-file-name "cookies.sqlite" dir) nil))))))
975 (throw 'found cookies)
976 (lj-get-cookies 'auto)))
978 ;; Mozilla (untested)
979 (when (or (eq flavour 'mozilla)
981 (when (file-directory-p (expand-file-name ".mozilla"
982 (user-home-directory)))
983 (let ((d1 (paths-construct-path '(".mozilla" "default")
984 (user-home-directory)))
985 (d2 (paths-construct-path `(".mozilla" ,(user-login-name))
986 (user-home-directory)))
988 (if (file-directory-p d1)
989 (setq dir (car (directory-files d1 t "\\.slt$" nil 'dirs)))
990 (setq dir (car (directory-files d2 t "\\.slt$" nil 'dirs))))
991 (and (file-exists-p (expand-file-name "cookies.txt" dir))
992 (setq cookies (lj-extract-text-cookies
993 (expand-file-name "cookies.txt" dir))))))
995 (throw 'found cookies)
996 (lj-get-cookies 'auto)))
999 (when (or (eq flavour 'galeon)
1001 (let ((dir (paths-construct-path
1002 '(".galeon" "mozilla" "galeon") (user-home-directory))))
1003 (and (file-exists-p (expand-file-name "cookies.txt" dir))
1004 (setq cookies (lj-extract-text-cookies
1005 (expand-file-name "cookies.txt" dir)))))
1007 (throw 'found cookies)
1008 (lj-get-cookies 'auto)))
1010 ;; Safari (untested)
1011 (when (or (eq flavour 'safari)
1013 (let ((dir (paths-construct-path '("Library" "Cookies")
1014 (user-home-directory))))
1015 (and (file-exists-p (expand-file-name "Cookies.plist" dir))
1016 (setq cookies (lj-extract-xml-cookies
1017 (expand-file-name "Cookies.plist" dir)))))
1019 (throw 'found cookies)
1020 (lj-get-cookies 'auto)))
1022 ;; Netscape (untested)
1023 (when (or (eq flavour 'netscape)
1025 (let ((dir (paths-construct-path '(".netscape")
1026 (user-home-directory))))
1027 (and (file-exists-p (expand-file-name "cookies" dir))
1028 (setq cookies (lj-extract-text-cookies
1029 (expand-file-name "cookies" dir)))))
1031 (throw 'found cookies)
1032 (lj-get-cookies 'auto)))
1034 ;; Midori (works, but Midori doesn't take too much care about
1035 ;; invalid or broken cookies so YMMV here)
1036 (when (or (eq flavour 'midori)
1038 (let ((dir (paths-construct-path '(".config" "midori")
1039 (user-home-directory))))
1040 (and (file-exists-p (expand-file-name "cookies.txt" dir))
1041 (setq cookies (lj-extract-text-cookies
1042 (expand-file-name "cookies.txt" dir)))))
1044 (throw 'found cookies)
1045 (lj-get-cookies 'auto)))
1047 ;; Emacs-W3 URL (works with W3 in XE packages)
1048 (when (or (eq flavour 'w3)
1050 (and (file-exists-p url-cookie-file)
1051 (setq cookies (lj-extract-w3-cookies)))
1053 (throw 'found cookies)
1054 (lj-get-cookies 'auto)))
1056 ;; Gah! no cookes anywhere!
1057 (error 'search-failed "LJ Cookie data"))))
1059 (defvar lj-cookies (lj-get-cookies lj-cookie-flavour)
1060 "Alist of cookie data to send to LJ.")
1062 ;; adapted from jwz-lj.el
1063 (defun lj-http-post (url cookies parser)
1064 "Sends a HTTP POST to URL with COOKIES.
1066 Argument PARSER is a function to handle parsing the output received."
1067 (unless (string-match "\\`https?://\\([^/]+\\)\\([^?&]+\\)\\?\\(.*\\)\\'" url)
1068 (error "Unparsable url: %s" url))
1069 (let* ((host (match-string 1 url))
1071 (path (match-string 2 url))
1072 (args (match-string 3 url))
1074 (concat "POST " path " HTTP/1.0\r\n"
1075 "Content-Type: application/x-www-form-urlencoded\r\n"
1076 "Content-Length: " (int-to-string (length args)) "\r\n"
1077 "Host: " host "\r\n"
1078 "X-LJ-Auth: cookie\r\n"
1082 (buf (generate-new-buffer " *LJ-process*"))
1084 (setq proc (open-network-stream "LiveJournal" buf host port))
1085 (when (lj-utf-emacs-p)
1086 (set-process-coding-system proc 'utf-8 'utf-8))
1087 (process-send-string proc post-cmd)
1088 (message "HTTP POST sent to %s" host)
1089 (while (eq (process-status proc) 'open)
1090 (unless (accept-process-output proc 60)
1091 (delete-process proc)
1092 (error "[LJ] Server error: timeout")))
1093 (funcall parser buf)))
1095 (defun lj-proc-success ()
1096 "Return t when LJ processes are successful.
1098 By \"successful\" we mean that livejournal.com didn't complain about
1099 anything we sent it."
1100 (let ((regex "^success\n\\(.*$\\)")
1103 (goto-char (point-min))
1104 (if (re-search-forward regex nil t)
1105 (setq result (match-string 1))
1106 (error "[LJ] Server error: try again later"))
1107 (cond ((string= result "OK")
1109 ((string= result "FAIL")
1110 (let ((ereg "^errmsg\n\\(.*$\\)"))
1112 (goto-char (point-min))
1113 (re-search-forward ereg)
1114 (if (string-match "Incorrect time value" (match-string 1))
1115 (lj-post 'out-of-order)
1116 (error "[LJ]: %s" (match-string 1))))))
1118 (error "[LJ]: Unknown error"))))))
1120 (defun lj-friends-proc-parser (buf)
1121 "Processes the output from `lj-get-friends-groups'.
1122 Argument BUF is the process buffer used."
1123 (let ((regexp "^frgrp_\\([0-9]+\\)_name\n\\(.*$\\)")
1125 (with-current-buffer buf
1126 (when (lj-proc-success)
1127 (goto-char (point-min))
1128 (while (re-search-forward regexp nil t)
1130 (cons (cons (match-string 2) (string-to-int (match-string 1)))
1134 (or (file-directory-p lj-directory)
1135 (make-directory-path lj-directory))
1136 (with-current-buffer (find-file-noselect lj-groups-file)
1138 (insert ";;; Automatically generated DO NOT EDIT -*- Emacs-Lisp -*-\n"
1139 (format "(setq lj-groups (quote %S))" groups))
1141 (eval-current-buffer nil)
1142 (kill-buffer nil))))))
1144 (defun lj-get-friends-groups ()
1145 "Retrieve an alist of groups/groupids from Livejournal."
1146 (let ((cookies (or lj-cookies
1147 (error "No LJ cookies found")))
1148 (url (concat lj-base-url
1149 "?mode=getfriendgroups"
1151 "&auth_method=cookie"
1152 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0)))))
1153 (lj-http-post url cookies #'lj-friends-proc-parser)))
1155 (defun lj-tags-proc-parser (buf)
1156 "Process the output from `lj-get-tags'.
1157 Argument BUF is the process buffer used."
1158 (let ((regexp "tag_[0-9]+_name\n\\(.*$\\)")
1160 (with-current-buffer buf
1161 (when (lj-proc-success)
1162 (goto-char (point-min))
1163 (while (re-search-forward regexp nil t)
1164 (push (match-string 1) tags))
1167 (or (file-directory-p lj-directory)
1168 (make-directory-path lj-directory))
1169 (with-current-buffer (find-file-noselect lj-tags-file)
1171 (insert ";;; Automatically generated DO NOT EDIT -*- Emacs-Lisp -*-\n"
1172 (format "(setq lj-tags (quote %S))" tags))
1174 (eval-current-buffer nil)
1175 (kill-buffer nil))))))
1177 (defun lj-get-tags ()
1178 "Retrieve a list of defined tags from Livejournal."
1179 (let ((cookies (or lj-cookies
1180 (error "No LJ cookies found")))
1181 (url (concat lj-base-url
1184 "&auth_method=cookie"
1185 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0)))))
1186 (lj-http-post url cookies #'lj-tags-proc-parser)))
1188 (defun lj-get-userpic-noffi (url file)
1189 "Download userpic from URL to FILE."
1190 (if (executable-find "curl")
1191 (shell-command (concat "curl " url " -so " file) nil)
1192 (error 'unimplemented "non-FFI leeching")))
1194 (defun lj-get-userpics ()
1195 "Leech your userpics from livejournal.com."
1196 (unless (file-directory-p lj-userpic-directory)
1197 (make-directory-path lj-userpic-directory))
1198 (let ((pics (mapcar #'car lj-pickws)))
1201 (unless (file-exists-p
1202 (expand-file-name p lj-userpic-directory))
1203 (let ((file (expand-file-name p lj-userpic-directory))
1204 (url (cdr (assoc p lj-pickws))))
1205 (if (featurep '(and sxemacs ffi-curl))
1206 (declare-fboundp (curl:download url file))
1207 (lj-get-userpic-noffi url file)))))
1210 (defun lj-pickws-proc-parser (buf)
1211 "Process the output from `lj-get-pickws'.
1212 Argument BUF is the process buffer used."
1213 (let ((msg "^message\n\\(.*$\\)")
1214 defaultk defaultu keywords)
1215 (with-current-buffer buf
1216 (when (lj-proc-success)
1217 (goto-char (point-min))
1219 (re-search-forward "defaultpicurl\n\\(.*$\\)")
1220 (setq defaultu (match-string 1))
1223 (re-search-forward (concat "^pickwurl_\\([0-9]+\\)\n"
1226 (goto-char (point-min))
1227 (re-search-forward (concat "^pickw_" defidx "\n\\(.*$\\)") nil t)
1228 (setq defaultk (match-string 1))
1229 (setq keywords (cons (cons defaultk defaultu) keywords))))
1231 (while (re-search-forward "^pickw_\\([0-9]+\\)\n\\(.*$\\)" nil t)
1232 (let* ((key (match-string 2))
1233 (url (save-excursion
1234 (goto-char (point-min))
1235 (and (re-search-forward
1237 (match-string 1) "\n\\(.*$\\)") nil t)
1238 (match-string 1)))))
1239 (unless (string= key defaultk)
1240 (setq keywords (cons (cons key url) keywords))))))
1241 (when (re-search-forward msg nil t)
1242 (pop-to-buffer (get-buffer-create "*LJ Message*"))
1243 (insert "Important Message From LiveJournal:\n"
1244 "==================================\n\n")
1245 (insert (match-string 1)))
1248 (or (file-directory-p lj-directory)
1249 (make-directory-path lj-directory))
1250 (with-current-buffer (find-file-noselect lj-pickws-file)
1252 (insert ";;; Automatically generated DO NOT EDIT -*- Emacs-Lisp -*-\n"
1253 (format "(setq lj-pickws (quote %S))" keywords))
1254 (insert (format "\n(setq lj-default-pickw %S)" defaultk))
1256 (eval-current-buffer nil)
1257 (kill-buffer nil))))
1260 (defun lj-get-pickws ()
1261 "Retieve an alist of userpic keyword/url pairs."
1262 (let ((cookies (or lj-cookies
1263 (error "No LJ cookies found")))
1264 (url (concat lj-base-url
1267 "&auth_method=cookie"
1268 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0))
1269 "&clientversion=" lj-clientversion
1271 "&getpickwurls=1")))
1272 (lj-http-post url cookies #'lj-pickws-proc-parser)))
1274 (defun lj-moods-proc-parser (buf)
1275 "Process the output from `lj-get-moods'.
1276 Argument BUF is the process buffer used."
1277 (let ((regexp "mood_[0-9]+_id\n\\(.*\\)\nmood_[0-9]+_name\n\\(.*\\)")
1278 (msg "^message\n\\(.*$\\)")
1280 (with-current-buffer buf
1281 (when (lj-proc-success)
1282 (goto-char (point-min))
1284 (while (re-search-forward regexp nil t)
1285 (setq moods (cons (cons (match-string 2)
1286 (string-to-int (match-string 1)))
1288 (when (re-search-forward msg nil t)
1289 (pop-to-buffer (get-buffer-create "*LJ Message*"))
1290 (insert "Important Message From LiveJournal:\n"
1291 "==================================\n\n")
1292 (insert (match-string 1)))
1294 (or (file-directory-p lj-directory)
1295 (make-directory-path lj-directory))
1296 (with-current-buffer (find-file-noselect lj-moods-file)
1298 (insert ";;; Automatically generated DO NOT EDIT -*- Emacs-Lisp -*-\n"
1299 (format "(setq lj-moods (quote %S))" moods))
1301 (eval-current-buffer nil)
1302 (kill-buffer nil)))))
1304 (defun lj-get-moods ()
1305 "Retieve an alist of mood/moodid pairs."
1306 (let ((cookies (or lj-cookies
1307 (error "No LJ cookies found")))
1308 (url (concat lj-base-url
1311 "&auth_method=cookie"
1312 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0))
1313 "&clientversion=" lj-clientversion
1315 (lj-http-post url cookies #'lj-moods-proc-parser)))
1317 (defvar lj-last-user-set-time nil)
1319 ;; adapted from jwz-lj.el
1320 (defun lj-construct-url (subject body user
1321 &optional security tags community
1322 auto-format no-comments mood location
1323 music pickw date backdated)
1324 "Construct a URL to use for posting to LiveJournal.
1326 Argument SUBJECT, a string, which is the title of the post.
1327 Argument BODY, a string, is the body of the post.
1328 Argument USER, a string, is the LJ userid to post as.
1330 Optional argument SECURITY, a string, is the security level this post
1331 will have. The default is `lj-default-security-level'.
1333 Optional argument TAGS, a string, which is a comma delimited list of
1334 tags to add to this post.
1336 Optional argument COMMUNITY, a string, which is the name of a LJ forum
1337 to send this post to instead of the user's blog.
1339 Optional argument AUTO-FORMAT, when non-nil request that the LJ server
1340 automatically formats the post. The default is nil, which means the
1341 post should NOT be auto formatted by LJ.
1343 Optional argument NO-COMMENTS, when non-nil means to turn off comments
1346 Optional argument MOOD, a string or an integer, is the post's \"mood\"
1347 header. If it is an integer, it is a \"mood id\" which is mapped to a
1350 Optional argument LOCATION, a string, free-form text describing your
1351 current location. Livejournal turns it into a search URL to google
1354 Optional argument MUSIC, a string, of the currently playing mp3/ogg.
1356 Optional argument PICKW, a string, of the userpic keyword to use. If
1357 omitted, your default LJ userpic will be used.
1359 Optional argument DATE, an internal time value as returned by
1360 `encode-time'. Used to set a date/time on a post, if omitted the
1361 current time is used.
1363 Optional boolean argument BACKDATED, causes the \"backdated\" flag to be
1364 set which will prevent the post from showing up on friends pages."
1365 (let* ((friends-mask nil)
1366 (tl (split-string-by-char
1367 (format-time-string "%Y,%m,%d,%H,%M"
1368 (or date (current-time))) ?,))
1374 (ctime (apply #'encode-btime (lj-parse-time-string
1375 (format "%s-%s-%s %s:%s"
1376 year month day hour minute))))
1377 (ltime (or lj-last-entry-btime (and (lj-get-last-entry-btime)
1378 lj-last-entry-btime)))
1380 ;; save custom date in case something goes wrong
1382 (setq lj-last-user-set-time date)
1383 (setq lj-last-user-set-time nil))
1384 (setq subject (lj-hexify-string subject t))
1385 (setq body (lj-hexify-string body t))
1387 (if (not (string-match "p\\(ublic\\|rivate\\)" security))
1388 (if (string= "usemask" security)
1389 (setq friends-mask 1)
1390 (let* ((groups (or lj-groups (lj-get-friends-groups)))
1391 (id (cdr (assoc security groups))))
1393 (setq security "usemask"
1394 friends-mask (lsh 1 id))
1395 (error "Unknown friends group: %s" security)))))
1396 (setq security (lj-hexify-string security t))
1398 (if (> (length tags) 0)
1399 (setq tags (lj-hexify-string tags t))
1402 (cond ((cdr (assoc mood lj-moods))
1403 (setq mood (cdr (assoc mood lj-moods))))
1404 ((and (stringp mood)
1405 (> (length mood) 0))
1406 (setq mood (lj-hexify-string mood t)))
1407 ((integerp mood) nil)
1411 (if (> (length music) 0)
1412 (setq music (lj-hexify-string music t))
1415 (if (> (length pickw) 0)
1416 (setq pickw (lj-hexify-string pickw t))
1419 (if (> (length community) 0)
1420 (setq community (lj-hexify-string community t))
1421 (setq community nil))
1423 (if (> (length location) 0)
1424 (setq location (lj-hexify-string location t))
1425 (setq location nil))
1426 ;; maybe force opt_backdated
1427 (when (> ltime ctime)
1434 "&auth_method=cookie"
1435 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0))
1437 "&security=" security
1439 (format "&allowmask=%d" friends-mask))
1441 (format "&prop_taglist=%s" tags))
1443 (format "&usejournal=%s" community))
1451 (format "&prop_current_moodid=%d" mood)
1452 (format "&prop_current_mood=%s" mood)))
1454 (format "&prop_current_music=%s" music))
1456 (format "&prop_current_location=%s" location))
1458 (format "&prop_picture_keyword=%s" pickw))
1459 (unless (zerop lj-qotd)
1460 (format "&prop_qotdid=%d" lj-qotd))
1461 "&prop_opt_backdated=" (if backdated "1" "0")
1462 "&prop_opt_preformatted=" (if auto-format "0" "1")
1463 "&prop_opt_nocomments=" (if no-comments "1" "0")
1464 "&prop_useragent=" (lj-hexify-string lj-useragent)
1468 (defun lj-cut-toggle-top ()
1469 "Toggle view of LJ CUT text."
1472 (goto-char (point-at-eol))
1474 (set-extent-property
1475 (extent-at (point) nil 'ljcut)
1476 'invisible (not (extent-property
1477 (extent-at (point) nil 'ljcut) 'invisible)))))
1480 (defun lj-cut-mouse-toggle-top (event)
1481 "Toggle view of LJ CUT text under EVENT."
1483 (let ((epoint (event-point event)))
1486 (goto-char (point-at-eol))
1488 (set-extent-property
1489 (extent-at (point) nil 'ljcut)
1490 'invisible (not (extent-property
1491 (extent-at (point) nil 'ljcut) 'invisible))))))
1493 (defun lj-cut-toggle-bottom ()
1494 "Toggle view of LJ CUT text."
1497 (goto-char (point-at-bol))
1499 (set-extent-property
1500 (extent-at (point) nil 'ljcut)
1501 'invisible (not (extent-property
1502 (extent-at (point) nil 'ljcut) 'invisible)))))
1504 (defun lj-cut-mouse-toggle-bottom (event)
1505 "Toggle view of LJ CUT text under EVENT."
1507 (let ((epoint (event-point event)))
1510 (goto-char (point-at-bol))
1512 (set-extent-property
1513 (extent-at (point) nil 'ljcut)
1514 'invisible (not (extent-property
1515 (extent-at (point) nil 'ljcut) 'invisible))))))
1517 (defvar lj-cut-keymap-top
1518 (let ((map (make-sparse-keymap)))
1519 (set-keymap-name map 'lj-cut-keymap-top)
1520 (define-key map [return] #'lj-cut-toggle-top)
1521 (define-key map [button2] #'lj-cut-mouse-toggle-top)
1523 "Keymap for LJ CUT extents.")
1525 (defvar lj-cut-keymap-bottom
1526 (let ((map (make-sparse-keymap)))
1527 (set-keymap-name map 'lj-cut-keymap-bottom)
1528 (define-key map [return] #'lj-cut-toggle-bottom)
1529 (define-key map [button2] #'lj-cut-mouse-toggle-bottom)
1531 "Keymap for LJ CUT extents.")
1533 (defun lj-cut-region (b e)
1534 "Mark text in the region B to E as an LJ CUT.
1536 The text that is to be hidden behind the LJ CUT is made invisible in
1537 the buffer. The visibility can be toggled with Return or Button2 on
1538 either of the lj-cut delimiters."
1540 (let ((echo "Ret / Button2 Toggle View")
1543 (narrow-to-region b e)
1544 (lj-text-to-html (point-min) (point-max))
1545 (set-extent-properties
1546 (setq ext (make-extent (point-min) (point-max)))
1547 '(start-open t end-open t invisible t ljcut t))
1548 (goto-char (point-min))
1549 (set-extent-properties
1550 (insert-face "<lj-cut text=\"---More---\">" 'widget-button-face)
1553 keymap ,lj-cut-keymap-top
1554 mouse-face font-lock-warning-face))
1556 (goto-char (point-max))
1557 (set-extent-properties
1558 (insert-face "</lj-cut>" 'widget-button-face)
1561 keymap ,lj-cut-keymap-bottom
1562 mouse-face font-lock-warning-face))
1564 (set-extent-properties
1566 '(start-open nil end-open nil))
1567 (run-hooks 'lj-cut-hook)))
1569 (defvar lj-poll-types '("radio" "check" "drop" "text" "scale")
1572 (defun lj-insert-poll (name type question)
1573 "Insert a poll into a LJ post.
1574 Argument NAME is the title of the poll.
1575 Argument TYPE is the type of poll \(see `lj-poll-types'\).
1576 Argument QUESTION is the poll question, or \"topic\"."
1578 (list (read-string "Poll Title: " nil nil "unnamed poll")
1579 (completing-read "Poll Type (default \"radio\"): "
1580 (mapcar #'list lj-poll-types)
1581 nil t nil nil "radio")
1582 (read-string "Poll Question: ")))
1583 (let ((voters (completing-read "Who can vote (default \"all\"): "
1584 (mapcar #'list '("all" "friends"))
1585 nil t nil nil "all"))
1586 (viewers (completing-read "Who can view results (default \"all\"): "
1587 (mapcar #'list '("all" "friends" "none"))
1588 nil t nil nil "all"))
1591 (format "\n<lj-poll name=\"%s\" whovote=\"%s\" whoview=\"%s\">"
1592 name voters viewers)
1593 (format "\n<lj-pq type=\"%s\"" type))
1595 ((string= "scale" type)
1596 (let ((low (read-number "Scale low mark (int): " t "1"))
1597 (high (read-number "Scale high mark (int): " t "10"))
1598 (step (read-number "Stepping: " t "1")))
1599 (insert (format " from=\"%d\" to=\"%d\" by=\"%d\">"
1601 (format "\n%s" question))))
1602 ((string= "text" type)
1603 (let* ((size (read-number "Text box size: " t "50"))
1604 (max (read-number "Max answer length: " t
1605 (number-to-string (1- size)))))
1606 (insert (format " size=\"%d\" maxlength=\"%d\">" size max)
1607 (format "\n%s" question))))
1608 (t (insert (format ">\n%s" question))))
1609 (unless (string-match "scale\\|text" type)
1611 (while (not (zerop (length x)))
1612 (setq x (read-string "Poll Answer (RET to finish): "))
1613 (or (zerop (length x))
1614 (insert (format "\n<lj-pi>%s</lj-pi>" x))))))
1615 (insert "\n</lj-pq>"
1617 (indent-region p (point) nil)
1618 (run-hooks 'lj-poll-hook)))
1620 ;; Apparantly the _VALID_ markup that this function produces causes
1621 ;; some (all?) versions of M$ Internet Exploiter to buffer the entire
1622 ;; movie before beginning playback. Hey, lets call it a FEATURE!
1623 (defun lj-insert-youtube (url)
1624 "Insert a Google or Youtube video URL into a LJ post."
1625 (interactive "sVideo URL: ")
1626 (let* ((googlep (string-match "^http://video\\.google\\.com/.*$" url))
1627 (youtubep (string-match "^http://\\(www\\.\\)?youtube\\.com/.*$" url))
1628 (w (if googlep 420 400))
1629 (h (if googlep 352 338))
1631 (unless (or googlep youtubep)
1632 (error "Invalid Google/Youtube URL: %s" url))
1633 (insert (format "\n<object width=\"%d\" height=\"%d\"" w h)
1634 "\ntype=\"application/x-shockwave-flash\"")
1636 (setq url (replace-regexp-in-string "/videoplay\\?"
1637 "/googleplayer.swf?" url))
1638 (setq url (replace-regexp-in-string "\\(/watch\\)?\\?v=" "/v/" url)))
1639 (setq url (replace-regexp-in-string "&.*$" "" url))
1640 (insert (format "\ndata=\"%s\">" url)
1641 "\n<param name=\"movie\""
1642 (format "\nvalue=\"%s\" />" url)
1644 (indent-region p (point) nil)
1645 (run-hooks 'lj-youtube-hook)))
1647 (defun lj-insert-journal (name &optional community)
1648 "Insert a link to NAME journal or LJ community into an LJ post.
1650 Optional prefix argument, COMMUNITY means the link is to a LJ community
1651 instead of a LJ user's journal."
1652 (interactive "sUser or Community name: \nP")
1653 (let ((type (if current-prefix-arg "comm" "user"))
1655 (insert (format "\n<lj %s=\"%s\" />\n" type name))
1656 (indent-region p (point) nil)
1657 (run-hooks 'lj-journal-hook)))
1659 (defvar lj-abbrev-table nil
1660 "Abbrev table to use in `lj-mode'.")
1661 (define-abbrev-table 'lj-abbrev-table ())
1663 (define-derived-mode lj-mode html-mode "LJ"
1664 "This is a mode for composing LiveJournal posts.
1665 Its parent modes are `html-mode' and `sgml-mode' so everything you
1666 need to construct good clean HTML should be right at your fingertips.
1668 LJ specific bindings:
1670 \\[lj-post]\tSubmit post to LiveJournal
1671 \\[lj-preview]\t\tPreview post in web browser
1672 \\[lj-validate]\t\tValidate the markup in the post
1674 \\[lj-writers-block]\t\tAnswer a LJ \"Writer's Block\" question
1676 \\[lj-cut-region]\t\tHide text behind a LJ \"cut\"
1677 \\[lj-insert-journal]\t\tInsert a journal link
1678 \\[lj-insert-poll]\t\tInsert a poll
1679 \\[lj-insert-youtube]\t\tInsert a Google or YouTube Video
1681 \\[lj-goto-subject]\tMove to the Subject header
1682 \\[lj-goto-fcc]\tMove to the FCC header
1683 \\[lj-goto-bcc]\tMove to the BCC header
1684 \\[lj-goto-community]\tMove to the Community header
1685 \\[lj-goto-music]\tMove to the Music header
1686 \\[lj-goto-security]\tMove to the Security header
1687 \\[lj-goto-mood]\tMove to the Mood header
1688 \\[lj-goto-location]\tMove to the Location header
1689 \\[lj-goto-userpic]\tMove to the Userpic header
1690 \\[lj-goto-tags]\tMove to the Tags header
1691 \\[lj-goto-body]\tMove to the post body
1693 \\[lj-customise-faces]\t\tSet the header faces
1694 \\[lj-customise-group]\t\tSet the user options
1701 :abbrev-table 'lj-abbrev-table
1704 (add-hook 'lj-mode-hook #'font-lock-mode)
1706 (defun lj-make-archive-name ()
1707 "Compute a filename for archiving LJ posts.
1709 The filenames are of the format... `ljp-YYYYMMDDHHMM'."
1710 (let ((file (format-time-string "ljp-%Y%m%d%H%M"))
1711 (dir lj-archive-directory))
1712 (expand-file-name file dir)))
1714 (defun lj-generate-new-buffer ()
1715 "Create a new buffer for writing a new LJ post."
1716 (or (file-directory-p lj-drafts-directory)
1717 (make-directory-path lj-drafts-directory))
1720 (expand-file-name (format-time-string "ljd-%Y%m%d%H%M")
1721 lj-drafts-directory)))
1722 (rename-buffer "*LJ-Post*" 'unique)
1723 (when (lj-utf-emacs-p)
1724 (set-buffer-file-coding-system 'utf-8))
1726 (make-extent (point-min) (point-at-eol))
1727 (insert "Subject: \n")
1728 (when lj-archive-posts
1729 (or (file-directory-p lj-archive-directory)
1730 (make-directory-path lj-archive-directory))
1731 (insert (format "FCC: %s\n" (lj-make-archive-name))))
1732 (when (stringp lj-bcc-address)
1733 (insert (format "BCC: %s\n" lj-bcc-address)))
1734 (insert (format "Security: %s\n" lj-default-security-level))
1735 (when (stringp lj-default-location)
1736 (insert (format "Location: %s\n" lj-default-location)))
1737 (when (functionp (symbol-value 'lj-music))
1738 (insert (format "Music: %s\n" (funcall lj-music))))
1740 (when-boundp 'lj-default-pickw
1741 (insert (format "Userpic: %s\n" lj-default-pickw))
1742 (lj-update-userpic-glyph (expand-file-name lj-default-pickw
1743 lj-userpic-directory)))
1746 (set-extent-property
1747 (insert-face "</head>\n" 'default) 'invisible t)
1748 (insert lj-header-separator "\n")
1751 (defun lj-goto-subject (&optional nocreate)
1752 "Move to the Subject header of an LJ post buffer.
1754 The header is created if it doesn't exist, unless optional argument
1755 NOCREATE is non-nil."
1757 (goto-char (point-min))
1758 (or (re-search-forward "^Subject: " nil 'missing)
1760 (goto-char (point-min))
1761 (insert "Subject: ")
1762 (backward-char 1))))
1764 (defun lj-goto-fcc (&optional nocreate)
1765 "Move to the FCC header of an LJ post buffer.
1767 The header is created if it doesn't exist, unless optional argument
1768 NOCREATE is non-nil."
1770 (goto-char (point-min))
1771 (or (re-search-forward "^FCC: " nil 'missing)
1773 (goto-char (point-min))
1775 (backward-char 1))))
1777 (defun lj-goto-bcc (&optional nocreate)
1778 "Move to the BCC header of an LJ post buffer.
1780 The header is created if it doesn't exist, unless optional argument
1781 NOCREATE is non-nil."
1783 (goto-char (point-min))
1784 (or (re-search-forward "^BCC: " nil 'missing)
1786 (goto-char (point-min))
1788 (backward-char 1))))
1790 (defun lj-goto-security (&optional nocreate)
1791 "Move to the Security header of an LJ post buffer.
1793 The header is created if it doesn't exist, unless optional argument
1794 NOCREATE is non-nil."
1796 (goto-char (point-min))
1797 (or (re-search-forward "^Security: " nil 'missing)
1799 (goto-char (point-min))
1800 (insert "Security: \n")
1801 (backward-char 1))))
1803 (defun lj-goto-community (&optional nocreate)
1804 "Move to the Community header of an LJ post buffer.
1806 The header is created if it doesn't exist, unless optional argument
1807 NOCREATE is non-nil."
1809 (goto-char (point-min))
1810 (or (re-search-forward "^Community: " nil 'missing)
1812 (goto-char (point-min))
1813 (insert "Community: \n")
1814 (backward-char 1))))
1816 (defun lj-goto-location (&optional nocreate)
1817 "Move to the Location header of an LJ post buffer.
1819 The header is created if it doesn't exist, unless optional argument
1820 NOCREATE is non-nil."
1822 (goto-char (point-min))
1823 (or (re-search-forward "^Location: " nil 'missing)
1825 (goto-char (point-min))
1826 (insert "Location: \n")
1827 (backward-char 1))))
1829 (defun lj-goto-mood (&optional nocreate)
1830 "Move to the Mood header of an LJ post buffer.
1832 The header is created if it doesn't exist, unless optional argument
1833 NOCREATE is non-nil."
1835 (goto-char (point-min))
1836 (or (re-search-forward "^Mood: " nil 'missing)
1838 (goto-char (point-min))
1840 (backward-char 1))))
1842 (defun lj-goto-music (&optional nocreate)
1843 "Move to the Music header of an LJ post buffer.
1845 The header is created if it doesn't exist, unless optional argument
1846 NOCREATE is non-nil."
1848 (goto-char (point-min))
1849 (or (re-search-forward "^Music: " nil 'missing)
1851 (goto-char (point-min))
1852 (insert "Music: \n")
1853 (backward-char 1))))
1855 (defun lj-goto-userpic (&optional nocreate)
1856 "Move to the Userpic header of an LJ post buffer.
1858 The header is created if it doesn't exist, unless optional argument
1859 NOCREATE is non-nil."
1861 (goto-char (point-min))
1862 (or (re-search-forward "^Userpic: " nil 'missing)
1864 (goto-char (point-min))
1865 (insert "Userpic: \n")
1866 (backward-char 1))))
1868 (defun lj-goto-tags (&optional nocreate)
1869 "Move to the Tags header of an LJ post buffer.
1870 The header is created if it doesn't exist unless NOCREATE is non-nil."
1872 (goto-char (point-min))
1873 (or (re-search-forward "^Tags: " nil 'missing)
1875 (goto-char (point-min))
1877 (backward-char 1))))
1879 (defun lj-goto-body ()
1880 "Move to the body of an LJ post buffer."
1882 (goto-char (point-min))
1883 (re-search-forward (regexp-quote lj-header-separator) nil t)
1885 (goto-char (point-at-bol)))
1887 (defun lj-current-header ()
1888 "Return the name of the LJ header on the current line, or nil."
1889 (let ((hregex lj-header-regexp)
1890 (separator (regexp-quote lj-header-separator)))
1891 (if (save-excursion (re-search-forward separator nil t))
1893 (narrow-to-region (point-at-bol) (point-at-eol))
1894 (string-match hregex (buffer-string))
1895 (substring (buffer-string) (match-beginning 1) (match-end 1)))
1898 (defun lj-header-content (header)
1899 "Return the content of HEADER as a string."
1900 (let ((goto (intern-soft (concat "lj-goto-" (downcase header)))))
1902 (funcall goto 'nocreate)
1903 (buffer-substring-no-properties (point) (point-at-eol)))))
1905 (defun lj-update-userpic-glyph (glyph)
1906 "Update the userpic, GLYPH, displayed in the LJ-Post buffer."
1907 (let ((ext (extent-at (point-min)))
1908 (type (if (featurep '(and sxemacs ffi-magic))
1909 (downcase (car (split-string-by-char
1911 (magic:file-type glyph)) ?\ )))
1913 (cadr (split-string-by-char
1914 (shell-command-to-string (concat "file " glyph))
1916 (set-extent-begin-glyph
1918 (list (vector (intern-soft type)
1919 :data (with-temp-buffer
1920 (insert-file-contents-literally glyph)
1921 (buffer-string))))))))
1923 ;; Header completion
1924 (defvar lj-completion-time 3
1925 "Time in seconds before completion list is reset.")
1927 (defvar lj-completion-timer (make-itimer)
1928 "Completion timer.")
1930 (defvar lj-completion-list nil
1933 (defvar lj-header-syntax-table
1934 (let ((table (copy-syntax-table text-mode-syntax-table)))
1935 (modify-syntax-entry ?~ "w " table)
1936 (modify-syntax-entry ?` "w " table)
1937 (modify-syntax-entry ?- "w " table)
1938 (modify-syntax-entry ?_ "w " table)
1939 (modify-syntax-entry ?+ "w " table)
1940 (modify-syntax-entry ?{ "w " table)
1941 (modify-syntax-entry ?[ "w " table)
1942 (modify-syntax-entry ?} "w " table)
1943 (modify-syntax-entry ?] "w " table)
1944 (modify-syntax-entry ?\\ "w " table)
1945 (modify-syntax-entry ?| "w " table)
1946 (modify-syntax-entry ?\; "w " table)
1947 (modify-syntax-entry ?' "w " table)
1948 (modify-syntax-entry ?< "w " table)
1949 (modify-syntax-entry ?> "w " table)
1950 (modify-syntax-entry ?# "w " table)
1951 (modify-syntax-entry ?\ "w " table)
1952 (modify-syntax-entry ?. "w " table)
1954 "Syntax table used in funky header cycling completion.")
1956 (defun lj-init-completion-timer ()
1957 "Initialise the completion timer."
1958 (let ((timer lj-completion-timer))
1959 (set-itimer-function timer #'(lambda ()
1960 (setq lj-completion-list nil)))
1961 (set-itimer-value timer lj-completion-time)))
1962 (add-hook 'lj-init-hook #'lj-init-completion-timer)
1964 (defsubst lj-cycle-list (list &optional reverse)
1965 "Return a list of head of LIST, and LIST rotated 1 place forward.
1967 If optional argument, REVERSE is non-nil, rotate the list in the other
1969 (if (featurep 'sxemacs)
1970 (let ((list (apply #'dllist list))
1973 (dllist-rrotate list)
1974 (dllist-lrotate list))
1975 (setq name (dllist-car list))
1976 (list name (dllist-to-list list)))
1979 (let* ((name (car (last list)))
1980 (l1 (cdr (reverse list)))
1984 (let* ((name (cadr list))
1987 (list (append list (list oldcar))))
1988 (list name list)))))
1990 (defsubst lj-set-completion-timer ()
1991 "(Re)set completion timer's value."
1992 (let ((timer lj-completion-timer))
1993 (and (itimerp timer)
1994 (set-itimer-value timer lj-completion-time))))
1996 (defun lj-complete-header-backwards ()
1997 "Complete header, cycling backwards."
1999 (and (lj-current-header)
2000 (lj-complete-header 'reverse)
2001 (when (string-match (lj-current-header) "Userpic")
2002 (when (file-exists-p (expand-file-name
2003 (lj-header-content "userpic")
2004 lj-userpic-directory))
2005 (lj-update-userpic-glyph
2006 (expand-file-name (lj-header-content "userpic")
2007 lj-userpic-directory))))))
2009 (defun lj-complete-header (&optional reverse)
2010 "Completion for LJ headers.
2012 This completion does not pop up any completion buffers, instead it
2013 cycles through the possible completions \"in-place\" with each
2016 With non-nil optional argument, REVERSE, the cycling goes in the other
2019 (unless lj-completion-list
2020 (unless (itimer-live-p lj-completion-timer)
2021 (lj-set-completion-timer)
2022 (activate-itimer lj-completion-timer))
2023 (let* ((completion-ignore-case t)
2024 (type (lj-current-header))
2025 (table (cond ((string= type "Security")
2026 (let ((groups (copy-sequence
2030 ("usemask" . ?c))))))
2031 (sort* groups #'string-lessp :key #'car)))
2032 ((string= type "Mood")
2033 (let ((moods (copy-sequence lj-moods)))
2034 (sort* moods #'string-lessp :key #'car)))
2035 ((string= type "Userpic")
2036 (let ((pics (copy-sequence lj-pickws)))
2037 (sort* pics #'string-lessp :key #'car)))
2038 ((string= type "Tags")
2039 (let ((tags (mapcar #'(lambda (e) (cons e ?a))
2041 (sort* tags #'string-lessp :key #'car)))
2042 (t (error 'invalid-argument type))))
2043 (current (if (string-match (current-word) type)
2046 (completion (try-completion current table))
2047 (all (all-completions current table)))
2048 (if (null completion)
2049 (message "Can't find completion for \"%s\"" current)
2050 (setq lj-completion-list all))))
2051 (when lj-completion-list
2052 (multiple-value-bind (completion newlist)
2053 (lj-cycle-list lj-completion-list reverse)
2054 (setq lj-completion-list newlist)
2055 (with-syntax-table lj-header-syntax-table
2056 (unless (string= "" (current-word))
2059 (unless (string-match (lj-current-header) (current-word))
2060 (backward-delete-word)))
2061 (insert " " completion)))
2062 (lj-set-completion-timer)))
2064 (defun lj-sgml-indent-tab-or-complete (&optional refresh)
2065 "Does completion if in LJ headers, `sgml-indent-or-tab' otherwise.
2067 If point is after the header separator, this function simply calls
2068 `sgml-indent-or-tab'. If point is in the headers section it will do
2069 completion relevent to the header on the current line.
2071 Please note that this is \"inline\" completion, that means you won't
2072 be prompted for anything in the minibuffer. The completions will
2073 cycle directly in the LJ-post buffer.
2075 The different header completions are:
2077 Subject: Sweet bugger all. Sorry, haven't perfected read-mind-mode
2080 FCC: Computes a new archive filename.
2082 BCC: BBDB email addresses
2084 Security: Completes valid security levels. With prefix arg REFRESH,
2085 update your list of friends groups from livejournal.com
2087 Community: No completion, just insert a TAB.
2089 Music: Refreshes to the currently current song
2091 Mood: Completes moods. With prefix arg REFRESH, update the list
2092 of moods from livejournal.com.
2094 Location: No completion.
2096 Userpic: Completes list of LJ userpic keywords you have defined.
2097 With prefix arg REFRESH, update you list of userpic
2100 Tags: Multiple completion from your list of previously used tags.
2101 With prefix arg REFRESH, update your list of tags from
2104 (let ((header (lj-current-header)))
2106 (cond ((string= header "Subject")
2107 (error "Sorry, me crystal ball is in for repairs"))
2108 ((string= header "FCC")
2109 (let ((new (lj-make-archive-name)))
2110 (goto-char (point-at-bol))
2111 (re-search-forward "^FCC: " (point-at-eol))
2112 (delete-region (point) (point-at-eol))
2114 ((string= header "BCC")
2115 (if-fboundp #'bbdb-complete-name
2117 (goto-char (point-at-eol))
2118 (bbdb-complete-name))
2120 ((string= header "Security")
2121 (when (or refresh (not lj-groups))
2122 (lj-get-friends-groups))
2123 (goto-char (point-at-bol))
2124 (re-search-forward "^Security: " (point-at-eol))
2125 (lj-complete-header))
2126 ((string= header "Community")
2127 (goto-char (point-at-eol))
2129 ((string= header "Music")
2130 (let ((current (and (functionp (symbol-value 'lj-music))
2131 (funcall lj-music))))
2133 (goto-char (point-at-bol))
2134 (re-search-forward "^Music: " (point-at-eol))
2135 (delete-region (point) (point-at-eol))
2137 ((string= header "Mood")
2138 (when (or refresh (not lj-moods))
2140 (goto-char (point-at-bol))
2141 (re-search-forward "^Mood: " (point-at-eol))
2142 (lj-complete-header))
2143 ((string= header "Location")
2144 (error "If you don't know, I can't help you"))
2145 ((string= header "Userpic")
2146 (when (or refresh (not lj-pickws))
2148 (goto-char (point-at-bol))
2149 (re-search-forward "^Userpic: " (point-at-eol))
2150 (lj-complete-header)
2151 (when (file-exists-p (expand-file-name
2152 (lj-header-content "userpic")
2153 lj-userpic-directory))
2154 (lj-update-userpic-glyph
2155 (expand-file-name (lj-header-content "userpic")
2156 lj-userpic-directory))))
2157 ((string= header "Tags")
2158 (when (or refresh (not lj-tags))
2160 (lj-complete-header))
2162 (error "Unknown LJ header: %s" header)))
2163 (sgml-indent-or-tab))))
2165 (defregexp lj-url-regexp
2166 (concat "\\(https?://\\|s?ftp://\\|gopher://\\|telnet://"
2167 "\\|wais://\\|file:/\\|s?news:\\)"
2168 "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;\\(>\\)]+")
2169 "A regular expression matching URL's.")
2171 (defregexp lj-email-regexp
2172 "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
2173 "A regular expression matching email addresses.")
2175 (defun lj-text-to-html (beg end &optional nopbr)
2176 "Convert the plain text in the region BEG - END to html.
2178 With optional argument, NOPBR, don't add <p>..</p> or <br /> tags.
2180 This is an extremely basic converter. All it really does is wrap
2181 paragraphs in <p>...</p>, and add <br /> to the end of each non-blank
2182 line. It will also convert old 70's style text highlighting to the
2183 HTML equivalent. e.g. _text_ -> <u>text</u>, *text* -> <b>text</b>.
2184 It also converts non-ASCII to HTML entities, and converts URL's and
2185 email addresses to hyperlinks. Email addresses are obfuscated in an
2186 attempt to protect against spam harvesters.
2188 Apart from the bold, underline, and hyperlink stuff, that's all the
2189 eye-candy you'll get. Forget fonts, colours, tables, and lists.
2190 That's not what this is about. The idea is to keep the text as close
2191 to \"as-is\" without resorting to using <pre>...</pre> tags.
2193 Calling this function on text that contains \"<lj*>\" will break those
2194 tags. So take note of what you are doing."
2195 (let ((replacements '(("&" . "&")
2196 ("\\.\\.\\." . "…")
2200 ("_\\(.*\\)_" . "<u>\\1</u>")
2201 ("\\*\\(.*\\)\\*" . "<b>\\1</b>")))
2203 (email lj-email-regexp))
2205 (add-to-list 'replacements
2206 (cons (if (featurep 'sxemacs)
2207 "\\([[:alnum:][:punct:]]\\)\n"
2208 "\\([a-zA-Z0-9]\\|\\s.\\)\n")
2209 "\\1<br />\n") 'append))
2211 (narrow-to-region beg end)
2212 (goto-char (point-min))
2217 (while (re-search-forward (car rep) nil t)
2218 (replace-match (cdr rep) t))))
2226 (narrow-to-region (point) (mark))
2227 (goto-char (point-min))
2229 (goto-char (point-max))
2231 (forward-paragraph))))
2234 (while (re-search-forward url nil t)
2235 (replace-match "<a href=\"\\&\">\\&</a>")))
2238 (while (re-search-forward email nil t)
2239 (replace-match "<a href=\"mailto:\\&\">\\&</a>"))
2240 (while (search-backward "@" nil t)
2241 (replace-match "@" nil t)))
2244 (lj-entify-region (point-min) (point-max))))
2245 (when (region-exists-p)
2246 (zmacs-deactivate-region))))
2248 (defun lj-ljtags-to-html ()
2249 "Convert \"<lj-*>\" tags to something resembling HTML.
2251 This function is used so that the markup in a post can be validated
2252 before it is submitted, and also so the post can be previewed before
2253 it is submitted. Do not expect anything fancy."
2254 (goto-char (point-min))
2257 (while (re-search-forward "<lj-\\(poll\\)" nil t)
2258 (let ((p (point-at-bol)))
2259 (search-forward (concat "</lj-" (match-string 1) ">") nil t)
2261 (narrow-to-region p (point))
2262 (lj-text-to-html (point-min) (point-max) 'nopbr)
2263 (goto-char (point-min))
2264 (insert "<div class=\"ljpoll\">\n<pre>\n")
2265 (goto-char (point-max))
2266 (insert "\n</pre>\n</div>")))))
2269 (while (re-search-forward "^</?lj-cut\\( text=\"---More---\"\\)?>$" nil t)
2270 (lj-text-to-html (match-beginning 0) (match-end 0) 'nopbr)))
2272 (while (re-search-forward "<lj-cut" nil t)
2273 (replace-match "<div class=\"ljcut\">\n\\&")
2274 (re-search-forward "</lj-cut>" nil t)
2275 (replace-match "\\&\n</div>")))
2278 (while (re-search-forward "<lj user=\"\\(.*\\)\" />" nil t)
2279 (replace-match "<a href=\"http://\\1.livejournal.com/profile\">
2280 <img src=\"http://p-stat.livejournal.com/img/userinfo.gif\"
2281 alt=\"[info]\" width=\"17\" height=\"17\"
2282 style=\"vertical-align: bottom; border: 0; padding-right: 1px;\" />
2284 <a href=\"http://\\1.livejournal.com/\"><b>\\1</b></a>")))
2287 (while (re-search-forward "<lj-template name=\"qotd\" id=\"[0-9]+\" />"
2289 (replace-match "<h3>Writer's Block Answer</h3>" t))))
2291 (defun lj-validate ()
2292 "Check the markup in a LJ post.
2294 Please note that livejournal.com is quite forgiving when it comes to
2295 HTML in journal entries, lj.el, on the other hand... isn't. For
2296 your entry to pass this validation it needs to be valid XHTML 1.0
2299 (run-hooks 'lj-before-validate-hook)
2300 (let ((vf (make-temp-name (expand-file-name "LJ-" (temp-directory))))
2301 (pb (current-buffer)))
2302 (with-current-buffer (get-buffer-create vf)
2304 (insert lj-validate-header)
2310 (narrow-to-region (point) (point-max))
2312 (insert lj-validate-footer)
2314 (write-region (point-min) (point-max) vf))
2320 (sgml-validate (sgml-default-validate-command))
2321 (let ((proc (get-buffer-process "*sgml validation*")))
2322 (while (process-live-p proc)
2324 (message "Validating markup, please wait..."))
2325 (message "Validation complete!")
2326 (when (> (process-exit-status proc) 0)
2327 (error 'syntax-error (process-name proc)))))
2330 (switch-to-buffer pb))
2331 (run-hooks 'lj-after-validate-hook)))
2333 (defun lj-preview-headers (buf)
2334 "Add htmlised LJ headers in buffer, BUF for `lj-preview'."
2339 (setq pic (lj-header-content "userpic"))
2341 (narrow-to-region (point-min) (point))
2342 (setq text (buffer-substring-no-properties)))
2346 (lj-text-to-html (point-min) (point-max))
2347 (goto-char (point-min))
2348 (insert "<div class=\"ljhead\">\n")
2349 (and (search-forward "<p>")
2350 (insert (format "<img src=\"%s\" align=\"right\" alt=\"Userpic\" />"
2351 (cdr (assoc pic lj-pickws)))))
2352 (while (search-forward "</head>" nil t)
2353 (replace-match "" nil t))
2354 (goto-char (point-max))
2355 (insert "\n</div>\n\n")
2358 (defun lj-preview ()
2359 "Preview the LJ post in a web browser.
2361 Please note that this is far from a true representation of what the
2362 thing will look like once it has been submitted to LiveJournal. But
2363 it should give you a rough idea."
2365 (run-hooks 'lj-before-preview-hook)
2366 (let ((vf (make-temp-name (expand-file-name "LJ-" (temp-directory))))
2367 (pb (current-buffer)))
2368 (with-current-buffer (get-buffer-create vf)
2370 (insert lj-validate-header)
2371 (insert (lj-preview-headers pb))
2372 (insert "<div class=\"lj\">\n")
2378 (narrow-to-region (point) (point-max))
2381 (insert lj-validate-footer)
2383 (browse-url-of-buffer))
2384 (when (region-exists-p)
2385 (zmacs-deactivate-region))
2386 (run-hooks 'lj-after-preview-hook)))
2388 (defvar lj-last-url "No URL yet, got nothing to blog about?"
2389 "The URL to your last posted blog entry on LiveJournal.")
2391 (defun lj-post-proc-parser (buf)
2392 "Process parser for `lj-post'.
2393 Argument BUF is the process buffer used."
2394 (let ((url "^url\n\\(.*$\\)"))
2395 (with-current-buffer buf
2396 (when (lj-proc-success)
2397 (setq lj-last-user-set-time nil)
2398 (goto-char (point-min))
2399 (if (re-search-forward url nil t)
2400 (setq lj-last-url (match-string 1))
2401 (setq lj-last-url "NO URL RETURNED FROM LiveJournal"))
2402 (kill-buffer nil)))))
2404 (defun lj-archive-post (archive)
2405 "Archive the current post to ARCHIVE."
2406 (let ((buf (current-buffer)))
2407 (with-current-buffer (find-file-noselect archive)
2409 (goto-char (point-max))
2410 (insert (format "\n\n<a href\"%s\">View Online</a>\n" lj-last-url))
2412 (kill-buffer nil))))
2414 (defun lj-send-bcc (subject security tags comm mood music location body)
2415 "Send a copy of a LJ post via email to `lj-bcc-address'.
2417 Argument SUBJECT is the subject header from the post.
2419 Argument SECURITY is the security level from the post, it is added to
2420 them mail as X-LJ-Auth header.
2422 Argument TAGS are the tags from the post, added as Keywords header.
2424 Argument COMM is the community from the post, added as X-LJ-Community
2427 Argument MOOD is the mood from the post, added as X-LJ-Mood header.
2429 Argument MUSIC is the music from the post, added as X-Now-Playing
2432 Argument LOCATION is the location from the post, added as X-LJ-Location
2435 Argument BODY is of course the post's body."
2436 (let* ((from (concat user-full-name
2437 " <" lj-user-id "@livejournal.com>"))
2438 (headers `(("From" . ,from)
2439 ("Keywords" . ,tags)
2440 ("X-LJ-Auth" . ,security)
2441 ("X-LJ-Community" . ,comm)
2442 ("X-LJ-Location" . ,location)
2443 ("X-LJ-Mood" . ,mood)
2444 ("X-Now-Playing" . ,music)
2445 ("X-URL" . ,lj-last-url)
2446 ("MIME-Version" . "1.0")
2447 ("Content-Type" . "text/html")))
2448 (mail-user-agent 'sendmail-user-agent))
2449 (compose-mail lj-bcc-address subject headers)
2450 (goto-char (point-max))
2452 (declare-fboundp (mail-send-and-exit nil))))
2454 (defun lj-last-entry-proc-parser (buf)
2455 "Process the output from `lj-get-last-entry-btime'.
2456 Argument BUF is the process buffer used."
2457 (let ((regexp "^events_1_eventtime\n\\(.*$\\)"))
2458 (with-current-buffer buf
2459 (when (lj-proc-success)
2460 (goto-char (point-min))
2461 (re-search-forward regexp nil t)
2462 (setq lj-last-entry-btime
2463 (apply #'encode-btime (lj-parse-time-string
2465 (kill-buffer nil)))))
2467 (defun lj-get-last-entry-btime ()
2468 "Leech the last entry from LJ to get it's date/time."
2469 (let ((cookies (or lj-cookies
2470 (error "No LJ cookies found")))
2471 (url (concat lj-base-url
2474 "&auth_method=cookie"
2475 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0))
2479 (lj-http-post url cookies #'lj-last-entry-proc-parser)))
2481 (defun lj-set-date/time ()
2482 "Return an internal time value to use as post date/time.
2484 This will prompt for a date string of the format yyyy-mm-dd, and a
2485 time string in the format HH:MM \(24hr\). If either are given a null
2486 string the current date/time are used.
2488 The value returned is that same as from `encode-time'."
2489 (let* ((date (read-string (format-time-string "New date [%Y-%m-%d]: ")
2491 (format-time-string "%Y-%m-%d")))
2492 (time (read-string (format-time-string "New time [%H:%M]: ")
2494 (format-time-string "%H:%M")))
2495 (timestr (concat date " " time))
2496 (btime (apply #'encode-btime (lj-parse-time-string timestr))))
2497 (btime-to-time btime)))
2499 (defun lj-twitter-compress-url (url)
2500 "Compress URL using tinyurl.com."
2503 (concat "http://tinyurl.com/api-create.php?url="
2504 (lj-hexify-string url t)))
2507 (defun lj-twitter-sentinel (process status)
2508 "Sentinel for `lj-twitter-update-status' PROCESS STATUS."
2509 (if (equal status "finished\n")
2510 (message "Sending to Twitter...done")
2511 (message "Sending to Twitter...failed: %s"
2512 (substring status 0 (1- (length status))))))
2514 (defun lj-twitter-update-status (user pass status url)
2515 "Update twitter status.
2517 Argument USER is your twitter username.
2518 Argument PASS is your twitter password.
2519 Argument STATUS is the subject header from your LJ post.
2520 Argument URL is the URL to the post on livejournal.com."
2521 (let* ((userpass (format "%s:%s" user pass))
2522 (turl (lj-twitter-compress-url url))
2523 (twit (concat "status="
2525 (concat status " See: " turl) t)))
2526 (twiturl "http://twitter.com/statuses/update.json")
2528 (if (<= (length twit) 147) ; twitter's max + "status="
2531 (apply #'start-process
2536 "-H" "X-Twitter-Client: SXEmacs_LJ"
2537 "-H" (format "X-Twitter-Client-Version: %s"
2540 "X-Twitter-Client-URL: "
2541 "http://www.sxemacs.org/~steve/lj/lj.xml")
2542 "-d" "source=lj.el")))
2543 (set-process-sentinel proc #'lj-twitter-sentinel))
2544 (warn "LJ subject too long for Twitter"))))
2546 (defun lj-post (&optional out-of-order)
2547 "Submit a new post to LiveJournal.
2549 With a single prefix argument, OUT-OF-ORDER, prompt for a date/time to
2552 With two prefix args, also set a \"date out of order\" flag."
2554 (run-hooks 'lj-before-post-hook)
2555 (let ((subject (lj-header-content "subject"))
2556 (body (and (lj-goto-body)
2557 (buffer-substring-no-properties (point) (point-max))))
2559 (security (lj-header-content "security"))
2560 (tags (lj-header-content "tags"))
2561 (comm (lj-header-content "community"))
2562 (mood (lj-header-content "mood"))
2563 (location (lj-header-content "location"))
2564 (music (lj-header-content "music"))
2565 (pickw (lj-header-content "userpic"))
2566 (cookies (or lj-cookies
2567 (error "No LJ cookies found")))
2570 (draftid (buffer-file-name))
2572 (when (and out-of-order
2573 (null current-prefix-arg))
2575 date lj-last-user-set-time))
2576 (cond ((eq (car current-prefix-arg) 4)
2577 (setq date (lj-set-date/time)))
2578 ((eq (car current-prefix-arg) 16)
2579 (setq date (lj-set-date/time)
2581 (setq url (lj-construct-url subject body user security tags comm nil nil
2582 mood location music pickw date backdated))
2583 ;; lets save the draft out to disc just in case something goes wrong
2585 (lj-http-post url cookies #'lj-post-proc-parser)
2586 (and lj-archive-posts
2587 (lj-archive-post (lj-header-content "fcc")))
2589 (lj-send-bcc subject security tags comm mood music location body))
2590 (and lj-twitter-flag
2591 (lj-twitter-update-status lj-twitter-username lj-twitter-password
2592 subject lj-last-url))
2593 (delete-file draftid)
2594 (run-hooks 'lj-after-post-hook)))
2596 ;; keep track of the date of the last entry for backdating purposes
2597 (add-hook 'lj-after-post-hook #'lj-get-last-entry-btime)
2600 (defvar lj-qotd-buffer "*LJ Writer's Block*"
2601 "Buffer displaying a list of LJ Writer's Block questions.")
2603 (defun lj-parse-qotd-archive ()
2604 "Leech the qotd archive and make it presentable for human consumption."
2605 (let ((buf (get-buffer-create lj-qotd-buffer))
2606 (bregexp "<!-- Content -->")
2607 (eregexp "<p class='skiplinks'>")
2608 (qregexp "^<p class='qotd-archive-item-question'>\\(.*\\)</p><p")
2609 (dregexp "^<p class='qotd-archive-item-date'>\\(.*[0-9]+\\)</p>")
2610 (idregexp "^.*qotd=\\([0-9]+\\).*\n.*$")
2611 (url "http://www.livejournal.com/misc/qotdarchive.bml")
2613 (with-current-buffer buf
2614 (when (lj-utf-emacs-p)
2615 (set-buffer-file-coding-system 'utf-8))
2618 (goto-char (point-min))
2619 (setq b (and (search-forward bregexp nil t)
2622 e (and (search-forward eregexp nil t)
2624 (narrow-to-region b e)
2625 (goto-char (point-min))
2626 (insert (make-string 72 ?=) "\n")
2628 (while (re-search-forward dregexp nil t)
2629 (replace-match (format "%s:\n\n" (match-string 1)) t)))
2631 (while (re-search-forward qregexp nil t)
2632 (replace-match (format "QOTD: %s\n" (match-string 1)) t)))
2634 (while (re-search-forward "^QOTD:" nil t)
2635 (fill-paragraph nil)))
2637 (while (re-search-forward idregexp nil t)
2638 (replace-match (concat (format "\nWriter's Block ID: %s\n"
2640 (make-string 72 ?=)) t))))))
2642 (defun lj-narrow-to-qotd (qotd)
2643 "Narrow Writer's Block buffer to a single QOTD."
2644 (let ((delim (make-string 72 ?=))
2646 (goto-char (point-max))
2647 (setq e (and (search-backward (format "ID: %d" qotd))
2649 b (search-backward delim))
2650 (narrow-to-region b e)
2651 (shrink-window-if-larger-than-buffer)
2653 (unless (eq major-mode 'lj-mode)
2654 (switch-to-buffer "*LJ-Post*"))
2655 (unless (zerop lj-qotd)
2656 (insert (format "<lj-template name=\"qotd\" id=\"%d\" />\n\n"
2659 (defun lj-cleanup-qotd ()
2660 "Reset `lj-qotd' to zero and kill the qotd buffer."
2663 (delete-other-windows)
2664 (when (buffer-live-p (get-buffer lj-qotd-buffer))
2665 (kill-buffer lj-qotd-buffer))))
2667 (defun lj-qotd-quit ()
2668 "Cancel a LJ \"Writer's Block\" composition."
2671 (unless (eq major-mode 'lj-mode)
2672 (switch-to-buffer "*LJ-Post*"))
2674 (and (lj-goto-subject)
2675 (kill-region (point) (point-at-eol)))
2677 (kill-region (point) (point-at-eol)))
2679 (remove-hook 'lj-after-post-hook #'lj-cleanup-qotd))
2681 (defun lj-writers-block ()
2682 "Compose an answer to a LJ \"Writer's Block\" question."
2684 (and (lj-goto-subject)
2685 (kill-region (point) (point-at-eol))
2686 (insert "Writer's Block: "))
2688 (kill-region (point) (point-at-eol))
2689 (insert "writer's block"))
2691 (kill-region (point) (point-max)))
2692 (lj-sgml-indent-tab-or-complete)
2693 (lj-parse-qotd-archive)
2694 (pop-to-buffer lj-qotd-buffer)
2695 (local-set-key [space] #'scroll-up)
2696 (local-set-key [delete] #'scroll-down)
2697 (local-set-key [return]
2700 (setq lj-qotd (read-number "Select Writer's Block ID: " t))
2701 (lj-narrow-to-qotd lj-qotd)))
2702 (local-set-key [q] #'lj-qotd-quit)
2703 (message "[SPC]/[DEL] to scroll, [q] to cancel, [RET] to enter QOTD ID")
2704 (add-one-shot-hook 'lj-after-post-hook #'lj-cleanup-qotd 'append))
2706 (defun lj-session-auto-save-files ()
2707 "Return a list of auto-save files in `lj-drafts-directory'."
2708 (directory-files lj-drafts-directory nil
2709 #'auto-save-file-name-p 'list t))
2711 (defun lj-recover-drafts (files)
2712 "Recover auto-saved FILES in `lj-drafts-directory'."
2713 (let ((default-directory lj-drafts-directory))
2715 (recover-file (auto-save-original-name (car files)))
2716 (lj-edit-draft (auto-save-original-name (car files)))
2717 (setq files (cdr files)))))
2722 "Compose a new LiveJournal entry."
2724 (run-hooks 'lj-init-hook)
2725 ;; Maybe update tags, groups, moods, pic keywords
2726 (or lj-tags (lj-get-tags))
2727 (or lj-groups (lj-get-friends-groups))
2728 (or lj-moods (lj-get-moods))
2729 (or lj-default-pickw (lj-get-pickws))
2730 (let ((auto-saves (lj-session-auto-save-files)))
2732 (y-or-n-p "Auto saved drafts exist, do you wish to recover "))
2733 (lj-recover-drafts auto-saves)
2734 (lj-generate-new-buffer))))
2736 (defun lj-blog-buffer (buffer &optional noformat)
2737 "Use contents of BUFFER to compose LJ entry.
2739 With optional prefix arg, NOFORMAT, don't attempt to convert the text
2741 (interactive "bBuffer to blog: \nP")
2742 (let ((blog (with-temp-buffer
2743 (insert-buffer buffer)
2744 (unless current-prefix-arg
2745 (lj-text-to-html (point-min) (point-max)))
2746 (buffer-substring-no-properties))))
2750 (defun lj-blog-region (beg end &optional noformat)
2751 "Compose LJ entry using content of region BEG - END.
2753 With optional prefix arg, NOFORMAT, dont' attempt to convert the text
2755 (interactive "r\nP")
2756 (let ((blog (buffer-substring beg end)))
2757 (unless current-prefix-arg
2760 (lj-text-to-html (point-min) (point-max))
2761 (setq blog (buffer-substring-no-properties))))
2765 (defun lj-edit-draft (draft)
2766 "Edit an existing draft previously saved from lj.el."
2768 (read-file-name "Edit draft: "
2769 lj-drafts-directory "" t)))
2770 (if (or (zerop (length draft))
2771 (not (file-readable-p (expand-file-name draft))))
2772 (error 'invalid-argument draft)
2773 (switch-to-buffer (find-file-noselect (expand-file-name draft)))
2774 (rename-buffer "*LJ-draft*" 'unique)
2775 (goto-char (point-min))
2776 (make-extent (point) (point-at-eol))
2777 (lj-update-userpic-glyph
2778 (expand-file-name (lj-header-content "userpic")
2779 lj-userpic-directory))
2780 (re-search-forward lj-header-separator nil t)
2782 (set-extent-property
2783 (make-extent (point-at-bol) (1+ (point-at-eol))) 'invisible t)
2790 (and (file-exists-p lj-tags-file)
2791 (load-file lj-tags-file))
2792 (and (file-exists-p lj-groups-file)
2793 (load-file lj-groups-file))
2794 (and (file-exists-p lj-moods-file)
2795 (load-file lj-moods-file))
2796 (and (file-exists-p lj-pickws-file)
2797 (load-file lj-pickws-file))