Pages

Wednesday, September 15, 2010

org-googlecl release version - support tagging of blogged entries


GitHub : Tag blogged org entries with googlecl-blog-tag if its set. Auto delete suppport via googlecl-blog-auto-del.


--
My Emacs Files At GitHub

Ooo! Feedback on org-googlecl


Its always nice to get some feedback.





Subject: Re: org-googlecl : enhancements - replace existing blog entries.
From: Tim Burt <tcburt@rochester.rr DOT MOC>
Date: Wed, 15 Sep 2010 05:56:32 -0400

Richard Riley <rileyrg@gmail.com> writes:

> The org-googlecl package has been extended a little.
>
> http://splash-of-open-sauce.blogspot.com/2010/09/now-org-googlecl-supports-deleting-of_14.html
>
> It now detects if you try to blog an entry with the same title as an
> existing one and prompts you to view and/or remove one or more entries
> with the same name. Obviously very useful for just updating an entry (NB
> the url will change unfortunately). There is also a footer option and
> default labels (tags) if none are specified on the org entry you are
> blogging.

Tags as labels for the blog is a welcome feature.

> It's working pretty cleanly now but any feedback appreciated -
> its a pretty handy complement to org-mode if you maintain a
> blogger/blogspot account.

That's an understatement. Publishing from org to blogger is nearly
transparent and takes only seconds to confirm the information
(e.g. title, labels). It is a treat to use org-googlecl. Thank you
Richard.

Tim

> The elisp snippets you will see above were all
> blogged from my dotemacs files which are all in org files using this
> function.
>
> regards
>
> r.
>
>
> _______________________________________________
> Emacs-orgmode mailing list
> Please use `Reply All' to send replies to the list.
> Emacs-orgmode@gnu.org
> http://lists.gnu.org/mailman/listinfo/emacs-orgmode





--
My Emacs Files At GitHub

Example of providing auto input to a waiting shell process


In this instance pipes "y" to the called process to confirm we want the blog deleted.




(let ((delcommand  (format "yes y | google blogger delete --blog '%s'  --title '%s'"  googlecl-blogname  btitle)))
(message "Delete command is : %s" delcommand)
(call-process-shell-command delcommand))




--
My Emacs Files At GitHub

Tuesday, September 14, 2010

Now org-googlecl supports deleting of existing entries


If you try to blog a title that exists you can examine it and/or
delete prior to blogging the new version. See link in footer for git
files.





(if googlecl-blog-exists
(with-temp-buffer
(let* ((blogrc (call-process-shell-command (concat "google blogger list --blog '" googlecl-blogname "' --title '" btitle "' url") nil (current-buffer)))
(blogurl (buffer-string)))
(if (not (zerop(length blogurl)))
(progn
(if (y-or-n-p (concat "Blog entry exists :" blogurl ". View existing?"))
(browse-url (nth 0 (org-split-string blogurl))))
(setq blogurl (nth 0 (org-split-string blogurl)))
(if (y-or-n-p "Delete existing blog entry?")
(let ((delcommand (format "yes y | google blogger delete --blog '%s' --title '%s'" googlecl-blogname btitle)))
(message "Delete command is : %s" delcommand)
(call-process-shell-command delcommand))))))))




--
My Emacs Files At GitHub

Multiple Tabs (Elscreen)

(require 'elscreen) ;; C-z n for new screen or next etc.
(require 'elscreen-gf) ;; C-z n for new screen or next etc.

(defmacro elscreen-create-automatically (ad-do-it)
`(if (not (elscreen-one-screen-p))
,ad-do-it
(elscreen-create)
(elscreen-notify-screen-modification 'force-immediately)
(elscreen-message "New screen is automatically created")))

(defadvice elscreen-jump (before elscreen-jump-create activate)
(let ((next-screen (string-to-number (string last-command-event))))
(when (and (<= 0 next-screen)
(<= next-screen 9)
(not (elscreen-screen-live-p next-screen)))
(elscreen-set-window-configuration
(elscreen-get-current-screen)
(elscreen-current-window-configuration))
(elscreen-set-window-configuration
next-screen (elscreen-default-window-configuration))
(elscreen-append-screen-to-history next-screen)
(elscreen-notify-screen-modification 'force))))

(defadvice elscreen-next (around elscreen-create-automatically activate)
(elscreen-create-automatically ad-do-it))

(defadvice elscreen-previous (around elscreen-create-automatically activate)
(elscreen-create-automatically ad-do-it))

(defadvice elscreen-toggle (around elscreen-create-automatically activate)
(elscreen-create-automatically ad-do-it))




EMMS music setup using mpd

(define-key mode-specific-map (kbd "e e") 'my-start-player)
(require 'emms-source-file)
(require 'emms-player-mpd)
(require 'emms-playing-time)
(require 'emms-playlist-mode)
(require 'emms-mode-line-icon)
(require 'emms-streams)
(require 'emms-stream-info)
(require 'emms-volume)

(require 'emms-setup)
(emms-devel)
(emms-mode-line 1)
(emms-playing-time 1)

(emms-player-set emms-player-mpd 'regex
"\\.ogg\\|\\.mp3\\|\\.wma\\|\\.ogm\\|\\.asf\\|\\.mkv\\|http://\\|mms://\\|\\.rmvb\\|\\.flac\\|\\.vob\\|\\.m4a\\|\\.ape\\|\\.mpc")
(emms-player-set emms-player-mplayer 'regex
"\\.wav\\|\\.pls+\\|\\.mpg\\|\\.mpeg\\|\\.wmv\\|\\.wma\\|\\.mov\\|\\.avi\\|\\.divx\\|\\.ogm\\|\\.asf\\|\\.mkv\\|.rm\\|\\.rmvb\\|\\.mp4|\\.rm")


(define-emms-combined-source all nil
'((emms-source-directory emms-source-file-default-directory)))

(setq emms-playlist-buffer "*Music*")

;;;###autoload
(defun rgr/track-search()
(interactive)
(anything (list anything-c-source-emms-file anything-c-source-emms-directory anything-c-source-emms-playlist) nil "Video or even some music Sir? ")
)

(defadvice rgr/track-search (after rgr/track-search) (run-at-time "2 sec" nil 'emms-player-mpd-connect))


;;(add-hook 'emms-player-started-hook 'emms-player-mpd-connect)
(setq emms-show-format "EMMS is now playing : %s")

;; get list back from mpd for proper formatting
;; (defadvice emms-play-file (after emms-play-file activate)
;; (emms-player-mpd-connect))

; (emms-lyrics 1)
; (emms-lyrics-ena1ble)

(emms-playing-time 1)
(emms-mode-line 1)

(require 'emms-extension)
(ad-unadvise 'emms-play-directory-tree)

(define-key mode-specific-map (kbd "e q") 'my-stop-player)

(define-key mode-specific-map (kbd "e D") 'emms-mode-line-toggle)

(define-key mode-specific-map (kbd "e R") 'my-emms-streams)

(define-key mode-specific-map (kbd "e c") 'emms-playlist-current-clear)

(define-key mode-specific-map (kbd "e d") (lambda() (interactive)(emms-play-dired)(my-start-player)))
(define-key mode-specific-map (kbd "e a") 'emms-add-dired)
(define-key mode-specific-map (kbd "e m") 'emms-play-matching)
(define-key mode-specific-map (kbd "e f") 'emms-add-find)
(define-key mode-specific-map (kbd "e b") 'emms-browser)
(define-key mode-specific-map (kbd "e s") 'emms-smart-browse)

(define-key mode-specific-map (kbd "e j") 'emms-seek)
(define-key mode-specific-map (kbd "e <right>") (lambda()(interactive)(emms-seek 30)))
(define-key mode-specific-map (kbd "e <left>") (lambda()(interactive)(emms-seek -15)))

(define-key mode-specific-map (kbd "e l") 'my-emms-switch-to-current-playlist)
(define-key mode-specific-map (kbd "e L") 'emms-play-playlist)

(define-key mode-specific-map (kbd "e n") 'emms-next)
(define-key mode-specific-map (kbd "e p") 'emms-previous)

(define-key mode-specific-map (kbd "e +") 'emms-volume-raise)
(define-key mode-specific-map (kbd "e -") 'emms-volume-lower)

(define-key mode-specific-map (kbd "e r") 'emms-random)

(define-key mode-specific-map (kbd "e <SPC>") 'emms-pause)

(defun my-emms-info-track-description (track)
"Return a description of the current track."
(if (and (emms-track-get track 'info-artist)
(emms-track-get track 'info-title))
(let ((pmin (emms-track-get track 'info-playing-time-min))
(psec (emms-track-get track 'info-playing-time-sec))
(ptot (emms-track-get track 'info-playing-time))
(art (emms-track-get track 'info-artist))
(tit (emms-track-get track 'info-title)))
(cond ((and pmin psec) (format "%s - %s " art tit ))
(ptot (format "%s - %s " art tit ))
(t (emms-track-simple-description track))))))

(defun my-stop-player ()
"Stop emms player."
(interactive)
(shell-command "mpd --kill")
(emms-playlist-current-kill)
(emms-player-mpd-disconnect))

;; Switch to the radio buffer
(defun my-emms-streams ()
(interactive)
(my-start-player)
(let ((buf (get-buffer emms-stream-buffer-name)))
(if buf
(switch-to-buffer buf)
(emms-streams))))

;; Switch to either the radio buffer or the current EMMS playlist
(defun my-emms-switch-to-current-playlist ()
(interactive)
(if (and (boundp 'emms-stream-playlist-buffer)
(eq emms-stream-playlist-buffer emms-playlist-buffer))
(switch-to-buffer emms-stream-buffer-name)
(if (or (null emms-playlist-buffer)
(not (buffer-live-p emms-playlist-buffer)))
(error "No current Emms buffer")
(switch-to-buffer emms-playlist-buffer))))


(defun my-start-player ()
"Start MPD and sync to its playlistemms player."
(interactive)
(shell-command "mpd") ; uses default ~/.mpdconf
(emms-player-mpd-connect)
(switch-to-buffer emms-playlist-buffer)
(global-set-key (kbd "<M-f1>") 'rgr/track-search)
)




Language translation utilities/helper functions for interfacing to Babel


If prefix the call to the translate function than store the translation as an org item.




(require 'babel)

(defvar rgr/learn-first-lesson 1)
(defvar rgr/orig-text "The text we wish to translate")
(defvar rgr/trans-text "The translated text")

(setq babel-echo-area t)
(setq babel-preferred-from-language "English")
(setq babel-preferred-to-language "German")


(defun rgr/babel-language-code (lang)
(cdr (assoc lang babel-languages)))

(defun rgr/translate( &optional usedef )
(interactive)
(let* ((default (region-or-word-at-point)))
(setq default
(read-string (format "Translate \"%s\" :" default) nil nil default))
(when (length default)
(setq rgr/trans-text (babel default nil usedef))
(setq rgr/orig-text default)
(if current-prefix-arg
(progn
(org-capture nil ?v)
(org-schedule nil (time-add (current-time) (days-to-time rgr/learn-first-lesson)))))
(rgr/notify rgr/trans-text) ;; calls gnome notify function or whatever.
(message "%s" rgr/trans-text))))

(defun rgr/toggle-languages()
(interactive)
(let* ((temp babel-preferred-to-language))
(setq babel-preferred-to-language babel-preferred-from-language
babel-preferred-from-language temp))
(message "%s to %s " babel-preferred-from-language babel-preferred-to-language))

(global-set-key (kbd "<f5>")
(lambda()
(interactive)(require 'babel)(rgr/translate t)))

(global-set-key (kbd "<f6>")
'rgr/toggle-languages)




Emailing or replying to someone using recipient specific from address


The BBDB can be used to store specific fields which tell Gnus which accounts to
use when posting to the recipient in the BBDB.





(defun DE-bbdb-match-field-recipient (field regexp)
"Match FIELD for recipient against REGEXP.
FIELD must be a symbol, e.g. 'email-type."

(debug)
(let (who rec)
(when (and
(gnus-buffer-live-p gnus-article-copy)
(setq who
(with-current-buffer gnus-article-copy
(save-restriction
(nnheader-narrow-to-headers)
(or (message-fetch-field "reply-to")
(message-fetch-field "from")))))
(setq rec
(bbdb-search-simple
nil
(cadr (gnus-extract-address-components who)))))
(string-match regexp (bbdb-get-field rec field)))))


;; by adding a bdbb field called "email-type" and setting it to "friend-alias"
;; this gnus-posting-style is met when replying to people. If posting from a group
;; with "friends" in the name ditto.
(add-to-list `gnus-posting-styles `((or (string-match ,(rx "friends") gnus-newsgroup-name) (DE-bbdb-match-field-recipient 'email-type "friend-alias"))
(from rgr/friends-email)
(name rgr/friends-name)
(organization nil)
(eval (setq mml2015-signers nil))
(signature-file "~/.emacs.d/.sigs/friends.sig")) t )




Google and URL Opening from Emacs

(autoload 'w3m-browse-url "w3m" nil t)
(autoload 'browse-url-interactive-arg "browse-url")

(require 'browse-apropos-url)
(require 'browse-url)
(require 'thingatpt+)
(require 'w3m)

(defun rgr/browse (url)
"If prefix is specified use the system default browser else use the configured emacs one"
(if current-prefix-arg
(if url
(w3m-browse-url url)
(call-interactively 'browse-url))
(when url (browse-url-generic url))
))

(defun rgr/browse-url (&optional url)
"browse the url passed in"
(interactive)
(setq url (or url (w3m-url-valid (w3m-anchor)) (browse-url-url-at-point) (region-or-word-at-point)))
(setq url (read-string (format "Url \"%s\" :" url) url nil url))
(rgr/browse url))

(defun rgr/browse-apropos-url (apropos-prefix prompt)
(interactive)
(let* ((default (region-or-word-at-point))
)
(setq default (read-string (format prompt default) default nil default))
(browse-apropos-url (concat apropos-prefix " " default) nil current-prefix-arg)))


(defun rgr/google-search-prompt (&optional default)
(interactive)
(let* ((default (or default (region-or-word-at-point)))
(term (read-string (format "Google.com the web for the following phrase (%s): "
default) nil nil default)))
(rgr/browse (concat "http://www.google.com/search?q=" ; borrowed from dim
(replace-regexp-in-string
"[[:space:]]+"
"+"
term)))))

; google keys and url keys
; prefix (ctl-u) to use external browser.
(global-set-key (kbd "<f4>") 'rgr/browse-url)
(global-set-key (kbd "<f3>") 'rgr/google-search-prompt)




Setting up Gnus to read local dovecot server and nntp news


See Gnus IMAP




(setq gnus-select-method '(nnml ""))

(add-to-list 'gnus-secondary-select-methods
'(nnimap "riley"
(nnimap-address "offlineimap")
(nnir-search-engine imap)
(nnimap-stream network)
(nnimap-authinfo-file "~/.authinfo.gpg")))

(add-to-list 'gnus-secondary-select-methods
'(nnimap "shamrockpub"
(nnimap-address "offlineimap")
(nnir-search-engine imap)
(nnimap-stream network)
(nnimap-authinfo-file "~/.authinfo.gpg")))

(add-to-list 'gnus-secondary-select-methods
'(nnimap "friends"
(nnimap-address "offlineimap")
(nnir-search-engine imap)
(nnimap-stream network)
(nnimap-authinfo-file "~/.authinfo.gpg")))


(add-to-list 'gnus-secondary-select-methods '(nntp "Gmane" (nntp-address "news.gmane.org")))
(add-to-list 'gnus-secondary-select-methods '(nntp "Gwene" (nntp-address "news.gwene.org")))
(add-to-list 'gnus-secondary-select-methods '(nntp "Gnus" (nntp-address "news.gnus.org")))


(setq gnus-posting-styles `((".*"
(name "Richard Riley")
(from "Richard Riley <rileyrg@googlemail.com>")
(eval(setq gnushush-user-agent-header (quote real)))
(signature-file "~/.emacs.d/.sigs/rgr.sig")
(eval (setq mml2015-signers '("AB23BE58")))
(organization "aich tea tea pea dicky riley dot net"))))



(setq mail-host-address "news.eternal-september.org")




Using dictem for word lookup and flyspell for interactive spell checking

(require 'dictem)

; SEARCH = MATCH + DEFINE
; Ask for word, database and search strategy
; and show definitions found
(global-set-key (kbd "C-c s") 'dictem-run-search)


; SHOW DB
; Show a list of databases provided by DICT server
(global-set-key "\C-c\M-b" 'dictem-run-show-databases)

(define-key dictem-mode-map [tab] 'dictem-next-link)
(define-key dictem-mode-map [(backtab)] 'dictem-previous-link)
(define-key dictem-mode-map [return] 'dictem-run-search)

(dictem-initialize)


;;;###autoload
(defun rgr/synonyms()
(interactive)
(let* ((default (region-or-word-at-point))
(term (read-string (format "Synonyms for (%s): "
default) default)))
(dictem-run
'dictem-base-search
"moby-thes" term "exact")))

(define-key mode-specific-map [?S] 'rgr/synonyms)

(dictem-initialize)

(add-hook 'dictem-postprocess-match-hook
'dictem-postprocess-match)

(add-hook 'dictem-postprocess-definition-hook
'dictem-postprocess-definition-separator)

(add-hook 'dictem-postprocess-definition-hook
'dictem-postprocess-definition-hyperlinks)

(add-hook 'dictem-postprocess-show-info-hook
'dictem-postprocess-definition-hyperlinks)

(add-hook 'dictem-postprocess-definition-hook
'dictem-postprocess-each-definition)

(require 'flyspell)

(define-key flyspell-mode-map (kbd "C-+") 'flyspell-check-previous-highlighted-word)
(define-key flyspell-mode-map (kbd "C-#") 'flyspell-auto-correct-previous-word)
(define-key flyspell-mode-map (kbd "S-<f2>") 'ispell-word)
(define-key flyspell-mode-map (kbd "C-<f2>") 'flyspell-auto-correct-previous-word)
(define-key flyspell-mode-map (kbd "<f2>") 'flyspell-auto-correct-word)

(define-minor-mode babel-permanent-translation-mode "Bable translate notext")

(define-key mode-specific-map [?o] (lambda()(interactive)(if (babel-permanent-translation-mode) (add-hook 'post-command-hook 'rgr/context-babel nil t)(remove-hook 'post-command-hook 'rgr/context-babel))))

(setq babel-echo-area t)
(setq babel-preferred-from-language "German")
(setq babel-preferred-to-language "English")

(defun turn-on-flyspell ()
"Force flyspell-mode on using a positive arg. For use in hooks."
(interactive)
(flyspell-mode 1))

Change smtp server based on from field


See MSMTP Home Page.




;; Select the correct smtp server based on the from address.
(defun msmtp-account (&optional def)
(let* ((from
(save-restriction
(message-narrow-to-headers)
(message-fetch-field "From")))
(account (if from (catch 'match
(dolist (element msmtp-name-list)
;; (message (format "smpt chosen is %s" element))
(when (string-match (format ".*%s.*" element) from)
(throw 'match element)))) nil)))
(if account account (if def def "default"))))

(defun msmtp-change-smtp ()
(setq sendmail-program "/usr/bin/msmtp")
(setq smtpmail-starttls-credentials '(("smtp.googlemail.com" 587 nil nil)))
(setq smtpmail-smtp-server "smtp.googlemail.com")
(setq message-sendmail-envelope-from 'header)
(if (message-mail-p)
(setq message-sendmail-extra-arguments (list "-a" (msmtp-account "default")))))
(add-hook 'message-send-hook 'msmtp-change-smtp)

(setq message-required-news-headers
(remove' Message-ID message-required-news-headers))




Monday, September 13, 2010

Gnus Email and NNTP Handling

(setq
nntp-marks-is-evil t
bbdb-always-add-address t ;; add new addresses to existing...
bbbd-message-caching-enabled t ;; be fast
bbdb-elided-display t ;; single-line addresses
bbdb-ignore-some-messages-alist ;; don't ask about fake addresses
;; NOTE: there can be only one entry per header (such as To, From)
;; http://flex.ee.uec.ac.jp/texi/bbdb/bbdb_11.html
'(( "From" . "no.?reply\\|DAEMON\\|daemon\\|facebookmail\\|twitter")))


(require 'bbdb)
(require 'bbdb-autoloads)
(bbdb-initialize 'gnus 'message)
(add-hook 'message-setup-hook 'bbdb-define-all-aliases)

(spam-initialize)

(require 'w3m)
(require 'gnushush)
(require 'manatee)
(require 'miniedit)

;; (load "gnus-load") ;; Needed if using nognus.

(define-key mode-specific-map [?m] 'gnus)

;(if (featurep 'xemacs)
; (add-to-list 'Info-directory-list "~/builds/gnus/texi/")
; (add-to-list 'Info-default-directory-list "~/builds/gnus/texi/"))


(require 'offlineimap)
(add-hook 'gnus-get-new-news-hook 'offlineimap)

(require 'spam)
(spam-initialize)

;; which email addresses to detect for special highlighting
(defvar rgr-mails
"rileyrg@googlemail\\.com\\|rgr@richardriley\\.net\\|rileyrgdev@googlemail\\.com")

(defun store-gnus-outgoing-message-group ()
(cond ((and gnus-newsgroup-name
(not (message-news-p))
(stringp gnus-newsgroup-name))
gnus-newsgroup-name)
(t ted-default-gcc-group)))

(setq gnus-outgoing-message-group nil)


(setq rgr/server-name-maps
'(("RI" . "Email")
("SH" . "Pub")
("FR" . "Friends")
("KL" . "Sport")
("HA" . "Fun")
("GM" . "Gmane")
("GN" . "Gnu")
("GW" . "Gwene")
("" . "Unknown")
))

;; (copy-face 'default 'my-gnus-face)
;; (copy-face 'my-gnus-face 'my-subject-face)

;; (copy-face 'my-gnus-face 'my-group-face)
;; (set-face-attribute 'my-group-face nil :inherit 'my-gnus-face)

;; (copy-face 'my-group-face 'my-group-face-unread)
;; (set-face-attribute 'my-group-face-unread nil :inherit 'my-group-face)

;; (copy-face 'my-group-face 'my-group-server-face)
;; (copy-face 'my-group-server-face 'my-group-server-face-unread)
;; (set-face-attribute 'my-group-server-face-unread nil :inherit 'my-group-server-face)

;; (copy-face 'my-group-face 'my-unread-count-face)
;; (copy-face 'my-unread-count-face 'my-unread-count-face-unread)
;; (set-face-attribute 'my-unread-count-face-unread nil :inherit 'my-unread-count-face)

;; (copy-face 'my-group-face 'my-inbox-icon-face)
;; (copy-face 'my-inbox-icon-face 'my-inbox-icon-face-unread)
;; (set-face-attribute 'my-inbox-icon-face-unread nil :inherit 'my-inbox-icon-face)

;; (copy-face 'my-gnus-face 'my-topic-empty-face)
;; (copy-face 'my-gnus-face 'my-topic-face)


(setq gnus-topic-line-format "%i[ %u&topic-line; ] %v\n")

(defun rgr/unread-face (f)
(intern (if (> (string-to-number gnus-tmp-number-of-unread) 0) (concat f "-unread") f)))

;; this corresponds to a topic line format of "%n %A"
(defun gnus-user-format-function-topic-line (dummy)
(let ((topic-face (if (zerop total-number-of-articles)
'my-topic-empty-face
'my-topic-face)))
(propertize
(format "%s %d" name total-number-of-articles)
'face topic-face)))

(defun gnus-user-format-function-s (header)
(propertize (mail-header-subject header) 'face 'my-subject-face 'gnus-face t))

(defun gnus-user-format-function-g (headers) ;; gnus-group-line-format use %ug to call this func! e.g "%M%S%p%P%(%-40,40ug%)%-5uy %ud\n"
;; split full group protocol-server:group into three parts.
(string-match "\\(^.*\\)\\+\\(.*\\):\\(.*\\)" gnus-tmp-group)
;; map the first two letters of the server name to a more friendly and cuddly display name
(let* ((match-ok (match-string 2 gnus-tmp-group))
(server-key (if (null match-ok) nil (upcase(substring match-ok 0 2)))))
(if (zerop (length server-key))
gnus-tmp-group
;; construct new group format line with a small envelope taking the place of any INBOX
(concat
(propertize
(format "%-8s" (cdr (assoc server-key rgr/server-name-maps)))
'face (rgr/unread-face "my-group-server-face") 'face (rgr/unread-face (concat "my-group-server-face-" server-key)) 'gnus-face t)
" - "
(if (string-match "INBOX" (match-string 3 gnus-tmp-group) )
(propertize "\x2709" 'face (rgr/unread-face "my-inbox-icon-face") 'gnus-face t)
(propertize (match-string 3 gnus-tmp-group) 'face (rgr/unread-face "my-group-face") 'gnus-face t) )))))


(defun gnus-user-format-function-j (headers)
;; prefix each post depending on whether to, cc or Bcc to
(let ((to (gnus-extra-header 'To headers)))
(if (string-match rgr-mails to)
(if (string-match "," to) "~" "»")
(if (or (string-match rgr-mails
(gnus-extra-header 'Cc headers))
(string-match rgr-mails
(gnus-extra-header 'BCc headers)))
"~"
" "))))

(defun gnus-user-format-function-y (headers)
"return string representation for unread articles"
(concat
(propertize (if (= (string-to-number gnus-tmp-number-of-unread) 0) "" "\x2709") 'face (rgr/unread-face "my-inbox-icon-face") 'gnus-face t)
(propertize (if (= (string-to-number gnus-tmp-number-of-unread) 0) ""
(concat " (" gnus-tmp-number-of-unread ")")) 'face (rgr/unread-face "my-unread-count-face") 'gnus-face t)))



(setq gnus-user-date-format-alist
;; Format the date so we can see today/tomorrow quickly.
;; See http://emacs.wordpress.com/category/gnus/ for the original.
'(
((gnus-seconds-today) . "Today, %H:%M")
((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M")
(604800 . "%A %H:%M") ;;that's one week
((gnus-seconds-month) . "%A %d")
((gnus-seconds-year) . "%B %d")
(t . "%B %d '%y"))) ;;this one is used when no other does match


(defun gnus-group-read-group-no-prompt ()
"Read news in this newsgroup and don't prompt.
Use the value of `
gnus-large-newsgroup'."
(interactive)
(gnus-group-read-group gnus-large-newsgroup))

(defun gnus-article-sort-by-chars (h1 h2)
"Sort articles by size."
(< (mail-header-chars h1)
(mail-header-chars h2)))

(add-to-list 'message-syntax-checks '(existing-newsgroups . disabled))

(defun message-check-news-syntax ()
"Check the syntax of the message and prompt the user to be sure he wants to send."
(and
(save-excursion
(save-restriction
(widen)
(and
;; We narrow to the headers and check them first.
(save-excursion
(save-restriction
(message-narrow-to-headers)
(message-check-news-header-syntax)))
;; Check the body.
(message-check-news-body-syntax))))
; sm: this last line is my addition
(y-or-n-p "Post the message? ")
))



(defun wicked/gnus-add-subject-to-bbdb-record ()
"Add datestamped subject note for each person this message has been sent to."
(let* ((subject (concat (format-time-string "%Y.%m.%d")
": E-mail: " (message-fetch-field "Subject") "\n"))
(bbdb-get-addresses-headers
(list (assoc 'recipients bbdb-get-addresses-headers)))
records)
(setq records
(bbdb-update-records
(bbdb-get-addresses nil gnus-ignored-from-addresses 'gnus-fetch-field)
nil nil))
(mapc (lambda (rec)
(bbdb-record-putprop rec
'contact
(concat subject
(or
(bbdb-record-getprop rec 'contact)
""))))
records)))

(add-hook 'message-send-hook 'wicked/gnus-add-subject-to-bbdb-record)

(defun DE-bbdb-match-field-recipient (field regexp)
"Match FIELD for recipient against REGEXP.
FIELD must be a symbol, e.g. 'email-type."

(let (who rec)
(when (and
(gnus-buffer-live-p gnus-article-copy)
(setq who
(with-current-buffer gnus-article-copy
(save-restriction
(nnheader-narrow-to-headers)
(or (message-fetch-field "reply-to")
(message-fetch-field "from")))))
(setq rec
(bbdb-search-simple
nil
(cadr (gnus-extract-address-components who)))))
(string-match regexp (bbdb-get-field rec field)))))


;; group topics
(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)



;; we are all a bit egotistical and interested in our own ...
(add-hook 'message-sent-hook 'gnus-score-followup-article)
(add-hook 'message-sent-hook 'gnus-score-followup-thread)

;;F6 killfiles a poster, F7 ignores a thread
(define-key gnus-summary-mode-map (kbd "<f6>") "LA")
(define-key gnus-summary-mode-map (kbd "<f7>") 'gnus-summary-kill-thread)
(define-key gnus-summary-mode-map (kbd "<deletechar>") (lambda ()(interactive)(gnus-summary-delete-article)(next-line)))

;; some comfort keys to scroll article in other window when in summary window
(define-key gnus-summary-mode-map [(meta up)] (lambda() (interactive) (scroll-other-window -1)))
(define-key gnus-summary-mode-map [(meta down)] (lambda() (interactive) (scroll-other-window 1)))
;; thread navigation
(define-key gnus-summary-mode-map [(control down)] 'gnus-summary-next-thread)
(define-key gnus-summary-mode-map [(control up)] 'gnus-summary-prev-thread)

;; indexing in mail groups supported by dovecot on the server side.
(require 'nnir)
(define-key gnus-group-mode-map (kbd "<f1>") 'gnus-group-make-nnir-group)

(unless (assoc "audio/x-wav" w3m-content-type-alist)
(setq w3m-content-type-alist
(cons '("audio/x-wav" "\\.wav$" ("play" file))
w3m-content-type-alist)))

(defun playwav (url)
(interactive)
(message "url is %s" url)
(w3m-view-this-url url)
)

;; some trickery to show the newsread people are using and colour code depending on type
;; in this case highlight users of any outlook type dross :-;
(setq gnus-header-face-alist nil)
(add-to-list
'gnus-header-face-alist
(list (concat
"^"
(regexp-opt '("User-Agent" "X-Mailer" "Newsreader" "X-Newsreader") t)
":.*") ;; other
nil font-lock-comment-face))

(add-to-list
'gnus-header-face-alist
(list (concat
"^"
(regexp-opt '("User-Agent" "X-Mailer" "Newsreader" "X-Newsreader") t)
":.*Outlook.*")
nil 'gnus-emphasis-highlight-words))

;; And show any real men who use Gnus!
(add-to-list
'gnus-header-face-alist
(list (concat
"^"
(regexp-opt '("User-Agent" "X-Mailer" "Newsreader" "X-Newsreader") t)
":.*Gnus.*")
nil 'gnus-server-opened))

(defun jao-gnus-goto-google ()
(interactive)
(when (memq major-mode '(gnus-summary-mode gnus-article-mode))
(when (eq major-mode 'gnus-article-mode)
(gnus-article-show-summary))
(let* ((article (gnus-summary-article-number))
(header (gnus-summary-article-header article))
(id (substring (mail-header-id header) 1 -1))
(url (format "http://groups.google.com/groups?selm=%s" id)))
(if current-prefix-arg
(when url (browse-url-default-browser url))
(if url (browse-url url) (call-interactively 'browse-url))))))


(defun save-to-list ()
(interactive)
(bbdb/gnus-show-all-recipients)
)


;; Format RSS feed titles nicely
(add-hook 'gnus-summary-mode-hook
(lambda ()
(if (string-match "^nnrss:.*" gnus-newsgroup-name)
(progn
(make-local-variable 'gnus-show-threads)
(make-local-variable 'gnus-article-sort-functions)
(make-local-variable 'gnus-use-adaptive-scoring)
(make-local-variable 'gnus-use-scoring)
(make-local-variable 'gnus-score-find-score-files-function)
(make-local-variable 'gnus-summary-line-format)
(setq gnus-show-threads nil)
(setq gnus-article-sort-functions 'gnus-article-sort-by-date)
(setq gnus-use-adaptive-scoring nil)
(setq gnus-use-scoring t)
(setq gnus-score-find-score-files-function 'gnus-score-find-single)
(setq gnus-summary-line-format "%U%R%z%d %I%(%[ %s %]%)\n")))))


(add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp)

(defun gnus-user-format-function-d (headers)
(let ((time (gnus-group-timestamp gnus-tmp-group)))
(if time
(format-time-string "%b %d %H:%M" time)
""
)
)
)

(setq mail-sources
'((file :path "/var/spool/mail/shamrock")))

(setq gnus-select-method '(nnml ""))

(add-to-list 'gnus-secondary-select-methods
'(nnimap "riley"
(nnimap-address "offlineimap")
(nnir-search-engine imap)
(nnimap-stream network)
(nnimap-authinfo-file "~/.authinfo.gpg")))

(add-to-list 'gnus-secondary-select-methods
'(nnimap "shamrockpub"
(nnimap-address "offlineimap")
(nnir-search-engine imap)
(nnimap-stream network)
(nnimap-authinfo-file "~/.authinfo.gpg")))

(add-to-list 'gnus-secondary-select-methods
'(nnimap "friends"
(nnimap-address "offlineimap")
(nnir-search-engine imap)
(nnimap-stream network)
(nnimap-authinfo-file "~/.authinfo.gpg")))


(add-to-list 'gnus-secondary-select-methods '(nntp "Gmane" (nntp-address "news.gmane.org")))
(add-to-list 'gnus-secondary-select-methods '(nntp "Gwene" (nntp-address "news.gwene.org")))
(add-to-list 'gnus-secondary-select-methods '(nntp "Gnus" (nntp-address "news.gnus.org")))


(setq gnus-posting-styles `((".*"
(name "Richard Riley")
(from "Richard Riley <rileyrg@googlemail.com>")
(eval(setq gnushush-user-agent-header (quote real)))
(signature-file "~/.emacs.d/.sigs/rgr.sig")
(eval (setq mml2015-signers '("AB23BE58")))
(organization "aich tea tea pea dicky riley dot net"))))



(setq mail-host-address "news.eternal-september.org")

;; Select the correct smtp server based on the from address.
(defun msmtp-account (&optional def)
(let* ((from
(save-restriction
(message-narrow-to-headers)
(message-fetch-field "From")))
(account (if from (catch 'match
(dolist (element msmtp-name-list)
;; (message (format "smpt chosen is %s" element))
(when (string-match (format ".*%s.*" element) from)
(throw 'match element)))) nil)))
(if account account (if def def "default"))))

(defun msmtp-change-smtp ()
(setq sendmail-program "/usr/bin/msmtp")
(setq smtpmail-starttls-credentials '(("smtp.googlemail.com" 587 nil nil)))
(setq smtpmail-smtp-server "smtp.googlemail.com")
(setq message-sendmail-envelope-from 'header)
(if (message-mail-p)
(setq message-sendmail-extra-arguments (list "-a" (msmtp-account "default")))))
(add-hook 'message-send-hook 'msmtp-change-smtp)

(setq message-required-news-headers
(remove' Message-ID message-required-news-headers))




Misc UI settings

(fset 'yes-or-no-p 'y-or-n-p)

;; talk to the main x clipboard. A total clusterf*ck of over engineering.
(require 'xclip)
(turn-on-xclip)

;; Abbreviations
(setq abbrev-file-name "~/.emacs.d/.abbrev_defs")

;; Fast buffer and refile targets with fuzzy completion.
(require 'ido)
(ido-mode)

;; Show column mode in the mode line
(column-number-mode t)

;; An alternative for listing buffers.
;; Hardly use it now with IDO mode.
(require 'ibuffer)
(defalias 'list-buffers 'ibuffer)

;; Group the iBuffer contents.
(setq ibuffer-saved-filter-groups
(quote (("default"
("Org" ;; all org-related buffers
(mode . org-mode))
("Mail"
(or ;; mail-related buffers
(mode . message-mode)
(mode . mail-mode)
;; etc.; all your mail related modes
))
("MyProject1"
(filename . "src/myproject1/"))
("MyProject2"
(filename . "src/myproject2/"))
("Programming" ;; prog stuff not already in MyProjectX
(or
(mode . c-mode)
(mode . perl-mode)
(mode . python-mode)
(mode . emacs-lisp-mode)
;; etc
))
("ERC" (mode . erc-mode))))))

(add-hook 'ibuffer-mode-hook
(lambda ()
(ibuffer-switch-to-saved-filter-groups "default")))

;; Show vertical position relative in the mode line
(if (require 'sml-modeline nil 'noerror)
(progn
(sml-mode 1)
(scroll-bar-mode -1))
(scroll-bar-mode 1)
(set-scroll-bar-mode 'right))




Moving my dot files into org chunks and blogging them


The influx of code chunks to the blog are because I am moving my init
files to smaller org chunks. I think this could be helpful to not
only others but surely myself further down the road.


Process Emacs Command Line Options

(defvar server-emacs t
"If non-null, this emacs should run emacsclient.")
(defvar org-instance t
"If nil then no org bindings")
(defvar email-instance nil
"If nil then no email")
(defvar erc-instance nil
"If nil then no erc auto start")

(add-to-list
'command-switch-alist
'("email" . (lambda (&rest ignore)
;; Start Gnus when Emacs starts
(setq email-instance t))))

(add-to-list
'command-switch-alist
'("irc" . (lambda (&rest ignore)
(setq erc-instance t))))

(add-to-list
'command-switch-alist
'("no-server" . (lambda (&rest ignore)
(setq server-emacs nil))))

(add-to-list
'command-switch-alist
'("no-org" . (lambda (&rest ignore)
(setq org-instance nil))))

(add-hook 'emacs-startup-hook
(lambda ()
(when server-emacs
(server-start))
(when org-instance
(rgr-org))
(when erc-instance
(rgr/start-erc))
(when email-instance
(progn (gnus)))))




Save backup and temp files to the tmp directory

(setq backup-directory-alist
`((".*" . ,temporary-file-directory)))
(setq auto-save-file-name-transforms
`((".*" ,temporary-file-directory t)))





Sunday, September 12, 2010

IRC with ERC


erc is an excellent package to access irc from emacs. This includes an
interface to IDO fast buffer selection. I keep the important password
type vars in private.gpg.





  (require 'erc)

(setq
erc-prompt-for-nickserv-password nil
erc-autoaway-idle-seconds 600
erc-autoaway-message "Timed out."
erc-auto-discard-away t
)


; alert when someone highlights you.
(defun my-erc-nick-match (match-type nickuserhost message)
(cond
((eq match-type 'current-nick)
(if (eq (string-match (concat (erc-current-nick) ":") message) 0) (rgr/notify message)))))

(add-hook 'erc-text-matched-hook 'my-erc-nick-match)

; auto truncatebuffers
(defvar erc-insert-post-hook)
(add-hook 'erc-insert-post-hook
'erc-truncate-buffer)

(defun rgr/start-erc ()
(interactive)
(unless (erc-already-logged-in "im.rootdir.de" 6668 "rgr") (erc :server "88.198.83.122" :nick "rgr" :password bitl-password :port 6668)) ; im.rootdir.de
(if (not (erc-already-logged-in "irc.freenode.net" 6667 "rgr"))
(erc :server "irc.freenode.net" :nick "rgr" :password erc-password :port 6667)
(progn
(switch-to-buffer "#emacs"))) )

; /INFO auto logs the eval line for someone to evaluate to take them to the same INFO page you are currently viewing.
(defun erc-cmd-INFO (&rest ignore)
(erc-send-message (format "Evaluate this using C-x C-e with cursor at closing bracket --> %s" (rgr/info-link))))

; IDO switch between irc channels.
(defun rgr/ido-erc-buffer()
(interactive)
(switch-to-buffer
(ido-completing-read "Channel:"
(save-excursion
(delq
nil
(mapcar (lambda (buf)
(when (buffer-live-p buf)
(with-current-buffer buf
(and (eq major-mode 'erc-mode)
(buffer-name buf)))))
(buffer-list)))))))

(global-set-key (kbd "C-c e") 'rgr/ido-erc-buffer)





Security (PGP) - keychain

; settings moved to custom
(require 'keychain-environment)
(load "private.gpg")




dotemacs on github


My emacs files are now in github following a request for the files in
raw format. The main entry point is init.el at master from rileyrg's emacs - GitHub which processes emacs-init.org at master from rileyrg's emacs - GitHub to produce emacs-init.el at master from rileyrg's emacs - GitHub. Custom variables are stored in custom.el at master from rileyrg's emacs - GitHub. Not all of the things loaded by my init
files are in git. Some you will have to track down and install as
dependencies.


Saturday, September 11, 2010

org-google-weather


The google-weather Emacs extension allows to run access the Google Weather API from Emacs.



Org Mode : weather forecast in the agenda



Small patch to make it better behaved in terminal mode emacs





        Modified google-weather.el
diff --git a/google-weather.el b/google-weather.el
index 393a3cf..898c91b 100644
--- a/google-weather.el
+++ b/google-weather.el
@@ -162,8 +162,8 @@ See `google-weather-retrieve-data' for the use of EXPIRE-TIME."
`(,forecast-encoded-date
(low ,(google-weather-assoc 'low forecast))
(high ,(google-weather-assoc 'high forecast))
- (icon ,(concat google-weather-image-url
- (google-weather-assoc 'icon forecast)))
+ (icon ,(if (window-system) (concat google-weather-image-url
+ (google-weather-assoc 'icon forecast)) ""))
(condition ,(google-weather-assoc 'condition forecast)))))
(loop for entry in (google-weather-data->weather data)
when (eq (car entry) 'forecast_conditions)



Tagged org-googlecl as now includes interactive blog prompt


General function to prompt you if you really want to blog the org
entry if you are in an org buffer.





(defun googlecl-prompt-blog ()
"If in a org buffer prompt whether to blog the entire entry else normal text blog."
(interactive)
(if (eq major-mode 'org-mode)
(if (yes-or-no-p "Blog the Org Entry?")
(org-googlecl-blog)
(googlecl-blog))
(googlecl-blog)))






org-googlecl-blog at github


Wednesday, September 8, 2010

org-capture templates

(("t" "Todo" entry
(file+headline "" "Tasks To Refile")
"* TODO %?\n:PROPERTIES:\n :DateCreated: %T\n:END:\n%i\n%a")
("j" "Journal" entry
(file+datetree "journal.org")
"* %?\n:PROPERTIES:\n :DateCreated: %T\n:END:\n\n#+begin_src emacs-lisp\n%i\n#+end_src\n%a")
("n" "Quick note to refile later" entry
(file+headline "" "Notes To Refile")
"* %?\n:PROPERTIES:\n :DateCreated: %T\n:END:\n#+being_src\n%i\n#+end_src\n\n%a")
("w" "web capture" entry
(file "refile.org")
"* %a %?\\n:PROPERTIES:\n :DateCreated: %T\n:END:n\n%i"))



improved code for googlecl blog

Click here for newer code hosted on git-hub.

(defcustom org-googlecl-blogname "My Blog Name"
"The name of the default blogger/blogspot blog you wish to blog to."
:group 'org-googlecl
:type 'string)

(defcustom org-googlecl-username "changeme@googlemail.com"
"The google user id you wish to authenticate with. e.g mydevusername@googlemail.com"
:group 'org-googlecl
:type 'string)

(defun rgr/org-blog-entry ()
(interactive)
(if current-prefix-arg
; WOuld be nice to be able to query possible blogs and allow tab completion on legal names.
(setq org-googlecl-blogname (read-from-minibuffer "Blog Name:")))
(save-excursion
(let ((tmpheading (org-get-heading))
tmptags (org-get-tags-string))
(goto-char (org-entry-beginning-position))
(set-mark (org-entry-end-position))
(let*((tmpfile (make-temp-file "org-blog-html-"))
(blog-command (concat "google blogger post --blog \"" org-googlecl-blogname "\" --title \"" tmpheading "\" --user \"" org-googlecl-username (if (length tmptags) (concat "\" --tags \"org-googlecl," tmptags "\" ") "") tmpfile )))
(message "google blog command is : %s" blog-command)
(org-export-as-html 1 nil nil (find-file-noselect tmpfile) t)
(with-current-buffer (get-file-buffer tmpfile) (save-buffer))
(start-process-shell-command "Google Blog" "*googlecl*" blog-command)))))

Friday, September 3, 2010

Gnus group line pretty printing with UNREAD indicators

The following code assigns a unique read/unread face to the pertinent parts of the gnus group lines in the *Group* buffer. use %ug in your gnus-group-line-format and %s in your gnus-summary-line-format.

Here is an example screenshot

http://www.myupload.org/viewer.php?file=s3vqv9z8xihsdo3g27vm.png



(setq rgr/server-name-maps
'(("RI" . "Private")
("SH" . "Work")
("FR" . "Friends")
("KL" . "Sports")
("HA" . "Fun")
("GM" . "Gmane")
("GN" . "Gnu")
("" . "Unknown")
))

(copy-face 'default 'my-subject-face)
(copy-face 'default 'my-group-face)
(copy-face 'default 'my-group-face-unread)
(copy-face 'default 'my-inbox-face)
(copy-face 'default 'my-inbox-face-unread)
(copy-face 'default 'my-group-server-face)
(copy-face 'default 'my-group-server-face-unread)
(copy-face 'default 'my-unread-count-face)
(copy-face 'default 'my-unread-count-face-unread)

(copy-face 'default 'my-topic-empty-face)
(copy-face 'default 'my-topic-face)


(setq gnus-topic-line-format "%i[ %u&topic-line; ] %v\n")

(defun rgr/unread-face (f)
(intern (if (> (string-to-number gnus-tmp-number-of-unread) 0) (concat f "-unread") f)))

;; this corresponds to a topic line format of "%n %A"
(defun gnus-user-format-function-topic-line (dummy)
(let ((topic-face (if (zerop total-number-of-articles)
'my-topic-empty-face
'my-topic-face)))
(propertize
(format "%s %d" name total-number-of-articles)
'face topic-face)))

(defun gnus-user-format-function-s (header)
(propertize (mail-header-subject header) 'face 'my-subject-face 'gnus-face t))

(defun gnus-user-format-function-g (headers) ;; gnus-group-line-format use %ug to call this func! e.g "%M%S%p%P%(%-40,40ug%)%-5uy %ud\n"
;; split full group protocol-server:group into three parts.
(string-match "\\(^.*\\)\\+\\(.*\\):\\(.*\\)" gnus-tmp-group)
;; map the first two letters of the server name to a more friendly and cuddly display name
(let* ((match-ok (match-string 2 gnus-tmp-group))
(server-key (if (null match-ok) nil (upcase(substring match-ok 0 2)))))
(if (zerop (length server-key))
gnus-tmp-group
;; construct new group format line with a small envelope taking the place of any INBOX
(concat
(propertize
(format "%-8s" (cdr (assoc server-key rgr/server-name-maps)))
'face (rgr/unread-face "my-group-server-face") 'gnus-face t)
" - "
(if (string-match "INBOX" (match-string 3 gnus-tmp-group) )
(propertize "\x2709" 'face (rgr/unread-face "my-inbox-face") 'gnus-face t)
(propertize (match-string 3 gnus-tmp-group) 'face (rgr/unread-face "my-group-face") 'gnus-face t) )))))


(defun gnus-user-format-function-j (headers)
;; prefix each post depending on whether to, cc or Bcc to
(let ((to (gnus-extra-header 'To headers)))
(if (string-match rgr-mails to)
(if (string-match "," to) "~" "»")
(if (or (string-match rgr-mails
(gnus-extra-header 'Cc headers))
(string-match rgr-mails
(gnus-extra-header 'BCc headers)))
"~"
" "))))

(setq gnus-user-date-format-alist
;; Format the date so we can see today/tomorrow quickly.
;; See http://emacs.wordpress.com/category/gnus/ for the original.
'(
((gnus-seconds-today) . "Today, %H:%M")
((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M")
(604800 . "%A %H:%M") ;;that's one week
((gnus-seconds-month) . "%A %d")
((gnus-seconds-year) . "%B %d")
(t . "%B %d '%y"))) ;;this one is used when no other does match


(defun gnus-user-format-function-y (headers)
(if (string-match "^nnfolder" gnus-tmp-group)
""
(propertize (concat "" gnus-tmp-number-of-unread "") 'face '(rgr/unread-face "my-unread-count-face") 'gnus-face t)))

using IDO flex matching for ERC buffers


(defun rgr/ido-erc-buffer()
(interactive)
(switch-to-buffer
(ido-completing-read "Channel:"
(save-excursion
(delq
nil
(mapcar (lambda (buf)
(when (buffer-live-p buf)
(with-current-buffer buf
(and (eq major-mode 'erc-mode)
(buffer-name buf)))))
(buffer-list)))))))

(global-set-key (kbd "C-c e") 'rgr/ido-erc-buffer)