1 ;; lj.el --- LiveJournal meets SXEmacs -*- Emacs-Lisp -*-
3 ;; Copyright (C) 2008 - 2011 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/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.
64 ;;; A Note about validating your markup:
66 ;; Before you can validate your posts (with psgml) you need to
69 ;; o You have both, the psgml, and psgml-dtds XEmacs packages
70 ;; installed. Well, duh!
72 ;; o You have a working sgml toolchain. It is way beyond the
73 ;; scope of this lib (or my patience) to show you how.
74 ;; Instead, do what the pros do and see:
76 ;; http://www.linuxfromscratch.org/blfs/view/svn/pst/sgml.html
78 ;; o psgml needs to know where your catalog files are. The
79 ;; easiest way to do that is to set SGML_CATALOG_FILES in
80 ;; your shell environment...
82 ;; export SGML_CATALOG_FILES=/etc/sgml/catalog:/path/to/psgml-dtds/CATALOG
86 ;; Whack this lib into your load-path somewhere and...
88 ;; (setq lj-user-id "your_lj_id")
90 ;; When you want to compose a new LJ entry... M-x lj RET
92 ;; There's nothing hard or overly complicated here. Take a look at
93 ;; describe-mode (`C-h m') which will show you the keybindings
94 ;; available. All of the "lj-mode specific" interactive commands
95 ;; have a binding. There are 3 "global" commands that don't...
101 ;; The only reason they don't have keybindings is that I think it'd
102 ;; be bad form on my part to set global keys for you. Assign them
103 ;; to keys if you want.
105 ;; All of the "headers" have completion too. A couple of tips
106 ;; about the completion...
108 ;; - By default iso-left-tab (that's shift-tab for the clueless)
109 ;; will cycle backwards.
111 ;; - The trick to getting multiple tags is to type a comma (`,')
112 ;; plus the first letter or two of the next tag you wanna use
113 ;; after the last inserted tag.
115 ;;; Twitter: (broken, don't use)
117 ;; This is currently broken because twitter turned off Basic Auth
119 ;; You can optionally post the subject header of your blog entry as
120 ;; a status update to Twitter, along with a URL to the entry on
121 ;; livejournal.com. To do so, you must set...
124 ;; `lj-twitter-username'
125 ;; `lj-twitter-password'
127 ;; The down side to this is that your twitter username and password
128 ;; are stored in clear text. I'll work on a way to make that safer
135 ;; o Make "Writer's Block" a bit friendlier. Add the ability to
136 ;; choose different qotd's after one has been selected. Also, be
137 ;; able to view older qotd's.
139 ;; o Rewrite the twitter code to use OAuth.
144 ;; I've tried to make this compatible with XEmacs 21.5 and 21.4,
145 ;; but I don't have either of those installed so I'm not 100%
146 ;; certain. As for GNU/Emacs... absolutely no idea, but I'd doubt
147 ;; that this is anywhere near compatible.
151 (defconst lj-version 1.27
152 "Version number of SXEmacs/LJ.")
156 (autoload #'html-mode "psgml-html" nil t)
157 (autoload #'executable-find "executable")
158 (autoload #'completing-read-multiple "crm")
159 (autoload #'sgml-indent-or-tab "psgml" nil t)
160 (autoload #'sgml-parse-prolog "psgml-parse" nil t)
161 (autoload #'sgml-validate "psgml" nil t)
162 (autoload #'sgml-default-validate-command "psgml")
163 (autoload #'browse-url-of-buffer "browse-url" nil t)
164 (autoload #'customize-apropos "cus-edit" nil t)
165 (autoload #'customize-group "cus-edit" nil t)
166 (autoload #'regexp-opt "regexp-opt")
167 (autoload #'sqlite-open "ffi-sqlite")
168 (autoload #'sqlite-rows "ffi-sqlite")
169 (autoload #'sqlite-close "ffi-sqlite")
170 (autoload #'url-cookie-retrieve "url-cookie")
171 (autoload #'url-cookie-name "url-cookie")
172 (autoload #'url-cookie-value "url-cookie")
173 (defvar sxemacs-codename)
174 (defvar xemacs-codename)
175 (defvar url-cookie-secure-storage)
176 (defvar url-cookie-file))
179 (require 'hm--html-configuration)
180 (require 'psgml-html)
182 (unless (fboundp #'when-fboundp)
184 (autoload #'mm-url-insert "mm-url"))
189 :link '(url-link "http://www.livejournal.com/")
192 (defgroup lj-twitter nil
193 "LiveJournal meets Twitter"
194 :prefix "lj-twitter-"
195 :link '(url-link "http://www.livejournal.com/")
196 :link '(url-link "http://twitter.com/")
199 (defun lj-customise-faces ()
200 "Customise the lj.el faces."
202 (customize-apropos "^lj-" 'faces))
204 (defun lj-customise-group ()
205 "Customise lj.el user options."
207 (customize-group "lj"))
209 (defcustom lj-self-promote t
210 "When non-nil, a \"Posted via...\" byline is added to a post.
212 The text is a single line in small print (8pt) right justified at the
213 very end of your post. It should be quite inconspicuous, but you are
214 welcome to turn this off if you are too bashful to let the world know
215 what software you use."
219 (defcustom lj-user-id (user-login-name)
224 (defcustom lj-signature nil
225 "A signature to add to the bottom of a post.
227 This is analogous to an email signature. Set this any HTML marked up
228 text you like, or something that returns such. Remember to use valid
229 XHTML 1.0 Transitional if you plan to validate before posting."
233 (defcustom lj-cookie-flavour 'auto
234 "*The default cookie flavour \(browser\) to search for cookies."
236 (symbol :tag "Automatic" :value auto)
237 (symbol :tag "Chrome" :value chrome)
238 (symbol :tag "Firefox" :value firefox)
239 (symbol :tag "Seamonkey" :value seamonkey)
240 (symbol :tag "Mozilla" :value mozilla)
241 (symbol :tag "Galeon" :value galeon)
242 (symbol :tag "Safari" :value safari)
243 (symbol :tag "Netscape" :value netscape)
244 (symbol :tag "Midori" :value midori)
245 (symbol :tag "Emacs-W3" :value w3))
248 (defcustom lj-default-security-level "public"
249 "*The default security level LJ posts will have."
251 (string :tag "Public" :value "public")
252 (string :tag "Private" :value "private")
253 (string :tag "All Friends" :value "usemask")
254 (string :tag "Group..."))
257 (defcustom lj-directory (paths-construct-path
258 (list (user-home-directory) ".lj"))
259 "*Directory for storing tags and archiving posts."
263 (defcustom lj-tags-file (expand-file-name "ljtags" lj-directory)
264 "*File to store list of LJ tags."
268 (defcustom lj-groups-file (expand-file-name "ljgrps" lj-directory)
269 "*File to store list of LJ friends groups."
273 (defcustom lj-moods-file (expand-file-name "ljmoods" lj-directory)
274 "*File to store list of LJ \"moods\"."
278 (defcustom lj-pickws-file (expand-file-name "pickws" lj-directory)
279 "*File to store list of LJ user picture keywords."
283 (defcustom lj-userpic-directory
284 (file-name-as-directory
285 (expand-file-name "images" lj-directory))
286 "*Directory to store LJ userpic files."
290 (defcustom lj-drafts-directory
291 (file-name-as-directory
292 (expand-file-name "drafts" lj-directory))
293 "*Directory where post drafts are stored."
298 "A list of LJ tags.")
300 (defvar lj-groups nil
301 "A list of LJ friends groups.")
304 "LiveJournal \"moods\".")
306 (defvar lj-pickws nil
307 "A list of LJ userpic keywords.")
309 (defvar lj-default-pickw nil
310 "The default LJ userpic keyword.")
312 ;; See mpd.el in the same repo as lj.el
313 (defvar **mpd-var-Title* nil)
314 (defvar **mpd-var-Artist* nil)
315 (defun lj-music-mpd ()
316 "Return the current song title/artist from mpd."
317 (let ((song (if **mpd-var-Title*
318 (format "%s --- [%s]"
321 "The Sounds of Silence --- [Marcel Marceau]")))
324 (defcustom lj-music (and (featurep 'mpd) #'lj-music-mpd)
325 "*A function to retrieve current song for LJ music header.
326 This function should return a formatted string, or nil."
330 (defcustom lj-archive-posts nil
331 "*Keep an archive copy of LJ posts when non-nil."
335 (defcustom lj-archive-directory
336 (file-name-as-directory
337 (expand-file-name "archive" lj-directory))
338 "*Directory where LJ posts are archived."
342 (defcustom lj-bcc-address nil
343 "*Email address to send a copy of LJ posts to.
344 Set to nil to disable."
348 (defcustom lj-default-location nil
349 "*Default for the Location header."
353 (defcustom lj-before-preview-hook nil
354 "*Hook run before previewing a post."
358 (defcustom lj-after-preview-hook nil
359 "*Hook run as the last thing from `lj-preview'."
363 (defcustom lj-before-validate-hook nil
364 "*Hook run before validating a post."
368 (defcustom lj-after-validate-hook nil
369 "*Hook run as the last thing from `lj-validate'."
373 (defcustom lj-init-hook nil
374 "*Hook run before anything else is done when starting lj."
378 (defcustom lj-before-post-hook nil
379 "*Hook run before posting."
383 (defcustom lj-after-post-hook nil
384 "*Hook run after posting."
388 (defcustom lj-cut-hook nil
389 "*Hooks run after inserting an LJ-CUT."
393 (defcustom lj-poll-hook nil
394 "*Hooks run after inserting a LJ Poll."
398 (defcustom lj-journal-hook nil
399 "*Hooks run after inserting a LJ Journal link."
403 (defcustom lj-youtube-hook nil
404 "*Hooks run after inserting a youtube/google video."
408 (defcustom lj-twitter-flag nil
409 "*Non-nil means to update your twitter status.
411 The subject header and a URL to the last blog entry is posted to
412 twitter as a status update if this is set."
416 (defcustom lj-twitter-username (user-login-name)
417 "*Your twitter username."
421 ;;; FIXME: Can we store this in something OTHER than plain text. Do
422 ;;; we even need it at all with OAuth?
423 (defcustom lj-twitter-password "secret"
424 "*Your twitter password."
428 (defconst lj-clientversion
429 (concat (when (featurep 'sxemacs) "S")
431 emacs-program-version
432 (format "/LJ: %.2f" lj-version))
433 "Client version string.")
435 (defconst lj-useragent
437 (when (featurep 'sxemacs) "S")
439 emacs-program-version
440 (format " [%s]:LJ-%.2f; steve@sxemacs.org)"
441 (if (featurep 'sxemacs)
445 "Useragent string sent to livejournal.com.")
447 (defconst lj-validate-header
448 "<?xml version=\"1.0\" encoding=\"utf-8\"?>
449 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
450 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
452 <html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
454 <title>LJ Post Preview</title>
456 <style type=\"text/css\">
458 background: rgb(204,204,255);
462 font-family: times new roman, verdana, helvetica, sans-serif;
467 background: rgb(255,235,205);
487 "Header used to construct HTML doc for previewing and validating LJ posts.")
489 (defconst lj-validate-footer
494 <!-- Leave this comment at the end of this file
496 sgml-validate-command:\"onsgmls -E0 -wall -wno-unused-param -wfully-tagged -wfully-declared -wtype-valid -wintegral -s %s %s\"
499 sgml-namecase-general:nil
500 sgml-general-insert-case:lower
501 sgml-minimize-attributes:nil
502 sgml-always-quote-attributes:t
505 sgml-parent-document:nil
506 sgml-exposed-tags:nil
507 sgml-local-catalogs:nil
508 sgml-local-ecat-files:nil
512 "Footer used to construct HTML doc for previewing and validating LJ posts.")
514 (defconst lj-base-url
515 "http://www.livejournal.com/interface/flat"
516 "The base URL where LJ posts are submitted etc.")
518 (defvar lj-last-entry-btime nil
519 "The date/time of the last posted entry as a big integer.")
521 (defun lj-parse-time-string (string)
522 "Parse a time STRING of the format \"YYYY-MM-DD HH:MM:SS\".
524 The seconds field can be ommitted and in that case 0 is used.
526 Returns a list suitable for passing to `encode-time' or `encode-btime'."
527 (let ((regexp (concat "^\\([12][0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-"
528 "\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?$")))
529 (if (string-match regexp string)
530 (let ((year (string-to-int (substring string
533 (month (string-to-int (substring string
536 (day (string-to-int (substring string
539 (hour (string-to-int (substring string
542 (min (string-to-int (substring string
545 (sec (if (eq (length string) 19)
546 (string-to-int (substring string (match-beginning 7)
549 (unless (and (>= year 1970)
551 (error 'invalid-argument year))
552 (unless (and (>= month 1)
554 (error 'invalid-argument month))
555 (unless (and (>= day 1)
557 (error 'invalid-argument day))
558 (unless (and (>= hour 0)
560 (error 'invalid-argument hour))
561 (unless (and (>= min 0)
563 (error 'invalid-argument min))
564 (unless (and (>= sec 0)
566 (error 'invalid-argument sec))
567 (list sec min hour day month year))
568 (error 'invalid-argument string))))
570 ;; Probably should set up a proper prefix
572 (let ((map (make-sparse-keymap)))
573 (set-keymap-name map 'lj-mode-map)
574 (define-key map [(control ?c) (control return)] #'lj-post)
575 (define-key map [(control ?c) ?F] #'lj-customise-faces)
576 (define-key map [(control ?c) ?G] #'lj-customise-group)
577 (define-key map [(control ?c) ?P] #'lj-insert-poll)
578 (define-key map [(control ?c) ?c] #'lj-cut-region)
579 (define-key map [(control ?c) ?j] #'lj-insert-journal)
580 (define-key map [(control ?c) ?p] #'lj-preview)
581 (define-key map [(control ?c) ?w] #'lj-writers-block)
582 (define-key map [(control ?c) ?y] #'lj-insert-youtube)
583 (define-key map [(control ?c) (control ?f) ?M] #'lj-goto-mood)
584 (define-key map [(control ?c) (control ?f) ?S] #'lj-goto-security)
585 (define-key map [(control ?c) (control ?f) ?b] #'lj-goto-bcc)
586 (define-key map [(control ?c) (control ?f) ?c] #'lj-goto-community)
587 (define-key map [(control ?c) (control ?f) ?f] #'lj-goto-fcc)
588 (define-key map [(control ?c) (control ?f) ?l] #'lj-goto-location)
589 (define-key map [(control ?c) (control ?f) ?m] #'lj-goto-music)
590 (define-key map [(control ?c) (control ?f) ?s] #'lj-goto-subject)
591 (define-key map [(control ?c) (control ?f) ?t] #'lj-goto-tags)
592 (define-key map [(control ?c) (control ?f) ?u] #'lj-goto-userpic)
593 (define-key map [(control ?c) (control ?b)] #'lj-goto-body)
594 (define-key map [(control meta ?v)] #'lj-validate)
595 (define-key map [tab] #'lj-sgml-indent-tab-or-complete)
596 (define-key map [iso-left-tab] #'lj-complete-header-backwards)
599 (defvar lj-header-separator "--text follows this line--"
600 "Text to denote the end of the headers and beginning of the message.")
602 ;; Faces (defaults are probably crap for a light background)
603 (defun lj-face-p (face)
604 "Call facep on FACE."
605 (facep (find-face face)))
607 (make-face 'lj-header-name "Face used for LJ headers.")
608 (set-face-parent 'lj-header-name (or (and (lj-face-p 'message-header-name)
609 'message-header-name)
610 (and (lj-face-p 'message-header-name-face)
611 'message-header-name-face)
614 (make-face 'lj-header-subject "Face used for LJ Subject header content.")
615 (set-face-parent 'lj-header-subject
616 (or (and (lj-face-p 'message-header-subject)
617 'message-header-subject)
618 (and (lj-face-p 'message-header-subject-face)
619 'message-header-subject-face)
622 (make-face 'lj-header-fcc "Face used for LJ FCC header content.")
623 (set-face-parent 'lj-header-fcc 'font-lock-comment-face)
624 (make-face 'lj-header-bcc "Face used for LJ BCC header content.")
625 (set-face-parent 'lj-header-bcc (or (and (lj-face-p 'message-header-cc)
627 (and (lj-face-p 'message-header-cc-face)
628 'message-header-cc-face)
631 (make-face 'lj-header-security "Face used for LJ Security header content.")
632 (set-face-parent 'lj-header-security 'font-lock-warning-face)
634 (make-face 'lj-header-music "Face used for LJ Music header content.")
635 (set-face-parent 'lj-header-music
636 (or (and (lj-face-p 'message-header-xheader)
637 'message-header-xheader)
638 (and (lj-face-p 'message-header-xheader-face)
639 'message-header-xheader-face)
640 'font-lock-builtin-face))
642 (make-face 'lj-header-mood "Face used for LJ Mood header content.")
643 (set-face-parent 'lj-header-mood
644 (or (and (lj-face-p 'message-header-other)
645 'message-header-other)
646 (and (lj-face-p 'message-header-other-face)
647 'message-header-other-face)
648 'font-lock-function-name-face))
650 (make-face 'lj-header-userpic "Face used for LJ Userpic header content.")
651 (set-face-parent 'lj-header-userpic
652 (or (and (lj-face-p 'message-header-other)
653 'message-header-other)
654 (and (lj-face-p 'message-header-other-face)
655 'message-header-other-face)
656 'font-lock-function-name-face))
658 (make-face 'lj-header-tags "Face used for LJ Tags header content.")
659 (set-face-parent 'lj-header-tags
660 (or (and (lj-face-p 'message-header-newsgroups)
661 'message-header-newsgroups)
662 (and (lj-face-p 'message-header-newsgroups-face)
663 'message-header-newsgroups-face)
664 'font-lock-keyword-face))
666 (make-face 'lj-header-community "Face used for LJ Community header content.")
667 (set-face-parent 'lj-header-community 'lj-header-userpic)
669 (make-face 'lj-header-location "Face used for LJ Location header content.")
670 (set-face-parent 'lj-header-location 'lj-header-userpic)
672 (make-face 'lj-separator "Face used for the LJ header separator.")
673 (copy-face 'bold 'lj-separator)
674 (set-face-foreground 'lj-separator "red")
676 ;; compatibility hoohar
677 (unless (featurep 'sxemacs)
678 (fset #'defregexp #'defvar))
680 (defun lj-utf-emacs-p ()
681 "Return non-nil if this S?XEmacs has utf-8 coding-system."
682 (and (featurep 'mule)
683 (declare-fboundp (find-coding-system 'utf-8))))
685 (defregexp lj-header-regexp
686 (let ((headers '("Subject" "FCC" "BCC" "Security" "Community"
687 "Location" "Mood" "Music" "Userpic" "Tags")))
688 (concat (regexp-opt headers t) ":"))
689 "Regular expression matching LJ headers.")
691 (defvar lj-font-lock-keywords
693 `((,lj-header-regexp 0 lj-header-name)
694 ("^Subject: \\(.*$\\)" 1 lj-header-subject)
695 ("^FCC: \\(.*$\\)" 1 lj-header-fcc)
696 ("^BCC: \\(.*$\\)" 1 lj-header-bcc)
697 ("^Security: \\(.*$\\)" 1 lj-header-security)
698 ("^Community: \\(.*$\\)" 1 lj-header-community)
699 ("^Music: \\(.*$\\)" 1 lj-header-music)
700 ("^Mood: \\(.*$\\)" 1 lj-header-mood)
701 ("^Location: \\(.*$\\)" 1 lj-header-location)
702 ("^Userpic: \\(.*$\\)" 1 lj-header-userpic)
703 ("^Tags: \\(.*$\\)" 1 lj-header-tags)
704 (,(regexp-quote lj-header-separator) 0 lj-separator))
705 hm--html-font-lock-keywords
706 html-font-lock-keywords)
707 "Font lock keywords for `lj-mode'.")
709 ;; kill/yank'd from jwz-lj.el
710 (defconst lj-entity-table
711 '(("iexcl" . ?\¡) ("cent" . ?\¢) ("pound" . ?\£) ("euro" . ?\~)
712 ("curren" . ?\¤) ("yen" . ?\¥) ("brvbar" . ?\¦) ("sect" . ?\§)
713 ("uml" . ?\¨) ("copy" . ?\©) ("ordf" . ?\ª) ("laquo" . ?\«)
714 ("not" . ?\¬) ("shy" . ?\) ("reg" . ?\®) ("macr" . ?\¯)
715 ("deg" . ?\°) ("plusmn" . ?\±) ("sup2" . ?\²) ("sup3" . ?\³)
716 ("acute" . ?\´) ("micro" . ?\µ) ("para" . ?\¶) ("middot" . ?\·)
717 ("cedil" . ?\¸) ("sup1" . ?\¹) ("ordm" . ?\º) ("raquo" . ?\»)
718 ("frac14" . ?\¼) ("frac12" . ?\½) ("frac34" . ?\¾) ("iquest" . ?\¿)
719 ("Agrave" . ?\À) ("Aacute" . ?\Á) ("Acirc" . ?\Â) ("Atilde" . ?\Ã)
720 ("Auml" . ?\Ä) ("Aring" . ?\Å) ("AElig" . ?\Æ) ("Ccedil" . ?\Ç)
721 ("Egrave" . ?\È) ("Eacute" . ?\É) ("Ecirc" . ?\Ê) ("Euml" . ?\Ë)
722 ("Igrave" . ?\Ì) ("Iacute" . ?\Í) ("Icirc" . ?\Î) ("Iuml" . ?\Ï)
723 ("ETH" . ?\Ð) ("Ntilde" . ?\Ñ) ("Ograve" . ?\Ò) ("Oacute" . ?\Ó)
724 ("Ocirc" . ?\Ô) ("Otilde" . ?\Õ) ("Ouml" . ?\Ö) ("times" . ?\×)
725 ("Oslash" . ?\Ø) ("Ugrave" . ?\Ù) ("Uacute" . ?\Ú) ("Ucirc" . ?\Û)
726 ("Uuml" . ?\Ü) ("Yacute" . ?\Ý) ("THORN" . ?\Þ) ("szlig" . ?\ß)
727 ("agrave" . ?\à) ("aacute" . ?\á) ("acirc" . ?\â) ("atilde" . ?\ã)
728 ("auml" . ?\ä) ("aring" . ?\å) ("aelig" . ?\æ) ("ccedil" . ?\ç)
729 ("egrave" . ?\è) ("eacute" . ?\é) ("ecirc" . ?\ê) ("euml" . ?\ë)
730 ("igrave" . ?\ì) ("iacute" . ?\í) ("icirc" . ?\î) ("iuml" . ?\ï)
731 ("eth" . ?\ð) ("ntilde" . ?\ñ) ("ograve" . ?\ò) ("oacute" . ?\ó)
732 ("ocirc" . ?\ô) ("otilde" . ?\õ) ("ouml" . ?\ö) ("divide" . ?\÷)
733 ("oslash" . ?\ø) ("ugrave" . ?\ù) ("uacute" . ?\ú) ("ucirc" . ?\û)
734 ("uuml" . ?\ü) ("yacute" . ?\ý) ("thorn" . ?\þ) ("yuml" . ?\ÿ)
736 "HTML entities to Latin1 characters.")
738 ;; adapted from jwz-lj.el
739 (defun lj-entify-region (beg end)
740 "Convert non-ASCII chars in the region BEG - END to HTML entities."
741 (let ((regex (if (featurep 'sxemacs)
743 ;; ho-hum, life would be simpler if XEmacs enabled
745 (concat "[" (mapconcat
747 (make-string 1 (cdr c)))
750 (case-fold-search nil))
753 (setq end (copy-marker end))
754 (while (re-search-forward regex end t)
755 (let* ((char (preceding-char))
756 (entity (or (car (rassq char lj-entity-table))
757 (error "No entity %c" char))))
759 (insert-before-markers "&" entity ";")))))
760 (and-fboundp #'charsets-in-region
761 (delq 'ascii (charsets-in-region beg end))
762 (error "Non-ASCII characters exist in this buffer")))
764 (defconst lj-unreserved-chars
765 '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
766 ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
767 ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M
768 ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
769 ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
770 ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
771 "A list of characters that are _NOT_ reserved in the URL spec.
772 This is taken from RFC 2396.")
774 (defun lj-hexify-string (str &optional http-entify)
775 "Escape characters STR so STR can be used in a URL.
777 With non-nil HTTP-ENTIFY, convert non-ASCII characters to HTTP
782 (lj-entify-region (point-min) (point-max)))
785 (if (not (memq char lj-unreserved-chars))
787 (format "%%0%X" char)
789 (error "Hexifying multibyte character %s" str))
790 (format "%%%X" char))
791 (char-to-string char)))
792 (buffer-string) "")))
794 (when-fboundp #'ffi-defun
796 (require 'ffi-sqlite)
797 (require 'ffi-curl)))
799 ;; adapted from jwz-lj.el
800 (defun lj-extract-sql-cookies (file chromep)
801 "Extract LJ cookie data from SQL cookies FILE.
803 Non-nil CHROMEP forces a Google Chrome compatible sql query."
804 (let ((sql (if chromep
805 ;; chrome sql cookies
806 (concat "SELECT name,value FROM cookies "
807 "WHERE host_key=\".www.livejournal.com\" "
808 "OR host_key=\".livejournal.com\"")
809 ;; mozilla based sql cookies
810 (concat "SELECT name,value FROM moz_cookies "
811 "WHERE host=\".www.livejournal.com\" "
812 "OR host=\".livejournal.com\""))))
813 (if (featurep 'ffi-sqlite)
814 ;; Try SXEmacs' sexy ffi-sqlite if it's available
815 (let* ((db (sqlite-open file))
816 (rows (sqlite-rows db sql)))
822 (concat (car c) "=" (cadr c)))
825 ;; The old fashioned way
826 (unless (executable-find "sqlite3")
827 (error "Can't find sqlite3"))
828 (let* ((sql (shell-command-to-string
829 (concat "sqlite3 " file "'" sql ";'")))
831 (split-string-by-char
832 (replace-regexp-in-string "\n" "|" sql) ?|)))
835 (push (cons (car slist) (cadr slist)) cookies)
836 (setq slist (cddr slist)))
841 (concat (car c) "=" (cdr c)))
842 (reverse cookies) "; ")
845 ;;; FIXME: redo this with #'xml-parse-file. Just as soon as I can get
846 ;; me grubby little hands on one of these xml cookie files.
847 ;; kill/yank'd from jwz-lj.el
848 ;;; FIXME: this will now be broken!
849 (defun lj-extract-xml-cookies (file)
850 "Extract LJ data from XML cookies FILE."
853 (narrow-to-region (point) (point))
854 (insert-file-contents file nil nil nil t)
855 (goto-char (point-min))
856 (search-forward "<dict>")
860 domain path name value)
861 (while (search-forward "</dict>" nil t)
865 ((search-forward "livejournal.com" end t) ; bail fast
868 (re-search-forward (concat "<key>Domain</key>[ \t\n\r]*"
869 "<string>\\([^<>]+\\)</string>")
871 (setq domain (match-string 1))
873 (re-search-forward (concat "<key>Path</key>[ \t\n\r]*"
874 "<string>\\([^<>]+\\)</string>")
876 (setq path (match-string 1))
878 (re-search-forward (concat "<key>Name</key>[ \t\n\r]*"
879 "<string>\\([^<>]+\\)</string>")
881 (setq name (match-string 1))
883 (re-search-forward (concat "<key>Value</key>[ \t\n\r]*"
884 "<string>\\([^<>]+\\)</string>")
886 (setq value (match-string 1))
887 (if (string-match "\\blivejournal\\.com$" domain)
889 (concat domain "\tTRUE\t" path "\tFALSE\t0\t"
894 (delete-region (point-min) (point-max))
898 (defun lj-extract-text-cookies (file)
899 "Extract LJ data from text based cookies FILE."
900 (let ((host-match "\\.livejournal\\.com$")
903 (insert-file-contents-literally file)
904 (goto-char (point-min))
906 (when (looking-at (concat "^\\([^\t\r\n]+\\)\t" ; 1 host
907 "\\([^\t\r\n]+\\)\t" ; 2 bool
908 "\\([^\t\r\n]+\\)\t" ; 3 path
909 "\\([^\t\r\n]+\\)\t" ; 4 bool
910 "\\([^\t\r\n]+\\)\t" ; 5 time_t
911 "\\([^\t\r\n]+\\)\t" ; 6 key
912 "\\([^\t\r\n]+\\)$")) ; 7 val
913 (let ((host (match-string 1))
914 (key (match-string 6))
915 (val (match-string 7)))
916 (when (and (string-match host-match host)
917 (not (assoc key cookies)))
918 (setq cookies (cons (cons key val) cookies))))
924 (concat (car c) "=" (cdr c)))
925 (nreverse cookies) "; ")
928 (defun lj-extract-w3-cookies ()
929 "Extract LJ cookie data from Emacs-W3 cookies."
930 (let* ((secure (and url-cookie-secure-storage t))
931 (w3cookies (remove-duplicates
932 (append (url-cookie-retrieve
933 "www.livejournal.com" "/" secure)
935 ".livejournal.com" "/" secure))
938 (replace-regexp-in-string
943 (unless (string-equal (url-cookie-name c) "HttpOnly")
944 (concat (url-cookie-name c) "=" (url-cookie-value c))))
945 (nreverse w3cookies) "; ")
948 ;; adapted from jwz-lj.el, but rewritten from scratch
949 (defun lj-get-cookies (flavour)
950 "Return a string of LJ cookie data suitable for HTTP POST'ing.
952 Argument FLAVOUR specifies which browser's cookies to check. If it is
953 the symbol `auto' \(the default\) all browsers will be searched in the
956 Google Chrome, Firefox, SeaMonkey, Mozilla, Galeon, Safari, Nescape,
957 Midori, and Emacs-W3 for cookie data."
962 (when (or (eq flavour 'chrome)
964 (let ((dir (paths-construct-path
965 '(".config" "google-chrome" "Default")
966 (user-home-directory))))
967 (and (file-exists-p (expand-file-name "Cookies" dir))
968 (setq cookies (lj-extract-sql-cookies
969 (expand-file-name "Cookies" dir) t))))
971 (throw 'found cookies)
972 (when (not (eq flavour 'auto))
973 (lj-get-cookies 'auto))))
975 ;; Firefox 1-3 (works for sqlite cookies, plain text cookies are
977 (when (or (eq flavour 'firefox)
979 (let ((d1 (paths-construct-path
980 '("Library" "Application Support" "Firefox" "Profiles")
981 (user-home-directory)))
982 (d2 (paths-construct-path
983 '(".mozilla" "firefox") (user-home-directory)))
985 (if (file-directory-p d1)
986 (setq dir (car (directory-files d1 t "\\.default$" nil 'dirs)))
987 (setq dir (car (directory-files d2 t "\\.default$" nil 'dirs))))
988 (or (and (file-exists-p (expand-file-name "cookies.txt" dir))
989 (setq cookies (lj-extract-text-cookies
990 (expand-file-name "cookies.txt" dir))))
991 (and (file-exists-p (expand-file-name "cookies.sqlite" dir))
992 (setq cookies (lj-extract-sql-cookies
993 (expand-file-name "cookies.sqlite" dir) nil)))))
995 (throw 'found cookies)
996 (when (not (eq flavour 'auto))
997 (lj-get-cookies 'auto))))
999 ;; SeaMonkey (untested)
1000 (when (or (eq flavour 'seamonkey)
1002 (when (file-directory-p (expand-file-name ".mozilla/seamonkey"
1003 (user-home-directory)))
1004 (let ((dir (car (directory-files "~/.mozilla/seamonkey"
1005 t "\\.default$" nil 'dirs))))
1006 (or (and (file-exists-p (expand-file-name "cookies.txt" dir))
1007 (setq cookies (lj-extract-text-cookies
1008 (expand-file-name "cookies.txt" dir))))
1009 (and (file-exists-p (expand-file-name "cookies.sqlite" dir))
1010 (setq cookies (lj-extract-sql-cookies
1011 (expand-file-name "cookies.sqlite" dir) nil))))))
1013 (throw 'found cookies)
1014 (when (not (eq flavour 'auto))
1015 (lj-get-cookies 'auto))))
1017 ;; Mozilla (untested)
1018 (when (or (eq flavour 'mozilla)
1020 (when (file-directory-p (expand-file-name ".mozilla"
1021 (user-home-directory)))
1022 (let ((d1 (paths-construct-path '(".mozilla" "default")
1023 (user-home-directory)))
1024 (d2 (paths-construct-path `(".mozilla" ,(user-login-name))
1025 (user-home-directory)))
1027 (if (file-directory-p d1)
1028 (setq dir (car (directory-files d1 t "\\.slt$" nil 'dirs)))
1029 (setq dir (car (directory-files d2 t "\\.slt$" nil 'dirs))))
1030 (and (file-exists-p (expand-file-name "cookies.txt" dir))
1031 (setq cookies (lj-extract-text-cookies
1032 (expand-file-name "cookies.txt" dir))))))
1034 (throw 'found cookies)
1035 (when (not (eq flavour 'auto))
1036 (lj-get-cookies 'auto))))
1038 ;; Galeon (untested)
1039 (when (or (eq flavour 'galeon)
1041 (let ((dir (paths-construct-path
1042 '(".galeon" "mozilla" "galeon") (user-home-directory))))
1043 (and (file-exists-p (expand-file-name "cookies.txt" dir))
1044 (setq cookies (lj-extract-text-cookies
1045 (expand-file-name "cookies.txt" dir)))))
1047 (throw 'found cookies)
1048 (when (not (eq flavour 'auto))
1049 (lj-get-cookies 'auto))))
1051 ;; Safari (untested)
1052 (when (or (eq flavour 'safari)
1054 (let ((dir (paths-construct-path '("Library" "Cookies")
1055 (user-home-directory))))
1056 (and (file-exists-p (expand-file-name "Cookies.plist" dir))
1057 (setq cookies (lj-extract-xml-cookies
1058 (expand-file-name "Cookies.plist" dir)))))
1060 (throw 'found cookies)
1061 (when (not (eq flavour 'auto))
1062 (lj-get-cookies 'auto))))
1064 ;; Netscape (untested)
1065 (when (or (eq flavour 'netscape)
1067 (let ((dir (paths-construct-path '(".netscape")
1068 (user-home-directory))))
1069 (and (file-exists-p (expand-file-name "cookies" dir))
1070 (setq cookies (lj-extract-text-cookies
1071 (expand-file-name "cookies" dir)))))
1073 (throw 'found cookies)
1074 (when (not (eq flavour 'auto))
1075 (lj-get-cookies 'auto))))
1077 ;; Midori (works, but Midori doesn't take too much care about
1078 ;; invalid or broken cookies so YMMV here)
1079 (when (or (eq flavour 'midori)
1081 (let ((dir (paths-construct-path '(".config" "midori")
1082 (user-home-directory))))
1083 (and (file-exists-p (expand-file-name "cookies.txt" dir))
1084 (setq cookies (lj-extract-text-cookies
1085 (expand-file-name "cookies.txt" dir)))))
1087 (throw 'found cookies)
1088 (when (not (eq flavour 'auto))
1089 (lj-get-cookies 'auto))))
1091 ;; Emacs-W3 URL (works with W3 in XE packages)
1092 (when (or (eq flavour 'w3)
1094 (and (file-exists-p url-cookie-file)
1095 (setq cookies (lj-extract-w3-cookies)))
1097 (throw 'found cookies)
1098 (when (not (eq flavour 'auto))
1099 (lj-get-cookies 'auto))))
1101 ;; Gah! no cookes anywhere!
1102 (error 'search-failed "LJ Cookie data"))))
1104 (defvar lj-cookies (lj-get-cookies lj-cookie-flavour)
1105 "Alist of cookie data to send to LJ.")
1107 ;; adapted from jwz-lj.el
1108 (defun lj-http-post (url cookies parser)
1109 "Sends a HTTP POST to URL with COOKIES.
1111 Argument PARSER is a function to handle parsing the output received."
1112 (unless (string-match "\\`https?://\\([^/]+\\)\\([^?&]+\\)\\?\\(.*\\)\\'" url)
1113 (error "Unparsable url: %s" url))
1114 (let* ((host (match-string 1 url))
1116 (path (match-string 2 url))
1117 (args (match-string 3 url))
1119 (concat "POST " path " HTTP/1.0\r\n"
1120 "Content-Type: application/x-www-form-urlencoded\r\n"
1121 "Content-Length: " (int-to-string (length args)) "\r\n"
1122 "Host: " host "\r\n"
1123 "X-LJ-Auth: cookie\r\n"
1127 (buf (generate-new-buffer " *LJ-process*"))
1129 (setq proc (open-network-stream "LiveJournal" buf host port))
1130 (when (lj-utf-emacs-p)
1131 (set-process-coding-system proc 'utf-8 'utf-8))
1132 (process-send-string proc post-cmd)
1133 (message "HTTP POST sent to %s" host)
1134 (while (eq (process-status proc) 'open)
1135 (unless (accept-process-output proc 60)
1136 (delete-process proc)
1137 (error "[LJ] Server error: timeout")))
1138 (funcall parser buf)))
1140 (defun lj-proc-success ()
1141 "Return t when LJ processes are successful.
1143 By \"successful\" we mean that livejournal.com didn't complain about
1144 anything we sent it."
1145 (let ((regex "^success\n\\(.*$\\)")
1148 (goto-char (point-min))
1149 (if (re-search-forward regex nil t)
1150 (setq result (match-string 1))
1151 (error "[LJ] Server error: try again later"))
1152 (cond ((string= result "OK")
1154 ((string= result "FAIL")
1155 (let ((ereg "^errmsg\n\\(.*$\\)"))
1157 (goto-char (point-min))
1158 (re-search-forward ereg)
1159 (if (string-match "Incorrect time value" (match-string 1))
1160 (lj-post 'out-of-order)
1161 (error "[LJ]: %s" (match-string 1))))))
1163 (error "[LJ]: Unknown error"))))))
1165 (defun lj-friends-proc-parser (buf)
1166 "Processes the output from `lj-get-friends-groups'.
1167 Argument BUF is the process buffer used."
1168 (let ((regexp "^frgrp_\\([0-9]+\\)_name\n\\(.*$\\)")
1170 (with-current-buffer buf
1171 (when (lj-proc-success)
1172 (goto-char (point-min))
1173 (while (re-search-forward regexp nil t)
1175 (cons (cons (match-string 2) (string-to-int (match-string 1)))
1179 (or (file-directory-p lj-directory)
1180 (make-directory-path lj-directory))
1181 (with-current-buffer (find-file-noselect lj-groups-file)
1183 (insert ";;; Automatically generated DO NOT EDIT -*- Emacs-Lisp -*-\n"
1184 (format "(setq lj-groups (quote %S))" groups))
1186 (eval-current-buffer nil)
1187 (kill-buffer nil))))))
1189 (defun lj-get-friends-groups ()
1190 "Retrieve an alist of groups/groupids from Livejournal."
1191 (let ((cookies (or lj-cookies
1192 (error "No LJ cookies found")))
1193 (url (concat lj-base-url
1194 "?mode=getfriendgroups"
1196 "&auth_method=cookie"
1197 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0)))))
1198 (lj-http-post url cookies #'lj-friends-proc-parser)))
1200 (defun lj-tags-proc-parser (buf)
1201 "Process the output from `lj-get-tags'.
1202 Argument BUF is the process buffer used."
1203 (let ((regexp "tag_[0-9]+_name\n\\(.*$\\)")
1205 (with-current-buffer buf
1206 (when (lj-proc-success)
1207 (goto-char (point-min))
1208 (while (re-search-forward regexp nil t)
1209 (push (match-string 1) tags))
1212 (or (file-directory-p lj-directory)
1213 (make-directory-path lj-directory))
1214 (with-current-buffer (find-file-noselect lj-tags-file)
1216 (insert ";;; Automatically generated DO NOT EDIT -*- Emacs-Lisp -*-\n"
1217 (format "(setq lj-tags (quote %S))" tags))
1219 (eval-current-buffer nil)
1220 (kill-buffer nil))))))
1222 (defun lj-get-tags ()
1223 "Retrieve a list of defined tags from Livejournal."
1224 (let ((cookies (or lj-cookies
1225 (error "No LJ cookies found")))
1226 (url (concat lj-base-url
1229 "&auth_method=cookie"
1230 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0)))))
1231 (lj-http-post url cookies #'lj-tags-proc-parser)))
1233 (defun lj-get-userpic-noffi (url file)
1234 "Download userpic from URL to FILE."
1235 (if (executable-find "curl")
1236 (shell-command (concat "curl " url " -so " file) nil)
1237 (error 'unimplemented "non-FFI leeching")))
1239 (defun lj-get-userpics ()
1240 "Leech your userpics from livejournal.com."
1241 (unless (file-directory-p lj-userpic-directory)
1242 (make-directory-path lj-userpic-directory))
1243 (let ((pics (mapcar #'car lj-pickws)))
1246 (unless (file-exists-p
1247 (expand-file-name p lj-userpic-directory))
1248 (let ((file (expand-file-name p lj-userpic-directory))
1249 (url (cdr (assoc p lj-pickws))))
1250 (if (featurep '(and sxemacs ffi-curl))
1251 (declare-fboundp (curl:download url file))
1252 (lj-get-userpic-noffi url file)))))
1255 (defun lj-pickws-proc-parser (buf)
1256 "Process the output from `lj-get-pickws'.
1257 Argument BUF is the process buffer used."
1258 (let ((msg "^message\n\\(.*$\\)")
1259 defaultk defaultu keywords)
1260 (with-current-buffer buf
1261 (when (lj-proc-success)
1262 (goto-char (point-min))
1264 (re-search-forward "defaultpicurl\n\\(.*$\\)")
1265 (setq defaultu (match-string 1))
1268 (re-search-forward (concat "^pickwurl_\\([0-9]+\\)\n"
1271 (goto-char (point-min))
1272 (re-search-forward (concat "^pickw_" defidx "\n\\(.*$\\)") nil t)
1273 (setq defaultk (match-string 1))
1274 (setq keywords (cons (cons defaultk defaultu) keywords))))
1276 (while (re-search-forward "^pickw_\\([0-9]+\\)\n\\(.*$\\)" nil t)
1277 (let* ((key (match-string 2))
1278 (url (save-excursion
1279 (goto-char (point-min))
1280 (and (re-search-forward
1282 (match-string 1) "\n\\(.*$\\)") nil t)
1283 (match-string 1)))))
1284 (unless (string= key defaultk)
1285 (setq keywords (cons (cons key url) keywords))))))
1286 (when (re-search-forward msg nil t)
1287 (pop-to-buffer (get-buffer-create "*LJ Message*"))
1288 (insert "Important Message From LiveJournal:\n"
1289 "==================================\n\n")
1290 (insert (match-string 1)))
1293 (or (file-directory-p lj-directory)
1294 (make-directory-path lj-directory))
1295 (with-current-buffer (find-file-noselect lj-pickws-file)
1297 (insert ";;; Automatically generated DO NOT EDIT -*- Emacs-Lisp -*-\n"
1298 (format "(setq lj-pickws (quote %S))" keywords))
1299 (insert (format "\n(setq lj-default-pickw %S)" defaultk))
1301 (eval-current-buffer nil)
1302 (kill-buffer nil))))
1305 (defun lj-get-pickws ()
1306 "Retieve an alist of userpic keyword/url pairs."
1307 (let ((cookies (or lj-cookies
1308 (error "No LJ cookies found")))
1309 (url (concat lj-base-url
1312 "&auth_method=cookie"
1313 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0))
1314 "&clientversion=" lj-clientversion
1316 "&getpickwurls=1")))
1317 (lj-http-post url cookies #'lj-pickws-proc-parser)))
1319 (defun lj-moods-proc-parser (buf)
1320 "Process the output from `lj-get-moods'.
1321 Argument BUF is the process buffer used."
1322 (let ((regexp "mood_[0-9]+_id\n\\(.*\\)\nmood_[0-9]+_name\n\\(.*\\)")
1323 (msg "^message\n\\(.*$\\)")
1325 (with-current-buffer buf
1326 (when (lj-proc-success)
1327 (goto-char (point-min))
1329 (while (re-search-forward regexp nil t)
1330 (setq moods (cons (cons (match-string 2)
1331 (string-to-int (match-string 1)))
1333 (when (re-search-forward msg nil t)
1334 (pop-to-buffer (get-buffer-create "*LJ Message*"))
1335 (insert "Important Message From LiveJournal:\n"
1336 "==================================\n\n")
1337 (insert (match-string 1)))
1339 (or (file-directory-p lj-directory)
1340 (make-directory-path lj-directory))
1341 (with-current-buffer (find-file-noselect lj-moods-file)
1343 (insert ";;; Automatically generated DO NOT EDIT -*- Emacs-Lisp -*-\n"
1344 (format "(setq lj-moods (quote %S))" moods))
1346 (eval-current-buffer nil)
1347 (kill-buffer nil)))))
1349 (defun lj-get-moods ()
1350 "Retieve an alist of mood/moodid pairs."
1351 (let ((cookies (or lj-cookies
1352 (error "No LJ cookies found")))
1353 (url (concat lj-base-url
1356 "&auth_method=cookie"
1357 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0))
1358 "&clientversion=" lj-clientversion
1360 (lj-http-post url cookies #'lj-moods-proc-parser)))
1362 (defvar lj-last-user-set-time nil)
1364 ;; adapted from jwz-lj.el
1365 (defun lj-construct-url (subject body user
1366 &optional security tags community
1367 auto-format no-comments mood location
1368 music pickw date backdated)
1369 "Construct a URL to use for posting to LiveJournal.
1371 Argument SUBJECT, a string, which is the title of the post.
1372 Argument BODY, a string, is the body of the post.
1373 Argument USER, a string, is the LJ userid to post as.
1375 Optional argument SECURITY, a string, is the security level this post
1376 will have. The default is `lj-default-security-level'.
1378 Optional argument TAGS, a string, which is a comma delimited list of
1379 tags to add to this post.
1381 Optional argument COMMUNITY, a string, which is the name of a LJ forum
1382 to send this post to instead of the user's blog.
1384 Optional argument AUTO-FORMAT, when non-nil request that the LJ server
1385 automatically formats the post. The default is nil, which means the
1386 post should NOT be auto formatted by LJ.
1388 Optional argument NO-COMMENTS, when non-nil means to turn off comments
1391 Optional argument MOOD, a string or an integer, is the post's \"mood\"
1392 header. If it is an integer, it is a \"mood id\" which is mapped to a
1395 Optional argument LOCATION, a string, free-form text describing your
1396 current location. Livejournal turns it into a search URL to google
1399 Optional argument MUSIC, a string, of the currently playing mp3/ogg.
1401 Optional argument PICKW, a string, of the userpic keyword to use. If
1402 omitted, your default LJ userpic will be used.
1404 Optional argument DATE, an internal time value as returned by
1405 `encode-time'. Used to set a date/time on a post, if omitted the
1406 current time is used.
1408 Optional boolean argument BACKDATED, causes the \"backdated\" flag to be
1409 set which will prevent the post from showing up on friends pages."
1410 (let* ((friends-mask nil)
1411 (tl (split-string-by-char
1412 (format-time-string "%Y,%m,%d,%H,%M"
1413 (or date (current-time))) ?,))
1419 (ctime (apply #'encode-btime (lj-parse-time-string
1420 (format "%s-%s-%s %s:%s"
1421 year month day hour minute))))
1422 (ltime (or lj-last-entry-btime (and (lj-get-last-entry-btime)
1423 lj-last-entry-btime)))
1425 ;; save custom date in case something goes wrong
1427 (setq lj-last-user-set-time date)
1428 (setq lj-last-user-set-time nil))
1429 (setq subject (lj-hexify-string subject t))
1430 (setq body (lj-hexify-string body t))
1432 (if (not (string-match "p\\(ublic\\|rivate\\)" security))
1433 (if (string= "usemask" security)
1434 (setq friends-mask 1)
1435 (let* ((groups (or lj-groups (lj-get-friends-groups)))
1436 (id (cdr (assoc security groups))))
1438 (setq security "usemask"
1439 friends-mask (lsh 1 id))
1440 (error "Unknown friends group: %s" security)))))
1441 (setq security (lj-hexify-string security t))
1443 (if (> (length tags) 0)
1444 (setq tags (lj-hexify-string tags t))
1447 (cond ((cdr (assoc mood lj-moods))
1448 (setq mood (cdr (assoc mood lj-moods))))
1449 ((and (stringp mood)
1450 (> (length mood) 0))
1451 (setq mood (lj-hexify-string mood t)))
1452 ((integerp mood) nil)
1456 (if (> (length music) 0)
1457 (setq music (lj-hexify-string music t))
1460 (if (> (length pickw) 0)
1461 (setq pickw (lj-hexify-string pickw t))
1464 (if (> (length community) 0)
1465 (setq community (lj-hexify-string community t))
1466 (setq community nil))
1468 (if (> (length location) 0)
1469 (setq location (lj-hexify-string location t))
1470 (setq location nil))
1471 ;; maybe force opt_backdated
1472 (when (> ltime ctime)
1479 "&auth_method=cookie"
1480 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0))
1482 "&security=" security
1484 (format "&allowmask=%d" friends-mask))
1486 (format "&prop_taglist=%s" tags))
1488 (format "&usejournal=%s" community))
1496 (format "&prop_current_moodid=%d" mood)
1497 (format "&prop_current_mood=%s" mood)))
1499 (format "&prop_current_music=%s" music))
1501 (format "&prop_current_location=%s" location))
1503 (format "&prop_picture_keyword=%s" pickw))
1504 (unless (zerop lj-qotd)
1505 (format "&prop_qotdid=%d" lj-qotd))
1506 "&prop_opt_backdated=" (if backdated "1" "0")
1507 "&prop_opt_preformatted=" (if auto-format "0" "1")
1508 "&prop_opt_nocomments=" (if no-comments "1" "0")
1509 "&prop_useragent=" (lj-hexify-string lj-useragent)
1513 (defun lj-cut-toggle-top ()
1514 "Toggle view of LJ CUT text."
1517 (goto-char (point-at-eol))
1519 (set-extent-property
1520 (extent-at (point) nil 'ljcut)
1521 'invisible (not (extent-property
1522 (extent-at (point) nil 'ljcut) 'invisible)))))
1525 (defun lj-cut-mouse-toggle-top (event)
1526 "Toggle view of LJ CUT text under EVENT."
1528 (let ((epoint (event-point event)))
1531 (goto-char (point-at-eol))
1533 (set-extent-property
1534 (extent-at (point) nil 'ljcut)
1535 'invisible (not (extent-property
1536 (extent-at (point) nil 'ljcut) 'invisible))))))
1538 (defun lj-cut-toggle-bottom ()
1539 "Toggle view of LJ CUT text."
1542 (goto-char (point-at-bol))
1544 (set-extent-property
1545 (extent-at (point) nil 'ljcut)
1546 'invisible (not (extent-property
1547 (extent-at (point) nil 'ljcut) 'invisible)))))
1549 (defun lj-cut-mouse-toggle-bottom (event)
1550 "Toggle view of LJ CUT text under EVENT."
1552 (let ((epoint (event-point event)))
1555 (goto-char (point-at-bol))
1557 (set-extent-property
1558 (extent-at (point) nil 'ljcut)
1559 'invisible (not (extent-property
1560 (extent-at (point) nil 'ljcut) 'invisible))))))
1562 (defvar lj-cut-keymap-top
1563 (let ((map (make-sparse-keymap)))
1564 (set-keymap-name map 'lj-cut-keymap-top)
1565 (define-key map [return] #'lj-cut-toggle-top)
1566 (define-key map [button2] #'lj-cut-mouse-toggle-top)
1568 "Keymap for LJ CUT extents.")
1570 (defvar lj-cut-keymap-bottom
1571 (let ((map (make-sparse-keymap)))
1572 (set-keymap-name map 'lj-cut-keymap-bottom)
1573 (define-key map [return] #'lj-cut-toggle-bottom)
1574 (define-key map [button2] #'lj-cut-mouse-toggle-bottom)
1576 "Keymap for LJ CUT extents.")
1578 (defun lj-cut-region (b e)
1579 "Mark text in the region B to E as an LJ CUT.
1581 The text that is to be hidden behind the LJ CUT is made invisible in
1582 the buffer. The visibility can be toggled with Return or Button2 on
1583 either of the lj-cut delimiters."
1585 (let ((echo "Ret / Button2 Toggle View")
1588 (narrow-to-region b e)
1589 (lj-text-to-html (point-min) (point-max))
1590 (set-extent-properties
1591 (setq ext (make-extent (point-min) (point-max)))
1592 '(start-open t end-open t invisible t ljcut t))
1593 (goto-char (point-min))
1594 (set-extent-properties
1595 (insert-face "<lj-cut text=\"---More---\">" 'widget-button-face)
1598 keymap ,lj-cut-keymap-top
1599 mouse-face font-lock-warning-face))
1601 (goto-char (point-max))
1602 (set-extent-properties
1603 (insert-face "</lj-cut>" 'widget-button-face)
1606 keymap ,lj-cut-keymap-bottom
1607 mouse-face font-lock-warning-face))
1609 (set-extent-properties
1611 '(start-open nil end-open nil))
1612 (run-hooks 'lj-cut-hook)))
1614 (defvar lj-poll-types '("radio" "check" "drop" "text" "scale")
1617 (defun lj-insert-poll (name type question)
1618 "Insert a poll into a LJ post.
1619 Argument NAME is the title of the poll.
1620 Argument TYPE is the type of poll \(see `lj-poll-types'\).
1621 Argument QUESTION is the poll question, or \"topic\"."
1623 (list (read-string "Poll Title: " nil nil "unnamed poll")
1624 (completing-read "Poll Type (default \"radio\"): "
1625 (mapcar #'list lj-poll-types)
1626 nil t nil nil "radio")
1627 (read-string "Poll Question: ")))
1628 (let ((voters (completing-read "Who can vote (default \"all\"): "
1629 (mapcar #'list '("all" "friends"))
1630 nil t nil nil "all"))
1631 (viewers (completing-read "Who can view results (default \"all\"): "
1632 (mapcar #'list '("all" "friends" "none"))
1633 nil t nil nil "all"))
1636 (format "\n<lj-poll name=\"%s\" whovote=\"%s\" whoview=\"%s\">"
1637 name voters viewers)
1638 (format "\n<lj-pq type=\"%s\"" type))
1640 ((string= "scale" type)
1641 (let ((low (read-number "Scale low mark (int): " t "1"))
1642 (high (read-number "Scale high mark (int): " t "10"))
1643 (step (read-number "Stepping: " t "1")))
1644 (insert (format " from=\"%d\" to=\"%d\" by=\"%d\">"
1646 (format "\n%s" question))))
1647 ((string= "text" type)
1648 (let* ((size (read-number "Text box size: " t "50"))
1649 (max (read-number "Max answer length: " t
1650 (number-to-string (1- size)))))
1651 (insert (format " size=\"%d\" maxlength=\"%d\">" size max)
1652 (format "\n%s" question))))
1653 (t (insert (format ">\n%s" question))))
1654 (unless (string-match "scale\\|text" type)
1656 (while (not (zerop (length x)))
1657 (setq x (read-string "Poll Answer (RET to finish): "))
1658 (or (zerop (length x))
1659 (insert (format "\n<lj-pi>%s</lj-pi>" x))))))
1660 (insert "\n</lj-pq>"
1662 (indent-region p (point) nil)
1663 (run-hooks 'lj-poll-hook)))
1665 ;; Apparantly the _VALID_ markup that this function produces causes
1666 ;; some (all?) versions of M$ Internet Exploiter to buffer the entire
1667 ;; movie before beginning playback. Hey, lets call it a FEATURE!
1668 (defun lj-insert-youtube (url)
1669 "Insert a Google or Youtube video URL into a LJ post."
1670 (interactive "sVideo URL: ")
1671 (let* ((googlep (string-match "^http://video\\.google\\.com/.*$" url))
1672 (youtubep (string-match "^http://\\(www\\.\\)?youtube\\.com/.*$" url))
1673 (w (if googlep 420 400))
1674 (h (if googlep 352 338))
1676 (unless (or googlep youtubep)
1677 (error "Invalid Google/Youtube URL: %s" url))
1678 (insert (format "\n<object width=\"%d\" height=\"%d\"" w h)
1679 "\ntype=\"application/x-shockwave-flash\"")
1681 (setq url (replace-regexp-in-string "/videoplay\\?"
1682 "/googleplayer.swf?" url))
1683 (setq url (replace-regexp-in-string "\\(/watch\\)?\\?v=" "/v/" url)))
1684 (setq url (replace-regexp-in-string "&.*$" "" url))
1685 (insert (format "\ndata=\"%s\">" url)
1686 "\n<param name=\"movie\""
1687 (format "\nvalue=\"%s\" />" url)
1689 (indent-region p (point) nil)
1690 (run-hooks 'lj-youtube-hook)))
1692 (defun lj-insert-journal (name &optional community)
1693 "Insert a link to NAME journal or LJ community into an LJ post.
1695 Optional prefix argument, COMMUNITY means the link is to a LJ community
1696 instead of a LJ user's journal."
1697 (interactive "sUser or Community name: \nP")
1698 (let ((type (if current-prefix-arg "comm" "user"))
1700 (insert (format "\n<lj %s=\"%s\" />\n" type name))
1701 (indent-region p (point) nil)
1702 (run-hooks 'lj-journal-hook)))
1704 (defvar lj-abbrev-table nil
1705 "Abbrev table to use in `lj-mode'.")
1706 (define-abbrev-table 'lj-abbrev-table ())
1708 (define-derived-mode lj-mode html-mode "LJ"
1709 "This is a mode for composing LiveJournal posts.
1710 Its parent modes are `html-mode' and `sgml-mode' so everything you
1711 need to construct good clean HTML should be right at your fingertips.
1713 LJ specific bindings:
1715 \\[lj-post]\tSubmit post to LiveJournal
1716 \\[lj-preview]\t\tPreview post in web browser
1717 \\[lj-validate]\t\tValidate the markup in the post
1719 \\[lj-writers-block]\t\tAnswer a LJ \"Writer's Block\" question
1721 \\[lj-cut-region]\t\tHide text behind a LJ \"cut\"
1722 \\[lj-insert-journal]\t\tInsert a journal link
1723 \\[lj-insert-poll]\t\tInsert a poll
1724 \\[lj-insert-youtube]\t\tInsert a Google or YouTube Video
1726 \\[lj-goto-subject]\tMove to the Subject header
1727 \\[lj-goto-fcc]\tMove to the FCC header
1728 \\[lj-goto-bcc]\tMove to the BCC header
1729 \\[lj-goto-community]\tMove to the Community header
1730 \\[lj-goto-music]\tMove to the Music header
1731 \\[lj-goto-security]\tMove to the Security header
1732 \\[lj-goto-mood]\tMove to the Mood header
1733 \\[lj-goto-location]\tMove to the Location header
1734 \\[lj-goto-userpic]\tMove to the Userpic header
1735 \\[lj-goto-tags]\tMove to the Tags header
1736 \\[lj-goto-body]\tMove to the post body
1738 \\[lj-customise-faces]\t\tSet the header faces
1739 \\[lj-customise-group]\t\tSet the user options
1746 :abbrev-table lj-abbrev-table
1750 (add-hook 'lj-mode-hook #'font-lock-mode)
1752 (defun lj-make-archive-name ()
1753 "Compute a filename for archiving LJ posts.
1755 The filenames are of the format... `ljp-YYYYMMDDHHMM'."
1756 (let ((file (format-time-string "ljp-%Y%m%d%H%M"))
1757 (dir lj-archive-directory))
1758 (expand-file-name file dir)))
1760 (defun lj-generate-new-buffer ()
1761 "Create a new buffer for writing a new LJ post."
1762 (or (file-directory-p lj-drafts-directory)
1763 (make-directory-path lj-drafts-directory))
1766 (expand-file-name (format-time-string "ljd-%Y%m%d%H%M")
1767 lj-drafts-directory)))
1768 (rename-buffer "*LJ-Post*" 'unique)
1769 (when (lj-utf-emacs-p)
1770 (set-buffer-file-coding-system 'utf-8))
1772 (make-extent (point-min) (point-at-eol))
1773 (insert "Subject: \n")
1774 (when lj-archive-posts
1775 (or (file-directory-p lj-archive-directory)
1776 (make-directory-path lj-archive-directory))
1777 (insert (format "FCC: %s\n" (lj-make-archive-name))))
1778 (when (stringp lj-bcc-address)
1779 (insert (format "BCC: %s\n" lj-bcc-address)))
1780 (insert (format "Security: %s\n" lj-default-security-level))
1781 (when (stringp lj-default-location)
1782 (insert (format "Location: %s\n" lj-default-location)))
1783 (when (functionp (symbol-value 'lj-music))
1784 (insert (format "Music: %s\n" (funcall lj-music))))
1786 (when-boundp 'lj-default-pickw
1787 (insert (format "Userpic: %s\n" lj-default-pickw))
1788 (lj-update-userpic-glyph (expand-file-name lj-default-pickw
1789 lj-userpic-directory)))
1792 (set-extent-property
1793 (insert-face "</head>\n" 'default) 'invisible t)
1794 (insert lj-header-separator "\n")
1796 (save-excursion (insert "\n\n" lj-signature)))
1799 (defun lj-goto-subject (&optional nocreate)
1800 "Move to the Subject header of an LJ post buffer.
1802 The header is created if it doesn't exist, unless optional argument
1803 NOCREATE is non-nil."
1805 (goto-char (point-min))
1806 (or (re-search-forward "^Subject: " nil 'missing)
1808 (goto-char (point-min))
1809 (insert "Subject: ")
1810 (backward-char 1))))
1812 (defun lj-goto-fcc (&optional nocreate)
1813 "Move to the FCC header of an LJ post buffer.
1815 The header is created if it doesn't exist, unless optional argument
1816 NOCREATE is non-nil."
1818 (goto-char (point-min))
1819 (or (re-search-forward "^FCC: " nil 'missing)
1821 (goto-char (point-min))
1823 (backward-char 1))))
1825 (defun lj-goto-bcc (&optional nocreate)
1826 "Move to the BCC header of an LJ post buffer.
1828 The header is created if it doesn't exist, unless optional argument
1829 NOCREATE is non-nil."
1831 (goto-char (point-min))
1832 (or (re-search-forward "^BCC: " nil 'missing)
1834 (goto-char (point-min))
1836 (backward-char 1))))
1838 (defun lj-goto-security (&optional nocreate)
1839 "Move to the Security header of an LJ post buffer.
1841 The header is created if it doesn't exist, unless optional argument
1842 NOCREATE is non-nil."
1844 (goto-char (point-min))
1845 (or (re-search-forward "^Security: " nil 'missing)
1847 (goto-char (point-min))
1848 (insert "Security: \n")
1849 (backward-char 1))))
1851 (defun lj-goto-community (&optional nocreate)
1852 "Move to the Community header of an LJ post buffer.
1854 The header is created if it doesn't exist, unless optional argument
1855 NOCREATE is non-nil."
1857 (goto-char (point-min))
1858 (or (re-search-forward "^Community: " nil 'missing)
1860 (goto-char (point-min))
1861 (insert "Community: \n")
1862 (backward-char 1))))
1864 (defun lj-goto-location (&optional nocreate)
1865 "Move to the Location header of an LJ post buffer.
1867 The header is created if it doesn't exist, unless optional argument
1868 NOCREATE is non-nil."
1870 (goto-char (point-min))
1871 (or (re-search-forward "^Location: " nil 'missing)
1873 (goto-char (point-min))
1874 (insert "Location: \n")
1875 (backward-char 1))))
1877 (defun lj-goto-mood (&optional nocreate)
1878 "Move to the Mood header of an LJ post buffer.
1880 The header is created if it doesn't exist, unless optional argument
1881 NOCREATE is non-nil."
1883 (goto-char (point-min))
1884 (or (re-search-forward "^Mood: " nil 'missing)
1886 (goto-char (point-min))
1888 (backward-char 1))))
1890 (defun lj-goto-music (&optional nocreate)
1891 "Move to the Music header of an LJ post buffer.
1893 The header is created if it doesn't exist, unless optional argument
1894 NOCREATE is non-nil."
1896 (goto-char (point-min))
1897 (or (re-search-forward "^Music: " nil 'missing)
1899 (goto-char (point-min))
1900 (insert "Music: \n")
1901 (backward-char 1))))
1903 (defun lj-goto-userpic (&optional nocreate)
1904 "Move to the Userpic header of an LJ post buffer.
1906 The header is created if it doesn't exist, unless optional argument
1907 NOCREATE is non-nil."
1909 (goto-char (point-min))
1910 (or (re-search-forward "^Userpic: " nil 'missing)
1912 (goto-char (point-min))
1913 (insert "Userpic: \n")
1914 (backward-char 1))))
1916 (defun lj-goto-tags (&optional nocreate)
1917 "Move to the Tags header of an LJ post buffer.
1918 The header is created if it doesn't exist unless NOCREATE is non-nil."
1920 (goto-char (point-min))
1921 (or (re-search-forward "^Tags: " nil 'missing)
1923 (goto-char (point-min))
1925 (backward-char 1))))
1927 (defun lj-goto-body ()
1928 "Move to the body of an LJ post buffer."
1930 (goto-char (point-min))
1931 (re-search-forward (regexp-quote lj-header-separator) nil t)
1933 (goto-char (point-at-bol)))
1935 (defun lj-current-header ()
1936 "Return the name of the LJ header on the current line, or nil."
1937 (let ((hregex lj-header-regexp)
1938 (separator (regexp-quote lj-header-separator)))
1939 (if (save-excursion (re-search-forward separator nil t))
1941 (narrow-to-region (point-at-bol) (point-at-eol))
1942 (string-match hregex (buffer-string))
1943 (substring (buffer-string) (match-beginning 1) (match-end 1)))
1946 (defun lj-header-content (header)
1947 "Return the content of HEADER as a string."
1948 (let ((goto (intern-soft (concat "lj-goto-" (downcase header)))))
1950 (funcall goto 'nocreate)
1951 (buffer-substring-no-properties (point) (point-at-eol)))))
1953 (defun lj-update-userpic-glyph (glyph)
1954 "Update the userpic, GLYPH, displayed in the LJ-Post buffer."
1955 (let ((ext (extent-at (point-min)))
1956 (type (if (featurep '(and sxemacs ffi-magic))
1957 (downcase (car (split-string-by-char
1959 (magic:file-type glyph)) ?\ )))
1961 (cadr (split-string-by-char
1962 (shell-command-to-string (concat "file " glyph))
1964 (set-extent-begin-glyph
1966 (list (vector (intern-soft type)
1967 :data (with-temp-buffer
1968 (insert-file-contents-literally glyph)
1969 (buffer-string))))))))
1971 ;; Header completion
1972 (defvar lj-completion-time 3
1973 "Time in seconds before completion list is reset.")
1975 (defvar lj-completion-timer (make-itimer)
1976 "Completion timer.")
1978 (defvar lj-completion-list nil
1981 (defvar lj-header-syntax-table
1982 (let ((table (copy-syntax-table text-mode-syntax-table)))
1983 (modify-syntax-entry ?~ "w " table)
1984 (modify-syntax-entry ?` "w " table)
1985 (modify-syntax-entry ?- "w " table)
1986 (modify-syntax-entry ?_ "w " table)
1987 (modify-syntax-entry ?+ "w " table)
1988 (modify-syntax-entry ?{ "w " table)
1989 (modify-syntax-entry ?[ "w " table)
1990 (modify-syntax-entry ?} "w " table)
1991 (modify-syntax-entry ?] "w " table)
1992 (modify-syntax-entry ?\\ "w " table)
1993 (modify-syntax-entry ?| "w " table)
1994 (modify-syntax-entry ?\; "w " table)
1995 (modify-syntax-entry ?' "w " table)
1996 (modify-syntax-entry ?< "w " table)
1997 (modify-syntax-entry ?> "w " table)
1998 (modify-syntax-entry ?# "w " table)
1999 (modify-syntax-entry ?\ "w " table)
2000 (modify-syntax-entry ?. "w " table)
2002 "Syntax table used in funky header cycling completion.")
2004 (defun lj-init-completion-timer ()
2005 "Initialise the completion timer."
2006 (let ((timer lj-completion-timer))
2007 (set-itimer-function timer #'(lambda ()
2008 (setq lj-completion-list nil)))
2009 (set-itimer-value timer lj-completion-time)))
2010 (add-hook 'lj-init-hook #'lj-init-completion-timer)
2012 (defsubst lj-cycle-list (list &optional reverse)
2013 "Return a list of head of LIST, and LIST rotated 1 place forward.
2015 If optional argument, REVERSE is non-nil, rotate the list in the other
2017 (if (featurep 'sxemacs)
2018 (let ((list (apply #'dllist list))
2021 (dllist-rrotate list)
2022 (dllist-lrotate list))
2023 (setq name (dllist-car list))
2024 (list name (dllist-to-list list)))
2027 (let* ((name (car (last list)))
2028 (l1 (cdr (reverse list)))
2032 (let* ((name (cadr list))
2035 (list (append list (list oldcar))))
2036 (list name list)))))
2038 (defsubst lj-set-completion-timer ()
2039 "(Re)set completion timer's value."
2040 (let ((timer lj-completion-timer))
2041 (and (itimerp timer)
2042 (set-itimer-value timer lj-completion-time))))
2044 (defun lj-complete-header-backwards ()
2045 "Complete header, cycling backwards."
2047 (and (lj-current-header)
2048 (lj-complete-header 'reverse)
2049 (when (string-match (lj-current-header) "Userpic")
2050 (when (file-exists-p (expand-file-name
2051 (lj-header-content "userpic")
2052 lj-userpic-directory))
2053 (lj-update-userpic-glyph
2054 (expand-file-name (lj-header-content "userpic")
2055 lj-userpic-directory))))))
2057 (defun lj-complete-header (&optional reverse)
2058 "Completion for LJ headers.
2060 This completion does not pop up any completion buffers, instead it
2061 cycles through the possible completions \"in-place\" with each
2064 With non-nil optional argument, REVERSE, the cycling goes in the other
2067 (unless lj-completion-list
2068 (unless (itimer-live-p lj-completion-timer)
2069 (lj-set-completion-timer)
2070 (activate-itimer lj-completion-timer))
2071 (let* ((completion-ignore-case t)
2072 (type (lj-current-header))
2073 (table (cond ((string= type "Security")
2074 (let ((groups (copy-sequence
2078 ("usemask" . ?c))))))
2079 (sort* groups #'string-lessp :key #'car)))
2080 ((string= type "Mood")
2081 (let ((moods (copy-sequence lj-moods)))
2082 (sort* moods #'string-lessp :key #'car)))
2083 ((string= type "Userpic")
2084 (let ((pics (copy-sequence lj-pickws)))
2085 (sort* pics #'string-lessp :key #'car)))
2086 ((string= type "Tags")
2087 (let ((tags (mapcar #'(lambda (e) (cons e ?a))
2089 (sort* tags #'string-lessp :key #'car)))
2090 (t (error 'invalid-argument type))))
2091 (current (if (string-match (current-word) type)
2094 (completion (try-completion current table))
2095 (all (all-completions current table)))
2096 (if (null completion)
2097 (message "Can't find completion for \"%s\"" current)
2098 (setq lj-completion-list all))))
2099 (when lj-completion-list
2100 (multiple-value-bind (completion newlist)
2101 (lj-cycle-list lj-completion-list reverse)
2102 (setq lj-completion-list newlist)
2103 (with-syntax-table lj-header-syntax-table
2104 (unless (string= "" (current-word))
2107 (unless (string-match (lj-current-header) (current-word))
2108 (backward-delete-word)))
2109 (insert " " completion)))
2110 (lj-set-completion-timer)))
2112 (defun lj-sgml-indent-tab-or-complete (&optional refresh)
2113 "Does completion if in LJ headers, `sgml-indent-or-tab' otherwise.
2115 If point is after the header separator, this function simply calls
2116 `sgml-indent-or-tab'. If point is in the headers section it will do
2117 completion relevent to the header on the current line.
2119 Please note that this is \"inline\" completion, that means you won't
2120 be prompted for anything in the minibuffer. The completions will
2121 cycle directly in the LJ-post buffer.
2123 The different header completions are:
2125 Subject: Sweet bugger all. Sorry, haven't perfected read-mind-mode
2128 FCC: Computes a new archive filename.
2130 BCC: BBDB email addresses
2132 Security: Completes valid security levels. With prefix arg REFRESH,
2133 update your list of friends groups from livejournal.com
2135 Community: No completion, just insert a TAB.
2137 Music: Refreshes to the currently current song
2139 Mood: Completes moods. With prefix arg REFRESH, update the list
2140 of moods from livejournal.com.
2142 Location: No completion.
2144 Userpic: Completes list of LJ userpic keywords you have defined.
2145 With prefix arg REFRESH, update you list of userpic
2148 Tags: Multiple completion from your list of previously used tags.
2149 With prefix arg REFRESH, update your list of tags from
2152 (let ((header (lj-current-header)))
2154 (cond ((string= header "Subject")
2155 (error "Sorry, me crystal ball is in for repairs"))
2156 ((string= header "FCC")
2157 (let ((new (lj-make-archive-name)))
2158 (goto-char (point-at-bol))
2159 (re-search-forward "^FCC: " (point-at-eol))
2160 (delete-region (point) (point-at-eol))
2162 ((string= header "BCC")
2163 (if-fboundp #'bbdb-complete-name
2165 (goto-char (point-at-eol))
2166 (bbdb-complete-name))
2168 ((string= header "Security")
2169 (when (or refresh (not lj-groups))
2170 (lj-get-friends-groups))
2171 (goto-char (point-at-bol))
2172 (re-search-forward "^Security: " (point-at-eol))
2173 (lj-complete-header))
2174 ((string= header "Community")
2175 (goto-char (point-at-eol))
2177 ((string= header "Music")
2178 (let ((current (and (functionp (symbol-value 'lj-music))
2179 (funcall lj-music))))
2181 (goto-char (point-at-bol))
2182 (re-search-forward "^Music: " (point-at-eol))
2183 (delete-region (point) (point-at-eol))
2185 ((string= header "Mood")
2186 (when (or refresh (not lj-moods))
2188 (goto-char (point-at-bol))
2189 (re-search-forward "^Mood: " (point-at-eol))
2190 (lj-complete-header))
2191 ((string= header "Location")
2192 (error "If you don't know, I can't help you"))
2193 ((string= header "Userpic")
2194 (when (or refresh (not lj-pickws))
2196 (goto-char (point-at-bol))
2197 (re-search-forward "^Userpic: " (point-at-eol))
2198 (lj-complete-header)
2199 (when (file-exists-p (expand-file-name
2200 (lj-header-content "userpic")
2201 lj-userpic-directory))
2202 (lj-update-userpic-glyph
2203 (expand-file-name (lj-header-content "userpic")
2204 lj-userpic-directory))))
2205 ((string= header "Tags")
2206 (when (or refresh (not lj-tags))
2208 (lj-complete-header))
2210 (error "Unknown LJ header: %s" header)))
2211 (sgml-indent-or-tab))))
2213 (defregexp lj-url-regexp
2214 (concat "\\(https?://\\|s?ftp://\\|gopher://\\|telnet://"
2215 "\\|wais://\\|file:/\\|s?news:\\)"
2216 "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;\\(>\\)]+")
2217 "A regular expression matching URL's.")
2219 (defregexp lj-email-regexp
2220 "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
2221 "A regular expression matching email addresses.")
2223 (defun lj-text-to-html (beg end &optional nopbr)
2224 "Convert the plain text in the region BEG - END to html.
2226 With optional argument, NOPBR, don't add <p>..</p> or <br /> tags.
2228 This is an extremely basic converter. All it really does is wrap
2229 paragraphs in <p>...</p>, and add <br /> to the end of each non-blank
2230 line. It will also convert old 70's style text highlighting to the
2231 HTML equivalent. e.g. _text_ -> <u>text</u>, *text* -> <b>text</b>.
2232 It also converts non-ASCII to HTML entities, and converts URL's and
2233 email addresses to hyperlinks. Email addresses are obfuscated in an
2234 attempt to protect against spam harvesters.
2236 Apart from the bold, underline, and hyperlink stuff, that's all the
2237 eye-candy you'll get. Forget fonts, colours, tables, and lists.
2238 That's not what this is about. The idea is to keep the text as close
2239 to \"as-is\" without resorting to using <pre>...</pre> tags.
2241 Calling this function on text that contains \"<lj*>\" will break those
2242 tags. So take note of what you are doing."
2243 (let ((replacements '(("&" . "&")
2244 ("\\.\\.\\." . "…")
2248 ("_\\(.*\\)_" . "<u>\\1</u>")
2249 ("\\*\\(.*\\)\\*" . "<b>\\1</b>")))
2251 (email lj-email-regexp))
2253 (add-to-list 'replacements
2254 (cons (if (featurep 'sxemacs)
2255 "\\([[:alnum:][:punct:]]\\)\n"
2256 "\\([a-zA-Z0-9]\\|\\s.\\)\n")
2257 "\\1<br />\n") 'append))
2259 (narrow-to-region beg end)
2260 (goto-char (point-min))
2265 (while (re-search-forward (car rep) nil t)
2266 (replace-match (cdr rep) t))))
2274 (narrow-to-region (point) (mark))
2275 (goto-char (point-min))
2277 (goto-char (point-max))
2279 (forward-paragraph))))
2282 (while (re-search-forward url nil t)
2283 (replace-match "<a href=\"\\&\">\\&</a>")))
2286 (while (re-search-forward email nil t)
2287 (replace-match "<a href=\"mailto:\\&\">\\&</a>"))
2288 (while (search-backward "@" nil t)
2289 (replace-match "@" nil t)))
2292 (lj-entify-region (point-min) (point-max))))
2293 (when (region-exists-p)
2294 (zmacs-deactivate-region))))
2296 (defun lj-ljtags-to-html ()
2297 "Convert \"<lj-*>\" tags to something resembling HTML.
2299 This function is used so that the markup in a post can be validated
2300 before it is submitted, and also so the post can be previewed before
2301 it is submitted. Do not expect anything fancy."
2302 (goto-char (point-min))
2305 (while (re-search-forward "<lj-\\(poll\\)" nil t)
2306 (let ((p (point-at-bol)))
2307 (search-forward (concat "</lj-" (match-string 1) ">") nil t)
2309 (narrow-to-region p (point))
2310 (lj-text-to-html (point-min) (point-max) 'nopbr)
2311 (goto-char (point-min))
2312 (insert "<div class=\"ljpoll\">\n<pre>\n")
2313 (goto-char (point-max))
2314 (insert "\n</pre>\n</div>")))))
2317 (while (re-search-forward "^</?lj-cut\\( text=\"---More---\"\\)?>$" nil t)
2318 (lj-text-to-html (match-beginning 0) (match-end 0) 'nopbr)))
2320 (while (re-search-forward "<lj-cut" nil t)
2321 (replace-match "<div class=\"ljcut\">\n\\&")
2322 (re-search-forward "</lj-cut>" nil t)
2323 (replace-match "\\&\n</div>")))
2326 (while (re-search-forward "<lj user=\"\\(.*\\)\" />" nil t)
2327 (replace-match "<a href=\"http://\\1.livejournal.com/profile\">
2328 <img src=\"http://p-stat.livejournal.com/img/userinfo.gif\"
2329 alt=\"[info]\" width=\"17\" height=\"17\"
2330 style=\"vertical-align: bottom; border: 0; padding-right: 1px;\" />
2332 <a href=\"http://\\1.livejournal.com/\"><b>\\1</b></a>")))
2335 (while (re-search-forward "<lj-template name=\"qotd\" id=\"[0-9]+\" />"
2337 (replace-match "<h3>Writer's Block Answer</h3>" t))))
2340 (format (concat "<br />"
2341 "<p style=\"text-align:right;font-family:verdana,"
2342 "helvetica,sans-serif;font-size:8pt;\">"
2343 "Posted via: <a href=\"http://www.sxemacs.org/lj.el\""
2344 " title=\"Download SXEmacs/LJ\">"
2345 "SXEmacs/LJ</a> (%s)</p>")
2347 "A client by-line to add to bottom of a post.
2349 It is also included when validating or previewing a post.")
2351 (defun lj-validate ()
2352 "Check the markup in a LJ post.
2354 Please note that livejournal.com is quite forgiving when it comes to
2355 HTML in journal entries, lj.el, on the other hand... isn't. For
2356 your entry to pass this validation it needs to be valid XHTML 1.0
2359 (run-hooks 'lj-before-validate-hook)
2360 (let ((vf (make-temp-name (expand-file-name "LJ-" (temp-directory))))
2361 (pb (current-buffer)))
2362 (with-current-buffer (get-buffer-create vf)
2364 (insert lj-validate-header)
2370 (narrow-to-region (point) (point-max))
2372 (and lj-self-promote
2374 (insert lj-validate-footer)
2376 (write-region (point-min) (point-max) vf))
2382 (sgml-validate (sgml-default-validate-command))
2383 (let ((proc (get-buffer-process "*sgml validation*")))
2384 (while (process-live-p proc)
2386 (message "Validating markup, please wait..."))
2387 (message "Validation complete!")
2388 (when (> (process-exit-status proc) 0)
2389 (error 'syntax-error (process-name proc)))))
2392 (switch-to-buffer pb))
2393 (run-hooks 'lj-after-validate-hook)))
2395 (defun lj-preview-headers (buf)
2396 "Add htmlised LJ headers in buffer, BUF for `lj-preview'."
2401 (setq pic (lj-header-content "userpic"))
2403 (narrow-to-region (point-min) (point))
2404 (setq text (buffer-substring-no-properties)))
2408 (lj-text-to-html (point-min) (point-max))
2409 (goto-char (point-min))
2410 (insert "<div class=\"ljhead\">\n")
2411 (and (search-forward "<p>")
2412 (insert (format "<img src=\"%s\" align=\"right\" alt=\"Userpic\" />"
2413 (cdr (assoc pic lj-pickws)))))
2414 (while (search-forward "</head>" nil t)
2415 (replace-match "" nil t))
2416 (goto-char (point-max))
2417 (insert "\n</div>\n\n")
2420 (defun lj-preview ()
2421 "Preview the LJ post in a web browser.
2423 Please note that this is far from a true representation of what the
2424 thing will look like once it has been submitted to LiveJournal. But
2425 it should give you a rough idea."
2427 (run-hooks 'lj-before-preview-hook)
2428 (let ((vf (make-temp-name (expand-file-name "LJ-" (temp-directory))))
2429 (pb (current-buffer)))
2430 (with-current-buffer (get-buffer-create vf)
2432 (insert lj-validate-header)
2433 (insert (lj-preview-headers pb))
2434 (insert "<div class=\"lj\">\n")
2440 (narrow-to-region (point) (point-max))
2442 (and lj-self-promote
2445 (insert lj-validate-footer)
2447 (browse-url-of-buffer))
2448 (when (region-exists-p)
2449 (zmacs-deactivate-region))
2450 (run-hooks 'lj-after-preview-hook)))
2452 (defvar lj-last-url "No URL yet, got nothing to blog about?"
2453 "The URL to your last posted blog entry on LiveJournal.")
2455 (defun lj-post-proc-parser (buf)
2456 "Process parser for `lj-post'.
2457 Argument BUF is the process buffer used."
2458 (let ((url "^url\n\\(.*$\\)"))
2459 (with-current-buffer buf
2460 (when (lj-proc-success)
2461 (setq lj-last-user-set-time nil)
2462 (goto-char (point-min))
2463 (if (re-search-forward url nil t)
2464 (setq lj-last-url (match-string 1))
2465 (setq lj-last-url "NO URL RETURNED FROM LiveJournal"))
2466 (kill-buffer nil)))))
2468 (defun lj-archive-post (archive)
2469 "Archive the current post to ARCHIVE."
2470 (let ((buf (current-buffer)))
2471 (with-current-buffer (find-file-noselect archive)
2473 (goto-char (point-max))
2474 (insert (format "\n\n<a href\"%s\">View Online</a>\n" lj-last-url))
2476 (kill-buffer nil))))
2478 (defun lj-send-bcc (subject security tags comm mood music location body)
2479 "Send a copy of a LJ post via email to `lj-bcc-address'.
2481 Argument SUBJECT is the subject header from the post.
2483 Argument SECURITY is the security level from the post, it is added to
2484 them mail as X-LJ-Auth header.
2486 Argument TAGS are the tags from the post, added as Keywords header.
2488 Argument COMM is the community from the post, added as X-LJ-Community
2491 Argument MOOD is the mood from the post, added as X-LJ-Mood header.
2493 Argument MUSIC is the music from the post, added as X-Now-Playing
2496 Argument LOCATION is the location from the post, added as X-LJ-Location
2499 Argument BODY is of course the post's body."
2500 (let* ((from (concat user-full-name
2501 " <" lj-user-id "@livejournal.com>"))
2502 (headers `(("From" . ,from)
2503 ("Keywords" . ,tags)
2504 ("X-LJ-Auth" . ,security)
2505 ("X-LJ-Community" . ,comm)
2506 ("X-LJ-Location" . ,location)
2507 ("X-LJ-Mood" . ,mood)
2508 ("X-Now-Playing" . ,music)
2509 ("X-URL" . ,lj-last-url)
2510 ("MIME-Version" . "1.0")
2511 ("Content-Type" . "text/html")))
2512 (mail-user-agent 'sendmail-user-agent))
2513 (compose-mail lj-bcc-address subject headers)
2514 (goto-char (point-max))
2516 (declare-fboundp (mail-send-and-exit nil))))
2518 (defun lj-last-entry-proc-parser (buf)
2519 "Process the output from `lj-get-last-entry-btime'.
2520 Argument BUF is the process buffer used."
2521 (let ((regexp "^events_1_eventtime\n\\(.*$\\)"))
2522 (with-current-buffer buf
2523 (when (lj-proc-success)
2524 (goto-char (point-min))
2525 (re-search-forward regexp nil t)
2526 (setq lj-last-entry-btime
2527 (apply #'encode-btime (lj-parse-time-string
2529 (kill-buffer nil)))))
2531 (defun lj-get-last-entry-btime ()
2532 "Leech the last entry from LJ to get it's date/time."
2533 (let ((cookies (or lj-cookies
2534 (error "No LJ cookies found")))
2535 (url (concat lj-base-url
2538 "&auth_method=cookie"
2539 (format "&ver=%d" (if (lj-utf-emacs-p) 1 0))
2543 (lj-http-post url cookies #'lj-last-entry-proc-parser)))
2545 (defun lj-set-date/time ()
2546 "Return an internal time value to use as post date/time.
2548 This will prompt for a date string of the format yyyy-mm-dd, and a
2549 time string in the format HH:MM \(24hr\). If either are given a null
2550 string the current date/time are used.
2552 The value returned is that same as from `encode-time'."
2553 (let* ((date (read-string (format-time-string "New date [%Y-%m-%d]: ")
2555 (format-time-string "%Y-%m-%d")))
2556 (time (read-string (format-time-string "New time [%H:%M]: ")
2558 (format-time-string "%H:%M")))
2559 (timestr (concat date " " time))
2560 (btime (apply #'encode-btime (lj-parse-time-string timestr))))
2561 (btime-to-time btime)))
2563 (defun lj-twitter-compress-url (url)
2564 "Compress URL using tinyurl.com."
2567 (concat "http://tinyurl.com/api-create.php?url="
2568 (lj-hexify-string url t)))
2571 (defun lj-twitter-sentinel (process status)
2572 "Sentinel for `lj-twitter-update-status' PROCESS STATUS."
2573 (if (equal status "finished\n")
2574 (message "Sending to Twitter...done")
2575 (message "Sending to Twitter...failed: %s"
2576 (substring status 0 (1- (length status))))))
2578 ;;; FIXME: Twitter no longer supports Basic Auth, so must rewrite this
2580 (defun lj-twitter-update-status (user pass status url)
2581 "Update twitter status.
2583 Argument USER is your twitter username.
2584 Argument PASS is your twitter password.
2585 Argument STATUS is the subject header from your LJ post.
2586 Argument URL is the URL to the post on livejournal.com."
2587 (let* ((userpass (format "%s:%s" user pass))
2588 (turl (lj-twitter-compress-url url))
2589 (twit (concat "status="
2591 (concat status " See: " turl) t)))
2592 (twiturl "http://twitter.com/statuses/update.json")
2594 (if (<= (length twit) 147) ; twitter's max + "status="
2597 (apply #'start-process
2602 "-H" "X-Twitter-Client: SXEmacs_LJ"
2603 "-H" (format "X-Twitter-Client-Version: %s"
2606 "X-Twitter-Client-URL: "
2607 "http://www.sxemacs.org/~steve/lj/lj.xml")
2608 "-d" "source=lj.el")))
2609 (set-process-sentinel proc #'lj-twitter-sentinel))
2610 (warn "LJ subject too long for Twitter"))))
2612 (defun lj-check-limits (bodlen sublen taglen muslen loclen)
2613 "Make sure we don't exceed any LJ size limits.
2615 Argument BODLEN: length of the body of a post. Max is 65535 bytes.
2616 Argument SUBLEN: length of the subject header. Max is 100 chars.
2617 Argument TAGLEN: length of the tags header. Max is 100 chars.
2618 Argument MUSLEN: length of the music header. Max is 100 chars.
2619 Argument LOCLEN: length of the location header. Max is 100 chars."
2620 (let ((maxbod 65535)
2625 (and (> bodlen maxbod)
2626 (error 'invalid-argument
2627 (format "Post body exceeds maximum by %d chars"
2628 (- bodlen maxbod))))
2629 (and (> sublen maxsub)
2630 (error 'invalid-argument
2631 (format "Subject exceeds maximum by %d chars"
2632 (- sublen maxsub))))
2633 (and (> taglen maxtag)
2634 (error 'invalid-argument
2635 (format "Tags exceed maximum by %d chars"
2636 (- taglen maxtag))))
2637 (and (> muslen maxmus)
2638 (error 'invalid-argument
2639 (format "Music header exceeds maximum by %d chars"
2640 (- muslen maxmus))))
2641 (and (> loclen maxloc)
2642 (error 'invalid-argument
2643 (format "Location header exceeds maximum by %d chars"
2644 (- loclen maxloc))))))
2646 (defun lj-post (&optional out-of-order)
2647 "Submit a new post to LiveJournal.
2649 With a single prefix argument, OUT-OF-ORDER, prompt for a date/time to
2652 With two prefix args, also set a \"date out of order\" flag."
2654 (run-hooks 'lj-before-post-hook)
2655 (let ((subject (lj-header-content "subject"))
2656 (body (and (lj-goto-body)
2659 (buffer-substring-no-properties (point) (point-max))
2661 (buffer-substring-no-properties (point) (point-max)))))
2663 (security (lj-header-content "security"))
2664 (tags (lj-header-content "tags"))
2665 (comm (lj-header-content "community"))
2666 (mood (lj-header-content "mood"))
2667 (location (lj-header-content "location"))
2668 (music (lj-header-content "music"))
2669 (pickw (lj-header-content "userpic"))
2670 (cookies (or lj-cookies
2671 (error "No LJ cookies found")))
2674 (draftid (buffer-file-name))
2676 (when (and out-of-order
2677 (null current-prefix-arg))
2679 date lj-last-user-set-time))
2680 (cond ((eq (car current-prefix-arg) 4)
2681 (setq date (lj-set-date/time)))
2682 ((eq (car current-prefix-arg) 16)
2683 (setq date (lj-set-date/time)
2685 (lj-check-limits (length body)
2690 (setq url (lj-construct-url subject body user security tags comm nil nil
2691 mood location music pickw date backdated))
2692 ;; lets save the draft out to disc just in case something goes wrong
2694 (lj-http-post url cookies #'lj-post-proc-parser)
2695 (and lj-archive-posts
2696 (lj-archive-post (lj-header-content "fcc")))
2698 (lj-send-bcc subject security tags comm mood music location body))
2699 ;;; FIXME: twitter updates are broken, needs OAuth
2700 ;; (and lj-twitter-flag
2701 ;; (lj-twitter-update-status lj-twitter-username lj-twitter-password
2702 ;; subject lj-last-url))
2703 (delete-file draftid)
2704 (run-hooks 'lj-after-post-hook)))
2706 ;; keep track of the date of the last entry for backdating purposes
2707 (add-hook 'lj-after-post-hook #'lj-get-last-entry-btime)
2710 (defvar lj-qotd-buffer "*LJ Writer's Block*"
2711 "Buffer displaying a list of LJ Writer's Block questions.")
2713 (defun lj-parse-qotd-archive ()
2714 "Leech the qotd archive and make it presentable for human consumption."
2715 (let ((buf (get-buffer-create lj-qotd-buffer))
2716 (bregexp "<!-- Content -->")
2717 (eregexp "<p class='skiplinks'>")
2718 (qregexp "<p class='qotd-archive-item-question'>\\(.*\\)</p><p")
2720 (concat "<div class=\"b-qotd-question\">"
2721 "<p class='qotd-archive-item-date'>\\(.*[0-9]+\\)</p>"))
2722 (idregexp "^.*qotd=\\([0-9]+\\).*\n.*$")
2723 (url "http://www.livejournal.com/misc/qotdarchive.bml")
2725 (with-current-buffer buf
2726 (when (lj-utf-emacs-p)
2727 (set-buffer-file-coding-system 'utf-8))
2730 (goto-char (point-min))
2731 (setq b (and (search-forward bregexp nil t)
2734 e (and (search-forward eregexp nil t)
2736 (narrow-to-region b e)
2737 (goto-char (point-min))
2738 (insert (make-string 72 ?=) "\n")
2740 (while (re-search-forward dregexp nil t)
2741 (replace-match (format "%s:\n\n" (match-string 1)) t)))
2743 (while (re-search-forward qregexp nil t)
2744 (replace-match (format "QOTD: %s\n" (match-string 1)) t)))
2746 (while (re-search-forward "^QOTD:" nil t)
2747 (fill-paragraph nil)))
2749 (while (re-search-forward idregexp nil t)
2750 (replace-match (concat (format "\nWriter's Block ID: %s\n"
2752 (make-string 72 ?=)) t))))))
2754 (defun lj-qotd-subject (qotd)
2755 "Update the Subject header with title of QOTD."
2756 (let ((url (format "http://www.livejournal.com/update.bml?qotd=%d"
2761 (goto-char (point-min))
2762 (when (re-search-forward "Writer's Block: \\(.*\\)\" name="
2764 (setq subject (match-string 1))))
2766 (goto-char (point-at-eol))
2768 (goto-char (point-max))))
2770 (defun lj-narrow-to-qotd (qotd)
2771 "Narrow Writer's Block buffer to a single QOTD."
2772 (let ((delim (make-string 72 ?=))
2774 (goto-char (point-max))
2775 (setq e (and (search-backward (format "ID: %d" qotd))
2777 b (search-backward delim))
2778 (narrow-to-region b e)
2779 (shrink-window-if-larger-than-buffer)
2781 (unless (eq major-mode 'lj-mode)
2782 (switch-to-buffer "*LJ-Post*"))
2783 (unless (zerop lj-qotd)
2784 (insert (format "<lj-template name=\"qotd\" id=\"%d\" />\n\n"
2786 (lj-qotd-subject lj-qotd))))
2788 (defun lj-cleanup-qotd ()
2789 "Reset `lj-qotd' to zero and kill the qotd buffer."
2792 (delete-other-windows)
2793 (when (buffer-live-p (get-buffer lj-qotd-buffer))
2794 (kill-buffer lj-qotd-buffer))))
2796 (defun lj-qotd-quit ()
2797 "Cancel a LJ \"Writer's Block\" composition."
2800 (unless (eq major-mode 'lj-mode)
2801 (switch-to-buffer "*LJ-Post*"))
2803 (and (lj-goto-subject)
2804 (kill-region (point) (point-at-eol)))
2806 (kill-region (point) (point-at-eol)))
2808 (remove-hook 'lj-after-post-hook #'lj-cleanup-qotd))
2810 (defun lj-writers-block ()
2811 "Compose an answer to a LJ \"Writer's Block\" question."
2813 (and (lj-goto-subject)
2814 (kill-region (point) (point-at-eol))
2815 (insert "Writer's Block: "))
2817 (kill-region (point) (point-at-eol))
2818 (insert "writer's block"))
2820 (kill-region (point) (point-max)))
2821 (lj-sgml-indent-tab-or-complete)
2822 (lj-parse-qotd-archive)
2823 (pop-to-buffer lj-qotd-buffer)
2824 (local-set-key [space] #'scroll-up)
2825 (local-set-key [delete] #'scroll-down)
2826 (local-set-key [return]
2829 (setq lj-qotd (read-number "Select Writer's Block ID: " t))
2830 (lj-narrow-to-qotd lj-qotd)))
2831 (local-set-key [q] #'lj-qotd-quit)
2832 (message "[SPC]/[DEL] to scroll, [q] to cancel, [RET] to enter QOTD ID")
2833 (add-one-shot-hook 'lj-after-post-hook #'lj-cleanup-qotd 'append))
2835 (defun lj-session-auto-save-files ()
2836 "Return a list of auto-save files in `lj-drafts-directory'."
2837 (directory-files lj-drafts-directory nil
2838 #'auto-save-file-name-p 'list t))
2840 (defun lj-recover-drafts (files)
2841 "Recover auto-saved FILES in `lj-drafts-directory'."
2842 (let ((default-directory lj-drafts-directory))
2844 (recover-file (auto-save-original-name (car files)))
2845 (lj-edit-draft (auto-save-original-name (car files)))
2846 (setq files (cdr files)))))
2851 "Compose a new LiveJournal entry."
2853 (run-hooks 'lj-init-hook)
2854 ;; Maybe update tags, groups, moods, pic keywords
2855 (or lj-tags (lj-get-tags))
2856 (or lj-groups (lj-get-friends-groups))
2857 (or lj-moods (lj-get-moods))
2858 (or lj-default-pickw (lj-get-pickws))
2859 (let ((auto-saves (lj-session-auto-save-files)))
2861 (y-or-n-p "Auto saved drafts exist, do you wish to recover "))
2862 (lj-recover-drafts auto-saves)
2863 (lj-generate-new-buffer))))
2865 (defun lj-blog-buffer (buffer &optional noformat)
2866 "Use contents of BUFFER to compose LJ entry.
2868 With optional prefix arg, NOFORMAT, don't attempt to convert the text
2870 (interactive "bBuffer to blog: \nP")
2871 (let ((blog (with-temp-buffer
2872 (insert-buffer buffer)
2873 (unless current-prefix-arg
2874 (lj-text-to-html (point-min) (point-max)))
2875 (buffer-substring-no-properties))))
2879 (defun lj-blog-region (beg end &optional noformat)
2880 "Compose LJ entry using content of region BEG - END.
2882 With optional prefix arg, NOFORMAT, dont' attempt to convert the text
2884 (interactive "r\nP")
2885 (let ((blog (buffer-substring beg end)))
2886 (unless current-prefix-arg
2889 (lj-text-to-html (point-min) (point-max))
2890 (setq blog (buffer-substring-no-properties))))
2894 (defun lj-edit-draft (draft)
2895 "Edit an existing draft previously saved from lj.el."
2897 (read-file-name "Edit draft: "
2898 lj-drafts-directory "" t)))
2899 (if (or (zerop (length draft))
2900 (not (file-readable-p (expand-file-name draft))))
2901 (error 'invalid-argument draft)
2902 (switch-to-buffer (find-file-noselect (expand-file-name draft)))
2903 (rename-buffer "*LJ-draft*" 'unique)
2904 (goto-char (point-min))
2905 (make-extent (point) (point-at-eol))
2906 (lj-update-userpic-glyph
2907 (expand-file-name (lj-header-content "userpic")
2908 lj-userpic-directory))
2909 (re-search-forward lj-header-separator nil t)
2911 (set-extent-property
2912 (make-extent (point-at-bol) (1+ (point-at-eol))) 'invisible t)
2919 (and (file-exists-p lj-tags-file)
2920 (load-file lj-tags-file))
2921 (and (file-exists-p lj-groups-file)
2922 (load-file lj-groups-file))
2923 (and (file-exists-p lj-moods-file)
2924 (load-file lj-moods-file))
2925 (and (file-exists-p lj-pickws-file)
2926 (load-file lj-pickws-file))