Iconify all discrete settings types

Also allow cascaded CSS : setting page css and then current page.

Unique images for each setting type available from css bg images.

Can now hide edit dialog properly using jscript. Also can duplicate events.

Image showing hiding edit dialog and duplication of events

--
My Emacs Files At GitHub

Added javascript toggle for the edit/create even dialog.

Javascript can be used to access document elements by ID on the client. In this
case we can toggle the visibility of the #editeventform using the css display
property.

http://rileyrg.imgur.com/pub_web_software/NQnSu

--
My Emacs Files At GitHub

Settings can be visible.

Particularly useful for things like web settings for comms path eg phone, email, fx etc. Token is the access id, title is human readable heading (can be internationalised) and description holds the value (again can be different for each language).

Visible Settings

In addition, added confirmation for all deletions

Protect settings and meta from deletion

No delete option for metas and settings

Meta data and general settings unified into internationalised event UI

keywords META tag as a setting in the event list

Which means you can edit as any other event and internationalise accordingly.

function getPageMetaHTML($category)
{
       $sql='select id from events where token="meta" and fenabled=1 and category="'.$category.'"';
       if(($result=getDB()->query($sql))==false)
               return "";

       if($result->num_rows==0){
               if($category!="index"){
                       return getPageMetaHTML("index");
               }else
                       return "";
       }
       $res="";
       while($r=$result->fetch_assoc()){
               getEventLocaleFields(&$r);
               $res.='<meta name="'.$r{"title"}.'" content="'.$r{"event"}.'">';
       }
       return $res;
}

--
My Emacs Files At GitHub

Using xmonad to control Yoono as a scratchpad

Yoono is head and shoulders above the rest when it comes to "Social Networking"
monitoring and configuration with instance messaging on the desktop. Especially
since it works well on Linux too.

That said, like a lot of these kind of tools it can be too in your face. Well,
if you use a decent tiling Windows Manager like xmonad all is instantly
solved. Providing you know some Haskell. chuckle …

scratchpads = [

 -- run htop in xterm, find it by title, use default floating window placement

--     NS "google-chrome" "google-chrome" (className =? "Google-chrome") nonFloating ,
--     NS "browser" "conkeror" (className =? "Conkeror") nonFloating ,
     NS "browser" "iceweasel -new-tab" (className =? "Iceweasel") nonFloating ,
     NS "evince" "evince" (className =? "evince") nonFloating ,
     NS "yoono" "yoono" (name =? "Yoono") defaultFloating ,
     NS "surf" "surf" (className =? "surf") nonFloating ,
     NS "emacs" "edit -c" (className =? "Emacs") nonFloating,
     NS "unison" "unison-gtk" (className =? "unison-gtk") nonFloating ,
     NS "htop" "xterm -name htop -e htop" (title =? "htop") 
         (customFloating $ W.RationalRect (1/3) (1/8) (2/3) (1/2)) ,
     NS "newsbeuter" "xterm -e myrss" (title =? "myrss")
         (customFloating $ W.RationalRect (1/2) 0 (1/2) (1/4)) 

 ] where name = stringProperty "WM_NAME"

and then in my keyboard hook

,((modMask myConfig .|. shiftMask, xK_y),  namedScratchpadAction scratchpads "yoono")

et Voila. Toggle it via a hotkey.

--
My Emacs Files At GitHub

Edit and Create Event dialog now using dynamic CSS for layout

Floating layouts for event dialogs. Advanced section automatically hides unless you select it.

--
My Emacs Files At GitHub

Enabling/Disabling events for Social Network sharing.

Enabling sharing example.

The create new/edit dialog now includes the ability to toggle event
sharing. This would typically be used to disable sharing for an item which can
not stand on its own such as a list item - some support text to an item that
includes an embedded object like a gcalendar or twitter feed for example. Or
perhaps simply something you dont want shared! Typically used in conjuntion with
the orderby field which is, currently, the only crude way to order things
(outside of caelendar ordering) in an event list in order to ensure certains
items remain at the top or bottom or follow a previous item. Relative ordering
and grouping is in the pipeline - this will facilitate online menu construction
and perhaps photo album management although I am doubtful that anything I
shoehorn in there can in any shape or form approach the functionality provided
by the plethora of existing solutions for photo management. Its what links are
for …

Event In German

As an added bonus it will now also allow you to share in another language. Just
set the language on the web page before sharing and the link back will ensure
that the article/event is in that language when people click back.

--
My Emacs Files At GitHub

Events can now be uniquely idendified in order to facilitate meta information for social network sharing.

A single event now has a unique meta tagging for title and description since facebook, twitter etc sieve the pages for these meta tags in order to describe the page they are linking to.

--
My Emacs Files At GitHub

Share your sites and events

http://www.addthis.com/

A simply wonderful utility to enable social networkers to spread the word.

Embeds a small icon (or list of icons) to enable people to link to your page from their blogs, facebook, etc etc etc. Lets go viral!

AddThis at work on the pub's web page.

--
My Emacs Files At GitHub

Temporary placeholder pages for barwebs.com

Pub and Band websites. Dedicated and specialised event management.

http://www.barwebs.com hosted at the The Shamrock's page for now.

--
My Emacs Files At GitHub

New And Edit Event Dialogs Rejigged

Edit Event

New Event

--
My Emacs Files At GitHub

Webs now using mssqli and simplified css layout

The Shamrock Irish Bar, Hamburg

Inspiration Yachts

Steve Fairway Music

--
My Emacs Files At GitHub

Moved from mysql functions mysqli class.

@mysql function calls pretty much deprecated in php. Moved all the code to
mysqli based. Pretty straightforward. e.g

$f=@fopen("authinfo","r",true);
$auth=explode(" ",@fgets($f));
@fclose($f);
setDB($mysqli = new mysqli($auth{3},$auth{0},$auth{1},$auth{2}));
if ($mysqli->connect_error) {
die('Connect Error (' . $mysqli->connect_errno . ') '
. $mysqli->connect_error);
}

--
My Emacs Files At GitHub

Steve Fairway site now released.

New album "Souled Out". New domain name. See all at Steve Fairway Enterntainment Homepage.

--
My Emacs Files At GitHub

db update scripts

-- move all text into msgcodes
-- insert into msgcodes (id,lang_id,msgtext)  select concat(id,"-event"),1,event from events;
-- insert into msgcodes (id,lang_id,msgtext)  select concat(id,"-title"),1,title from events;
-- alter table events drop title;
-- alter table events drop event;

-- added code field to languages to hold two letter language code
alter table languages drop column code;
alter table languages add column code char(2) after id;
update languages set code=lcase(substring(language FROM 1 FOR 2));
alter table msgcodes change id id varchar(32);
alter table languages drop column field;
alter table msgcodes add column field varchar(32) after lang_id;
alter table msgcodes drop column fkey;
alter table msgcodes add column fkey int(10) unsigned after lang_id;
alter table msgcodes ENGINE = InnoDB;
alter table events ENGINE = InnoDB;
update msgcodes set fkey=SUBSTRING_INDEX(id,"-",1) where id  REGEXP '^[0-9]+-';
update msgcodes set field=SUBSTRING_INDEX(id,"-",-1) where id  REGEXP '^[0-9]+-';
alter table msgcodes add constraint deletecodes foreign key (fkey) references events (id) on delete cascade;

~/webs/db-update.sql::– move all text into msgcodes

--
My Emacs Files At GitHub

Finally completed internationalising simple web support structure

The web SW now links all event titles and descriptions to relevant msgcode
entries. This means you can enter an event in English, switch to german and then
locale that in German.

--
My Emacs Files At GitHub

Css Drop Downs Supporting Direct Event Editing

Event list drop downs from navigation icons now allow direct editing

Drop down menus live from mySQL using CSS

I was preparing to entire the hazy horrible world of Java script to provide
event links from the navigation toolbar. And then! Bing! Why not use CSS? And it
works. Super. Click on the annoying advert below to take a gander …

--
My Emacs Files At GitHub

Finally : a good pop up translator for FireFox

I can't believe I missed this bad boy before.

Babel Translator will pop up word translations, select translations etc. Highly
customisable. Superb.

Babel Translator For Firefox

--
My Emacs Files At GitHub

Google Sitemap Generator

SiteMaps seems to be another way to optimsie google ratings. The link talks about googles own sitempa generator.

A site which claims to generate free sitemaps is XMLSiteMaps.

--
My Emacs Files At GitHub

Emacs 23, the emacs daemon and emacsclient

A recent entry to planetemacsen reminded me of a wiki entry added a good while
back which complements, or even supercedes, other methods of starting the emacs
daemon. There are a lot of solutions for running the emacs daemon when not
already running and/or using the emacsclient. I find the following solution
most convenient since there is no need to specifically start the server yourself
at any stage - it makes use of the alternate-editor option. Create a small
script and place it somewhere on your path.

#!/bin/bash
# edit
exec emacsclient --alternate-editor="" -c "$@"

The ="" is the key. This tells the emacsclient code to start the daemon and then
call itself if its not already running.

The wiki entry tells you more and describes the use of the EDITOR env variable.

--
My Emacs Files At GitHub

Fuzzy Search In Emacs

fuzzy.el provides a super fuzzy search capacity. Save the code linked below to somewhere on your elisp path, add the two lines below to your .emacs and now C-s (isearch-forward) will become "fuzzy" after the first miss for the item you are searching for. You can customise the "fuzzy" group to change the fuzziness. This module is part of the superb auto-complete suite - recommended.

(require 'fuzzy)
(turn-on-fuzzy-isearch)

--
My Emacs Files At GitHub

Steve Fairway Web up and running

The css opacity commands are pretty nice.

Anyway, pleae visit here Mr Google!

--
My Emacs Files At GitHub

Emacs Session Management

(desktop-save-mode t) ; remember which files were open
(require 'midnight) ; Clear up unimportant buffers
(require 'savehist-20+)
(savehist-mode 1)

--
My Emacs Files At GitHub

Add command line option to use nognus instead of gnus

(add-to-list
 'command-switch-alist
 '("nognus" . (lambda (&rest ignore)
                (add-to-list 'load-path "~/.emacs.d/nognus/lisp")
                (message "NoGnus loaded")
                (load "gnus-load")  ;; Needed if using  nognus.
                ;; Start Gnus when Emacs starts
                (setq email-instance t))))

--
My Emacs Files At GitHub

Keep something called shush quiet

Resyncing my little network including the Pub machine, I realised that my ssh logins were too noisy. eg. I would

>ssh $PUB

to see the following unnecessary chatter

Linux thinkpadt60 2.6.32-5-686 #1 SMP Sat Sep 18 02:14:45 UTC 2010 i686

The programs included with the Debian GNU/Linux system are free software;
the exact distribution terms for each program are described in the
individual files in /usr/share/doc/*/copyright.

Debian GNU/Linux comes with ABSOLUTELY NO WARRANTY, to the extent
permitted by applicable law.
No mail.
Last login: Mon Sep 27 19:16:11 2010 from development

The solution is very simple. On the remote machine simply create a .hushlogin file.

>touch ~/.hushlogin

If it doesnt work then check your /etc/login.defs file for the hush settings. Mine are like this:

# If defined, file which inhibits all the usual chatter during the login
# sequence.  If a full pathname, then hushed mode will be enabled if the
# user's name or shell are found in the file.  If not a full pathname, then
# hushed mode will be enabled if the file exists in the user's home directory.
#
HUSHLOGIN_FILE  .hushlogin
#HUSHLOGIN_FILE /etc/hushlogins

--
My Emacs Files At GitHub

NoGnus takes Gnus to the next level.

A popular objection to using Gnus was that its IMAP performance was
poor and its article counting simply rubbish. Not any more. Lars has
written pretty much a totally new back end for the imap portion of
gnus. Following an exchange of emails today it now works with my
dovecot set up which uses virtual users on the same dovecot server to
seperate different gmail accounts I sync with my local dovecot using
the excellent offlineimap. e.g The select name is passed as the server
name and each one has a corresponding .authinfo "machine" entry. e.g

(add-to-list 'gnus-secondary-select-methods
           `(nnimap "riley"
                    (nnimap-address "offlineimap")
                    (nnir-search-engine imap)
                    (nnimap-stream network)
                    ))

(add-to-list 'gnus-secondary-select-methods
           `(nnimap "shamrockpub"
                    (nnimap-address "offlineimap")
                    (nnir-search-engine imap)
                    (nnimap-stream network)
                    ))

(add-to-list 'gnus-secondary-select-methods
           `(nnimap "friends"
                    (nnimap-address "offlineimap")
                    (nnir-search-engine imap)
                    (nnimap-stream network)
                    ))

riley, friends and shamrockpub all have entries in .authinfo.gpg e.g

machine riley login riley password pass1
machine friends login friends password pass2
machine shamrockpub login shamrockpub password pass3

and these then, in turn, correspond to dovecot virtual users.
Group refresh is almost instant now. And article counts appear to be spot on.
You can grap nognus from here. Be sure to add it to you path and remember you need to

(load "gnus-load")

Grab it while its hot - I'm sure he would sooner get bug reports now
rather than months down the road when his mojo is depleted!

You can get nognus here.

--
My Emacs Files At GitHub

Getting the repaired web server working.

Fun, fun, fun. So following the demise of Hermes I took him into the
local shop for a checkout. The motherboard had gone too. My face
showed my pain. The techy there suggested he could try and dig out a
new main board. a day later I get a call : he's up and running. Ok, a
bit of a Frankenstein but running. Then the fun begins. How tricky
would it be to get Hermes back online, Transfer all the mysql data and
web stuff I had worked on the past few days for some friends?
Surprisingly easy as it turned out. Firtly Hermes nest doesn't have a
monitor or keyboard so I took him over to my main desktop and borrowed
the monitor and keyboard. I booted Hermes into Debian Lenny without a
glitch. Damn no network. I had been expecting that. So

#ifconfig -a

shows me that it was eth2 I needed to configure. Then a quick edit of /etc/network/interfaces as follows

# This file describes the network interfaces available on your system
# and how to activate them. For more information, see interfaces(5).

# The loopback network interface
auto lo
iface lo inet loopback

auto eth2
# The primary network interface
allow-hotplug eth2
iface eth2 inet static
 address 192.168.0.101
 gateway 192.168.0.1
 netmask 255.255.255.0
 network 192.168.0.0
 broadcast 192.168.0.255
dns-nameservers 192.168.0.1

Oh but wait. Hermes used to be a bind9 dns. It's hell to configure. Error prone and total overkill so ….

#sudo aptitude purge bind9

For my uses /etc/hosts will suffice. The its a case of seeing if we can obtain an ip address

#/etc/init.d/networking restart
#ifconfig -a

Success! So I shutdown Hermes, trundled him back to his nest, minus
keyboard and monitor, plugged him in, turned on the power and shazam!
A fully functional Debian Lenny apache/mysql server is up and
running. Total cost of repait including new second hand mainboard with
associated psul? 60 euro. Bargain.

For the rest of the configuration it was simply a case of using ssh login and scp.

--
My Emacs Files At GitHub

Trying gmap link type

Sebastian rose shows how to use google maps or open maps as link types.

Let see how it renders in a blog?

My Pub

Subject: Yet another way to use maps --- the light way
From: Sebastian Rose <sebastian_rose@gmx.de>
Date: Thu, 23 Sep 2010 10:17:14 +0200

Hi,

there is a light and easy way to use google and openstreetmap.org maps
if you define them as a custom link type:

(setq org-link-abbrev-alist
  '(("gmap"
     . "http://maps.google.com/maps?q=%s")
    ("omap"
      . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1")))

Now
  [[gmap:Falkenstr 10, Hannover, Germany][Falkenstraße]]

and
  [[omap:Falkenstr 10, Hannover, Germany]]

show a map in your browser.  LaTeX and HTML export works out the box
with the advantage, that this export can legally be published on the
internet without any additional action (API license key).  Even on
commercial sites, as it's just a link to google.  OSM is no problem
anyway.

This way it's possible to show a certain place on earth, but not a track
or route.

There's a (known) bug in the LaTeX eporter:

        [[Falkenstraße 10, Hannover, Germany]]

will _not_ work, because the german Umlaut will be distorted somehow
(unless fixed already....)

  Sebastian

--
My Emacs Files At GitHub

Gaming Excellence

Every now and again you play a game which makes you sit up and gawk. Uncharted 2, along with Red Dead Redemption, is one such. The attention to detail, the physics, the texures, the sound, the story line and the mind boggingly massive length of the game make this a must have. You can watch a playthrough here. Finishing this game leaves with an aching desire for more. Not one time did I feel "been there done that". Astonishing.

--
My Emacs Files At GitHub

Disaster. It doesn't get worse.

Familiarity breeds contempt. My faithful Debian Lenny web server, git repository, mysql server, irc gateway, ftp server etc etc has exploded. Most importantly is was my LANs DHCP and DNS. What does this mean? It means, and astonishingly, that my main development machine wont even boot into X. Can you believe that? Turning DNS back on on my router confirms that DNS not working on the designated dhcp/dns server actually stops the GLX module loading on my development machine? OK. DNS is back on, courtesy of my router, and this machine is now full res again with the Nvidia drivers correctly loaded. But talk about screwy dependencies.

The server is now at the doctors hopefully getting a new PSU. The outlook is bleak. Oh yes. Contempt? Yup. I hadn't checked the server cron jobs were correctly backing up things like the individial web servers mysql dbs. They weren't. Cron had decided to give up the ghost about a month ago it seems - mea culpa - I need to discipline myself to not trust this stuff as much as I have been.

The feeling of helplessness when booting a trusted debian desktop machine only to get the "X not loaded" BSOD and then having to wait 10 seconds after every bash command because of name resolution issues is really quite accute.

Fingers crossed that Hermes responds to treatment and that the good doctors at Level 1 can graft on a new PSU. It's an old P4 machine. A rock. A workhorse. And broken.

If a setting is function call that else if true call a hardcoded default

(defun callSettingFunc (&rest t)
  (when f
    (let ((f (if (functionp f) ; check if its a valid function name.
                      f 
                    'message))) ; use built in message function if not set to a function name
      (apply f t))))

--
My Emacs Files At GitHub

Insert or split babel src block

2010-09-19 Sun

(define-key org-mode-map (kbd "C-c C-b") 'rgr/org-split-src)
(defun rgr/org-split-src(&optional arg)
  (interactive "P")
  (beginning-of-line)
  ((lambda(info)
     (if info
         (let ((pos (point))
               (lang (nth 0 info))
               (stars (make-string (org-current-level) ?*)))
           (insert 
            (format 
             "%s\n%s \n#+begin_src %s\n%s#+end_src\n%s \n#+begin_src %s\n" 
             "#+end_src"
             stars
             lang
             (if (region-active-p) 
                 (delete-and-extract-region (region-beginning) (region-end)) "\n")
             stars
             lang))
             (org-back-to-heading))
       (insert 
        (format 
         "\n#+begin_src\n%s\n#+end_src\n" 
         (if (region-active-p) 
             (delete-and-extract-region (region-beginning) (region-end)) "")))))
   (org-babel-get-src-block-info)))

--
My Emacs Files At GitHub

Altering the style of source code snippets at blogspot

When editing your blog go to "design" and then edit your template. Add
the following to the end of CSS section.

pre.src {border: 1px solid rgb(187, 187, 187);
margin: 15px 5px;
padding: 5px;
background: rgb(238}\, 238, 238) none repeat scroll 0% 0%;
overflow: auto;
font-size: 130%;
-moz-background-clip: border;
-moz-background-origin: padding;
-moz-background-inline-policy: continuous;
}

Also see http://emacs-fu.blogspot.com/2010/05/using-zenburn-for-org-mode-generated.html

--
My Emacs Files At GitHub

Mark region as src code. If prefix used then create new org entry with the region marked as src.

(define-key org-mode-map (kbd "C-c C-b") '
  (lambda()(interactive)
    (let ((stars (make-string (org-current-level) ?*)))
      (insert 
       (format 
        "%s%s \n#+begin_src emacs-lisp\n%s#+end_src\n%s" 
        (if current-prefix-arg "#+end_src\n\n") stars (delete-and-extract-region (region-beginning) (region-end)) (if current-prefix-arg (concat "\n" stars " \n#+begin_src emacs-lisp")))))))

--
My Emacs Files At GitHub

Reopen a buffer as root prompting for password if necessary

(defun find-alternative-file-with-sudo ()
    "Open current buffer as root!"
    (interactive)
    (when buffer-file-name
      (find-alternate-file
       (concat "/sudo:root@localhost:"
               buffer-file-name))))

  (global-set-key (kbd "C-x C-r") 'find-alternative-file-with-sudo)

--
My Emacs Files At GitHub

workgroups for windows (emacs layouts)

thunk, #emacs.

http://github.com/tlh/workgroups.el

<irc:/irc.freenode.net:6667/#emacs>

--
My Emacs Files At GitHub

Creating a regexp from a set

(regexp-opt '("foo" "bar" "baz")) ; ==> "\\(?:ba[rz]\\|foo\\)"

--
My Emacs Files At GitHub

Store existing blogger labels in org item created by the blog search functionality

Updated the list blog functionality to read back the tags from the
blogger entry and add them to the newly created org mode item in case
you cant to refile.

(global-set-key (kbd "C-c L") 'googlecl-list-blogs)

(defun googlecl-list-process (proc string)
  (with-current-buffer (process-buffer proc)
    (delete-region (point-min) (point-max))
    (org-mode)
    (org-insert-heading)
    (insert(format " List of blogs with <%s> in the title\n\n" googlecl-default-title-filter))
    (setq string (replace-regexp-in-string "\n$" ""  string))
    (save-excursion
      (let ((items (split-string string "\n"))
            (first t))
        (while items
            (let((item (pop items)))
              (org-insert-heading)
              (string-match "\\(.*\\),\\(http.*\\),\\(.*\\)$" item)
              (insert  (format "%s\n  %s" (match-string 1 item)(match-string 2 item)))
              (let ((taglist (split-string (match-string 3 item) ";")))
                (if taglist (org-set-tags-to (add-to-list 'taglist googlecl-blog-tag))))
              (if first (progn
                          (setq first nil)
                          (org-back-to-heading)
                          (org-metaright)
                          (org-end-of-subtree))))))))
  (switch-to-buffer (process-buffer proc)))

(defun googlecl-list-blogs ()
  "accept a  title filter value and then list all blogs which match that value"
  (interactive)
  (let*((regexpfilter (read-from-minibuffer "Title Contains:"  googlecl-default-title-filter) )
         (listblogcmd (concat  "google blogger list title,url,tags --title \"" regexpfilter "\"")))
    (setq googlecl-default-title-filter regexpfilter)
    (message "List blog command is : %s" listblogcmd)
    (set-process-filter  (start-process-shell-command "googlecl-list" "*googlcl blogs*" listblogcmd) 'googlecl-list-process)))

--
My Emacs Files At GitHub

List all blogger blogs whose titles match a regular expression

Added support to list all blogs containing certain regexp.
Create an org-mode buffer so you can refile links etc.

Original code here

(global-set-key (kbd "C-c L") 'googlecl-list-blogs)

(defun googlecl-list-process (proc string)
(with-current-buffer (process-buffer proc)
(delete-region (point-min) (point-max))
(org-mode)
(org-insert-heading)
(insert(format " List of blogs with <%s> in the title\n\n" googlecl-default-title-filter))
(setq string (replace-regexp-in-string "\n$" ""  string))
(save-excursion
 (let ((items (split-string string "\n"))
       (first t))
   (while items
       (org-insert-heading)
       (insert  (replace-regexp-in-string ",http:" "\n  http:" (pop items)))
       (org-set-tags-to googlecl-blog-tag)
       (if first (progn
                   (setq first nil)
                   (org-back-to-heading)
                   (org-metaright)
                   (org-end-of-subtree)))))))
(switch-to-buffer (process-buffer proc)))

(defun googlecl-list-blogs ()
"accept a  title filter value and then list all blogs which match that value"
(interactive)
(let*((regexpfilter (read-from-minibuffer "Title Contains:"  googlecl-default-title-filter) )
    (listblogcmd (concat  "google blogger list title,url --title \"" regexpfilter "\"")))
(setq googlecl-default-title-filter regexpfilter)
(message "List blog command is : %s" listblogcmd)
(set-process-filter  (start-process-shell-command "googlecl-list" "*googlcl blogs*" listblogcmd) 'googlecl-list-process)))

--
My Emacs Files At GitHub

Using buffer narrowing in Emacs

Article about using buffer narrowing at the emacs-fu blog.
Very useful.
Emacs Manual : narrowing.
As a side note, emacs-fu is an awesome emacs resource.

--
My Emacs Files At GitHub

Last change navigation in Emacs

This is pretty good. Allows you to track back though the last places you altered.

(autoload 'goto-last-change "goto-last-change"
   "Set point to the position of the last change." t)
(global-set-key (kbd "C-x C-n") 'goto-last-change)

--
My Emacs Files At GitHub

Sheeva plug : the idle web server

Wonderful devices : http://en.wikipedia.org/wiki/SheevaPlug

Small, cheap to run, headless, support Debian. Reliable I guess.

--
My Emacs Files At GitHub

Different color themes depending on windows or terminal

http://emacs-fu.blogspot.com/2009/03/color-theming.html

(require 'color-theme)
(require 'zenburn)
(color-theme-initialize)

(defvar after-make-console-frame-hooks '()
  "Hooks to run after creating a new TTY frame")
(defvar after-make-window-system-frame-hooks '()
  "Hooks to run after creating a new window-system frame")
(defun run-after-make-frame-hooks (frame)
  "Selectively run either `after-make-console-frame-hooks' or
`after-make-window-system-frame-hooks'"
  (select-frame frame)
  (run-hooks (if window-system
                 'after-make-window-system-frame-hooks
               'after-make-console-frame-hooks)))
(add-hook 'after-make-frame-functions 'run-after-make-frame-hooks)
(add-hook 'after-init-hook
          (lambda ()
            (run-after-make-frame-hooks (selected-frame))))
(set-variable 'color-theme-is-global nil)
(add-hook 'after-make-window-system-frame-hooks 'color-theme-zenburn)
(add-hook 'after-make-console-frame-hooks 'color-theme-zenburn)

--
My Emacs Files At GitHub

Using the googlecl

http://groups.google.com/group/googlecl-discuss/browse_thread/thread/5bee204f9fe677ca

-----------------

Depends on the task. The "add" task follows quick-add text
rules:
http://www.google.com/support/calendar/bin/answer.py?answer=36604#text
<http://www.google.com/support/calendar/bin/answer.py?answer=36604#text>Setting
reminders is done with the --reminder option.
Dates of events to retrieve from the server (for listing, deleting, etc.)
uses the --date option

In general, if you're having trouble with the usage, check the following
docs:
Manual: http://code.google.com/p/googlecl/wiki/Manual
<http://code.google.com/p/googlecl/wiki/Manual>FAQ / troubleshooting:
http://code.google.com/p/googlecl/wiki/FAQ
<http://code.google.com/p/googlecl/wiki/FAQ>Configuration file help:
http://code.google.com/p/googlecl/wiki/ConfigurationOptions

<http://code.google.com/p/googlecl/wiki/ConfigurationOptions>For example,
the manual has a section on Calendar, and at the end, a section on how to
use --date.

If anything is unclear or confusing, just let the mailing list know, and
we'll clear it up or fix the docs. 

----------------


--
My Emacs Files At GitHub

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

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))

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))