summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-10-12 23:39:29 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-10-12 23:39:29 +0200
commit1b0abee054235ea4ac7589dd92d3939e1386d24a (patch)
tree91d2aa7d5a810bb0032dfe1585ad8e0023c5f81e
downloadelibs-1b0abee054235ea4ac7589dd92d3939e1386d24a.tar.gz
elibs-1b0abee054235ea4ac7589dd92d3939e1386d24a.tar.bz2
Initial contents
-rw-r--r--README.org10
-rw-r--r--bmk/bmk-mgr-w3.el58
-rw-r--r--bmk/bmk-mgr-w3m.el84
-rw-r--r--bmk/bmk-mgr.el1478
-rw-r--r--bmk/dot-emacs.el42
-rw-r--r--bmk/folder-closed.xpm31
-rw-r--r--bmk/folder-open.xpm39
-rw-r--r--bmk/url-alt.xpm31
-rw-r--r--bmk/url.xpm39
-rw-r--r--emms/jao-emms-info-track.el123
-rw-r--r--emms/jao-emms-lyrics.el171
-rw-r--r--emms/jao-emms-random-album.el113
-rw-r--r--emms/jao-emms.el27
-rwxr-xr-xemms/leoslyrics.py84
-rwxr-xr-xemms/lyricwiki.rb51
-rw-r--r--net/jao-frm.el214
-rw-r--r--net/jao-w3m-session.el410
-rw-r--r--net/jao-weather.el219
-rw-r--r--org/jao-org-gnus.el72
-rw-r--r--org/jao-org-links.el29
-rw-r--r--org/jao-org-popup.el31
-rw-r--r--org/jao-org-tags.el61
-rw-r--r--org/jao-org-utils.el37
-rw-r--r--prog/jao-cabal.el22
-rw-r--r--prog/jao-dominating-file.el34
-rw-r--r--prog/jao-java-ant.el20
-rw-r--r--skels/all-skels.el49
-rw-r--r--skels/asdf-skel.el52
-rw-r--r--skels/caml-skel.el42
-rw-r--r--skels/common-skel.el151
-rw-r--r--skels/cpp-skel.el255
-rw-r--r--skels/cppunit-skel.el91
-rw-r--r--skels/dot.emacs.el11
-rw-r--r--skels/fsf-copyright12
-rw-r--r--skels/fuel-skel.el45
-rw-r--r--skels/geiser-skel.el50
-rw-r--r--skels/haskell-skel.el69
-rw-r--r--skels/init-skel.el39
-rw-r--r--skels/latex-skel.el52
-rw-r--r--skels/lisa-skel.el157
-rw-r--r--skels/lisp-skel.el50
-rw-r--r--skels/make-skel.el53
-rw-r--r--skels/muse-skel.el41
-rw-r--r--skels/noweb-skel.el48
-rw-r--r--skels/perl-skel.el78
-rw-r--r--skels/pika-skel.el88
-rw-r--r--skels/python-skel.el53
-rw-r--r--skels/readme-skel.el44
-rw-r--r--skels/s48-skel.el61
-rw-r--r--skels/scsh-skel.el45
-rw-r--r--skels/texinfo-skel.el131
-rw-r--r--sys/furl.applescript1
-rw-r--r--sys/jao-applescript.el65
-rw-r--r--sys/jao-devon.el42
-rw-r--r--sys/jao-osd.el55
-rwxr-xr-xthemes/autumn-ec40
-rwxr-xr-xthemes/dark-ec42
-rw-r--r--themes/jao-dark-theme.el63
-rw-r--r--themes/jao-light-theme.el74
-rw-r--r--themes/jao-themes.el682
-rwxr-xr-xthemes/light-ec40
61 files changed, 6401 insertions, 0 deletions
diff --git a/README.org b/README.org
new file mode 100644
index 0000000..49f7038
--- /dev/null
+++ b/README.org
@@ -0,0 +1,10 @@
+* Elisp libraries
+
+ - *themes* color themes based on Emacs builtin custom themes
+ - *org* utilities for org-mode
+ - *emms* utilities for EMMS
+ - *prog* utilities for programming modes
+ - *skels* skeletons for source files
+ - *net* utilities for networking (w3m &c.)
+ - *sys* generic utilities for external programs
+ - *bmk* a web bookmark manager
diff --git a/bmk/bmk-mgr-w3.el b/bmk/bmk-mgr-w3.el
new file mode 100644
index 0000000..c22700f
--- /dev/null
+++ b/bmk/bmk-mgr-w3.el
@@ -0,0 +1,58 @@
+;;; bmk-mgr-w3.el --- w3 specific code for bmk-mgr
+
+;; Copyright (C) 2007, 2008 Jose Antonio Ortega Ruiz.
+;;
+;; Author: Robert D. Crawford
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: hypermedia
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; Set up bmk-mgr for w3.
+
+;;; Code:
+
+;;;; Dependencies:
+
+(require 'bmk-mgr)
+(require 'w3)
+
+(defun bmk-mgr-w3-current-url ()
+ "Returns the current document url
+without the string properties."
+ (interactive)
+ (substring-no-properties (url-view-url)))
+
+(defun bmk-mgr-w3-document-title-fixed ()
+ "Removes the newline in long titles that
+seems to have cropped up in current versions of w3."
+ (replace-regexp-in-string "\n" " " (buffer-name)))
+
+(add-hook 'w3-mode-hook
+ (lambda ()
+ (setq bmk-mgr-document-title
+ 'bmk-mgr-w3-document-title-fixed)
+ (setq bmk-mgr-url-at-point 'w3-view-this-url)
+ (setq bmk-mgr-current-url 'bmk-mgr-w3-current-url)))
+;; (setq bmk-mgr-document-title 'buffer-name)
+(provide 'bmk-mgr-w3)
+
+;; Local variables **
+;; indent-tabs-mode: nil **
+;; end **
+;;; bmk-mgr-w3.el ends here
diff --git a/bmk/bmk-mgr-w3m.el b/bmk/bmk-mgr-w3m.el
new file mode 100644
index 0000000..cc53d41
--- /dev/null
+++ b/bmk/bmk-mgr-w3m.el
@@ -0,0 +1,84 @@
+;;; bmk-mgr-w3m.el --- w3m specific code for bmk-mgr
+
+;; Copyright (C) 2007 Jose Antonio Ortega Ruiz.
+;;
+;; Author: Robert D. Crawford
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: hypermedia
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; Set up bmk-mgr for w3m.
+
+;;; Code:
+
+;;;; Dependencies:
+
+(require 'bmk-mgr)
+(require 'w3m)
+
+(defsubst bmk-mgr-w3m-url-at-point ()
+ "Return the url at point in w3m."
+ (or (w3m-anchor (point)) (w3m-image (point))))
+
+(defsubst bmk-mgr-w3m-current-url ()
+ "Returns the value of w3m-current-url."
+ w3m-current-url)
+
+(add-hook 'w3m-fontify-after-hook
+ (lambda ()
+ (setq bmk-mgr-document-title 'w3m-current-title)
+ (setq bmk-mgr-url-at-point 'bmk-mgr-w3m-url-at-point)
+ (setq bmk-mgr-current-url 'bmk-mgr-w3m-current-url)))
+
+(bmk-mgr-import-add-formatter "w3m" 'bmk-mgr-w3m-import)
+
+(defun bmk-mgr-w3m-import (file name)
+ (if (not (file-readable-p file)) (error "Cannot read file"))
+ (with-temp-buffer
+ (let ((result (bmk-mgr-node-folder-new (or name "w3m")))
+ (coding-system-for-read
+ (if (boundp 'w3m-bookmark-file-coding-system)
+ w3m-bookmark-file-coding-system
+ coding-system-for-read))
+ (sec-delim (if (boundp 'w3m-bookmark-section-delimiter)
+ w3m-bookmark-section-delimiter
+ "<!--End of section (do not delete this comment)-->\n")))
+ (insert-file-contents file)
+ (goto-char 1)
+ (while (re-search-forward "<h2>\\([^<]+\\)</h2>\n<ul>\n" nil t)
+ (let* ((folder
+ (bmk-mgr-node-folder-new (match-string 1) t))
+ (limit
+ (save-excursion
+ (and (search-forward sec-delim nil t) (point)))))
+ (while (search-forward "<li><a href=\"" limit t)
+ (if (re-search-forward "\\([^\"]+\\)\">\\([^<]+\\)</a>\n" nil t)
+ (bmk-mgr-node-add-child
+ folder
+ (bmk-mgr-node-url-new (match-string 2) (match-string 1)))))
+ (bmk-mgr-node-add-child result folder)))
+ result)))
+
+(provide 'bmk-mgr-w3m)
+
+;; Local variables **
+;; indent-tabs-mode: nil **
+;; end **
+
+;;; bmk-mgr-w3m.el ends here
diff --git a/bmk/bmk-mgr.el b/bmk/bmk-mgr.el
new file mode 100644
index 0000000..336447b
--- /dev/null
+++ b/bmk/bmk-mgr.el
@@ -0,0 +1,1478 @@
+;;; bmk-mgr.el --- Bookmark manager:
+
+;; Copyright (C) 2003, 2004, 2006, 2007 Jose Antonio Ortega Ruiz.
+;;
+
+(defconst bmk-mgr-version "0.1.2")
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: hypermedia
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;;; INTRODUCTION:
+;;;; Emacs Bookmark Manager.
+;;;;
+;;;; INSTALLATION:
+;;;;
+;;;; CUSTOMIZATION:
+;;;;
+;;;; HISTORY:
+;;;; - 0.1.1 (May 2006). XBEL importing corrected.
+;;;;
+;;;; TODO:
+;;;; - Export: xbel, HTML, bmk
+;;;; - Add menu: display bookmarks as a menu
+;;;;
+;;;; THANKS:
+;;;; - David Magill, for lots of help in debugging.
+;;;;
+
+;;; Code:
+
+;;;; Dependencies:
+
+(require 'cl)
+(require 'outline)
+(require 'browse-url)
+
+;;;; Compatibility:
+(if (< emacs-major-version 22)
+ (progn
+ (defun substring-no-properties (x) x)
+ (defsubst bmk-string-to-int (x) (string-to-int x)))
+ (progn
+ (defsubst bmk-string-to-int (x) (string-to-number x))))
+
+;;;; Customization:
+
+;;;;; Customization buffer:
+(defgroup bmk-mgr nil
+ "Bookmark manager"
+ :group 'hypermedia
+ :prefix "bmk-mgr-")
+
+(defcustom bmk-mgr-bookmark-file "~/.emacs.bookmarks"
+ "The file where bookmarks are stored."
+ :group 'bmk-mgr
+ :type 'file)
+
+(defcustom bmk-mgr-autosave t
+ "If on, save bookmarks whenever they are modified."
+ :group 'bmk-mgr
+ :type 'boolean)
+
+(defcustom bmk-mgr-indent-width 2
+ "The amount of indentation for evey new subfolder level."
+ :group 'bmk-mgr
+ :type 'number)
+
+(defcustom bmk-mgr-link-mark ""
+ "The string used to prefix link names."
+ :group 'bmk-mgr
+ :type 'string)
+
+(defcustom bmk-mgr-open-mark "- "
+ "The string used to prefix open folder names."
+ :group 'bmk-mgr
+ :type 'string)
+
+(defcustom bmk-mgr-closed-mark "+ "
+ "The string used to prefix closed folder names."
+ :group 'bmk-mgr
+ :type 'string)
+
+(defconst bmk-mgr-available-browsers
+ '(choice
+ (function-item :tag "Default" :value nil)
+ (function-item :tag "Emacs W3" :value browse-url-w3)
+ (function-item :tag "W3 in another Emacs via `gnudoit'"
+ :value browse-url-w3-gnudoit)
+ (function-item :tag "Mozilla" :value browse-url-mozilla)
+ (function-item :tag "Galeon" :value browse-url-galeon)
+ (function-item :tag "Netscape" :value browse-url-netscape)
+ (function-item :tag "Mosaic" :value browse-url-mosaic)
+ (function-item :tag "Mosaic using CCI" :value browse-url-cci)
+ (function-item :tag "IXI Mosaic" :value browse-url-iximosaic)
+ (function-item :tag "Lynx in an xterm window"
+ :value browse-url-lynx-xterm)
+ (function-item :tag "Lynx in an Emacs window"
+ :value browse-url-lynx-emacs)
+ (function-item :tag "Grail" :value browse-url-grail)
+ (function-item :tag "MMM" :value browse-url-mmm)
+ (function-item :tag "KDE" :value browse-url-kde)
+ (function-item :tag "Specified by `Browse Url Generic Program'"
+ :value browse-url-generic)
+ (function-item :tag "Default Windows browser"
+ :value browse-url-default-windows-browser)
+ (function-item :tag "GNOME invoking Mozilla"
+ :value browse-url-gnome-moz)
+ (function-item :tag "Default browser"
+ :value browse-url-default-browser)
+ (function :tag "Your own function")
+ (alist :tag "Regexp/function association list"
+ :key-type regexp :value-type function)))
+
+(defcustom bmk-mgr-browser-function nil
+ "*Function to display the current bookmark in a WWW browser.
+
+This has the same semantics as `browse-url''s `browse-url-browser-function'.
+If you set this variable to nil, the latter will be used. Otherwise,
+if the value is not a function it should be a list of pairs
+\(REGEXP . FUNCTION). In this case the function called will be the one
+associated with the first REGEXP which matches the current URL. The
+function is passed the URL and any other args of `browse-url'. The last
+regexp should probably be \".\" to specify a default browser."
+ :type bmk-mgr-available-browsers
+ :group 'bmk-mgr)
+
+(defcustom bmk-mgr-alt-browser-function nil
+ "Alternative function to display the current bookmark in a WWW browser.
+
+This has the same semantics as `bmk-mgr-browser-function'. You can use
+it to have a second browsing function available (activated by pressing
+`shift-return' instead of just `return'). A typical application is to
+have one to display the bookmark in the current tab, and another to
+display the bookmark in a new tab."
+ :type bmk-mgr-available-browsers
+ :group 'bmk-mgr)
+
+
+(defcustom bmk-mgr-inhibit-welcome-message nil
+ "When on, do not display a welcome message in the minibuffer upon
+entering the bookmark manager."
+ :group 'bmk-mgr
+ :type 'boolean)
+
+(defcustom bmk-mgr-inhibit-minibuffer nil
+ "When on, do not automatically display info about the current folder
+or bookmark in the minibuffer."
+ :group 'bmk-mgr
+ :type 'boolean)
+
+(defcustom bmk-mgr-ignore-fold-state nil
+ "Turn this variable on to display the initial tree with all
+subfolders closed, instead of using their last state."
+ :group 'bmk-mgr
+ :type 'boolean)
+
+(defcustom bmk-mgr-use-images nil
+ "If on, images are used by default."
+ :type 'boolean
+ :group 'bmk-mgr)
+
+(defcustom bmk-mgr-folder-open-image "folder-open.xpm"
+ "Image to use for representing open folders."
+ :type 'file
+ :group 'bmk-mgr)
+
+(defcustom bmk-mgr-folder-closed-image "folder-closed.xpm"
+ "Image to use for representing closed folders."
+ :type 'file
+ :group 'bmk-mgr)
+
+(defcustom bmk-mgr-bookmark-image "url.xpm"
+ "Image to use for representing bookmarks."
+ :type 'file
+ :group 'bmk-mgr)
+
+(defcustom bmk-mgr-use-own-frame nil
+ "Whether the bookmars buffer should be displayed on its own frame."
+ :type 'boolean
+ :group 'bmk-mgr)
+
+(defcustom bmk-mgr-frame-parameters '((width . 60))
+ "Parameters of the bookmars buffer frame, when
+`bmk-mgr-use-own-frame' has been set to non-nil"
+ :type '(repeat (sexp :tag "Parameter:"))
+ :group 'bmk-mgr)
+
+(defface bmk-mgr-folder-face '((t (:bold t :foreground nil :weight bold)))
+ "Face for folder names."
+ :group 'bmk-mgr)
+
+(defface bmk-mgr-sel-folder-face
+ '((t (:bold t :foreground "IndianRed" :weight bold)))
+ "Face for selected folder names."
+ :group 'bmk-mgr)
+
+(defface bmk-mgr-bookmark-face '((t ()))
+ "Face for bookmark names."
+ :group 'bmk-mgr)
+
+(defface bmk-mgr-sel-bookmark-face '((t (:foreground "IndianRed")))
+ "Face for selected bookmark names."
+ :group 'bmk-mgr)
+
+;;;;; Other variables:
+
+(defvar bmk-mgr-bookmark-buffer-name "*Bookmarks*"
+ "*Name of the bookmarks buffer.")
+
+(defvar bmk-mgr-kill-ring-size 50
+ "*Maximum number of killed bookmarks to be remembered.")
+
+(defvar bmk-mgr-line-spacing 2
+ "*Additional space to put between lines when displaying the
+bookmarks buffer.
+
+The space is measured in pixels, and put below lines on window
+systems.")
+
+(defvar bmk-mgr-document-title nil
+ "Function variable returning the current document title.")
+
+(defvar bmk-mgr-url-at-point nil
+ "Function variable returning the value of the url under point.")
+
+(defvar bmk-mgr-current-url nil
+ "Function variable returning the value of the current document url.")
+
+(make-variable-buffer-local 'bmk-mgr-document-title)
+(make-variable-buffer-local 'bmk-mgr-url-at-point)
+(make-variable-buffer-local 'bmk-mgr-current-url)
+
+;;;; User interactive functions:
+
+(defun bmk-mgr-create-bookmark-buffer ()
+ (let ((tree (bmk-mgr-read-from-file bmk-mgr-bookmark-file)))
+ (when tree
+ (when bmk-mgr-use-own-frame
+ (select-frame (make-frame bmk-mgr-frame-parameters)))
+ (switch-to-buffer
+ (get-buffer-create bmk-mgr-bookmark-buffer-name))
+ (bmk-mgr-mode tree)
+ (current-buffer))))
+
+(defsubst bmk-mgr-get-bookmark-buffer ()
+ (or (get-buffer bmk-mgr-bookmark-buffer-name)
+ (bmk-mgr-create-bookmark-buffer)))
+
+(defun bmk-mgr-show-bookmarks ()
+ "Display the bookmarks buffer."
+ (interactive)
+ (let ((display-buffer-reuse-frames bmk-mgr-use-own-frame)
+ (pop-up-frames bmk-mgr-use-own-frame))
+ (switch-to-buffer (bmk-mgr-get-bookmark-buffer))))
+
+(defun bmk-mgr-show-bookmarks-other-window ()
+ "Display the bookmarks buffer in other window"
+ (interactive)
+ (let ((display-buffer-reuse-frames nil)
+ (pop-up-frames nil))
+ (split-window-horizontally (/ (* 2 (window-width)) 3))
+ (other-window 1)
+ (switch-to-buffer (bmk-mgr-get-bookmark-buffer))))
+
+(defun bmk-mgr-add-url-at-point ()
+ "Add URL at point to the bookmarks collection.
+If there is no URL at point, this command asks for it."
+ (interactive)
+ (if bmk-mgr-url-at-point
+ (bmk-mgr-add-bookmark-at-folder (funcall bmk-mgr-url-at-point))
+ (progn
+ (require 'ffap)
+ (bmk-mgr-add-bookmark-at-folder (ffap-url-at-point)))))
+
+;; the following 2 functions need to be combined and generalized
+(defun bmk-mgr-add-current-page ()
+ "Adds the current page to the bookmark list."
+ (interactive)
+ (unless bmk-mgr-current-url
+ (error "Current buffer has no associated URL."))
+ ;; please leave these here, as I will need them later -- rdc
+ ;; (message "bmk-mgr-current-url value as function is %s"
+ ;; bmk-mgr-current-url)
+ ;; (message "bmk-mgr-current-url value as variable is %s"
+ ;; (funcall bmk-mgr-current-url))
+ ;; (message "bmk-mgr-document-title value as function is %s"
+ ;; bmk-mgr-document-title)
+ ;; (message "bmk-mgr-document-title value as variable is %s"
+ ;; (funcall bmk-mgr-document-title))
+ (bmk-mgr-add-bookmark-at-folder
+ (funcall bmk-mgr-current-url)
+ (funcall bmk-mgr-document-title)))
+
+;;;; Bookmark mode:
+
+;;;;; Variables:
+
+(defvar bmk-mgr-kill-ring nil "Killed nodes list")
+
+(defmacro bmk-mgr-folder-or-url (ffun ufun)
+ `(lambda ()
+ (interactive)
+ (if (bmk-mgr-node-folder-p (bmk-mgr-get-node-at-point))
+ (funcall ',ffun)
+ (funcall ',ufun))))
+
+(defvar bmk-mgr-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (define-key map [(control ?a)] 'beginning-of-line)
+ (define-key map [(control ?e)] 'end-of-line)
+ (define-key map [(control ?k)] 'bmk-mgr-kill-bookmark)
+ (define-key map [(control ?n)] 'bmk-mgr-next-line)
+ (define-key map [(control ?p)] 'bmk-mgr-previous-line)
+ (define-key map [(control ?y)] 'bmk-mgr-yank-bookmark)
+ (define-key map [??] 'describe-mode)
+ (define-key map [?A] 'bmk-mgr-add-folder)
+ (define-key map [?I] 'bmk-mgr-toggle-images)
+ (define-key map [?N] 'bmk-mgr-next-folder)
+ (define-key map [?P] 'bmk-mgr-previous-folder)
+ (define-key map [?Q] 'bmk-mgr-quit)
+ (define-key map [?V] 'bmk-mgr-version)
+ (define-key map [?a] 'bmk-mgr-add-bookmark)
+ (define-key map [?c] 'bmk-mgr-close-children)
+ (define-key map [?d] 'bmk-mgr-move-bookmark-down)
+ (define-key map [?e] 'bmk-mgr-edit-bookmark)
+ (define-key map [?f] 'bmk-mgr-find-folder)
+ (define-key map [?h] 'describe-mode)
+ (define-key map [?i] 'bmk-mgr-import)
+ (define-key map [?n] 'bmk-mgr-next-line)
+ (define-key map [?p] 'bmk-mgr-previous-line)
+ (define-key map [?q] 'bmk-mgr-quit-ask)
+ (define-key map [?s] 'bmk-mgr-save-bookmarks)
+ (define-key map [?u] 'bmk-mgr-move-bookmark-up)
+ (define-key map [?v] 'bmk-mgr-bookmark-info)
+ (define-key map [?y] 'bmk-mgr-copy-url)
+ (define-key map (kbd "<up>") 'bmk-mgr-previous-line)
+ (define-key map (kbd "<down>") 'bmk-mgr-next-line)
+ (define-key map (kbd "<left>") 'beginning-of-line)
+ (define-key map (kbd "<right>") 'end-of-line)
+ (define-key map (kbd "<mouse-1>") 'bmk-mgr-mouse-click)
+ (define-key map (kbd "<mouse-2>") 'bmk-mgr-mouse-click-alt)
+ (define-key map (kbd "<S-return>") 'bmk-mgr-browse-url-alt)
+ (define-key map (kbd "M-RET") 'bmk-mgr-browse-url-alt)
+ (define-key map (kbd "RET") 'bmk-mgr-browse-url)
+ (define-key map (kbd "TAB") 'bmk-mgr-toggle-folder)
+ map)
+ "Keymap for `bmk-mgr-mode'.")
+
+(defvar bmk-mgr-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ st)
+ "Syntax table for `bmk-mgr-mode'.")
+
+;; regexps used by bmk-mgr-mode and other functions
+(defvar bmk-mgr-outline-regexp nil)
+
+;; images
+(defvar bmk-mgr-url-img)
+(defvar bmk-mgr-fopen-img)
+(defvar bmk-mgr-fclosed-img)
+
+;;;;; Mode definition:
+
+;;;###autoload
+(defun bmk-mgr-mode (&optional tree)
+ "\\<bmk-mgr-mode-map>
+ Major mode for displaying bookmark files.
+
+Commands:
+
+<DIGIT>+<key>\tRepeat command denoted by <key> the number of times
+ \tpreviously typed. Commands accepting a prefix count are
+ \tmarked with (*) below.
+
+\\[bmk-mgr-next-line]\tGo to next visible line (*).
+\\[bmk-mgr-previous-line]\tGo to previous visible line (*).
+\\[bmk-mgr-next-folder]\tGo to next visible folder (*).
+\\[bmk-mgr-previous-folder]\tGo to previous visible folder (*).
+\\[beginning-of-line]\tGo to the beginning of text in current line.
+\\[end-of-line]\tGo to the end of text in current line.
+\\[bmk-mgr-toggle-folder]\tOpens or closes current folder.
+\\[bmk-mgr-close-children]\tCloses all subfolders of current folder.
+\\[bmk-mgr-bookmark-info]\tDisplay info about current bookmark or folder.
+\\[bmk-mgr-copy-url]\tPut the current URL (if any) in the kill ring.
+\\[bmk-mgr-find-folder]\tFind bookmarks folder.
+
+\\[bmk-mgr-mouse-click]\tDisplay or toggle the clicked URL or folder.
+\\[bmk-mgr-mouse-click-alt]\tDisplay or toggle the clicked URL or folder,
+ \tusing the alternate browser.
+\\[bmk-mgr-browse-url]\tDisplay current URL in browser.
+\\[bmk-mgr-browse-url-alt]\tDisplay current URL in alternate browser.
+
+\\[bmk-mgr-move-bookmark-up]\tMoves current bookmark one line up (*).
+\\[bmk-mgr-move-bookmark-down]\tMoves current bookmark one line down (*).
+\\[bmk-mgr-edit-bookmark]\tEdit bookmark or folder in current line.
+\\[bmk-mgr-add-bookmark]\tAdd a new bookmark (asks for its name and URL).
+\\[bmk-mgr-add-folder]\tAdd a new bookmark folder (asks for its path).
+\\[bmk-mgr-kill-bookmark]\tKills current bookmark or folder, putting it in the kill ring (*).
+\\[bmk-mgr-yank-bookmark]\tYanks a previously killed bookmark or folder (*).
+
+\\[bmk-mgr-import]\tImports an external bookmarks file (xbel, w3m, bmk).
+
+\\[bmk-mgr-toggle-images]\tToggle display of images.
+
+\\[bmk-mgr-save-bookmarks]\tSave current bookmarks.
+\\[bmk-mgr-quit]\tQuit Bookmark Manager.
+\\[bmk-mgr-quit-ask]\tQuit Bookmark Manager asking for confirmation.
+
+\\[bmk-mgr-version]\tShow version.
+\\[describe-mode]\tShows this help page.
+"
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (setq major-mode 'bmk-mgr-mode)
+ (setq mode-name "bmk")
+ (use-local-map bmk-mgr-mode-map)
+
+ (let ((prefix (make-string bmk-mgr-indent-width 32)))
+ (setq bmk-mgr-outline-regexp (concat "\\(" prefix "\\)*.")))
+ (set (make-local-variable 'outline-regexp) bmk-mgr-outline-regexp)
+ (set (make-local-variable 'truncate-lines) t)
+ (set (make-local-variable 'automatic-hscrolling) t)
+ (set (make-local-variable 'line-spacing) bmk-mgr-line-spacing)
+ (set (make-local-variable 'kill-whole-line) t)
+ (set (make-local-variable 'next-line-add-newlines) t)
+ (goto-char 1)
+ (bmk-mgr-refresh tree)
+ (toggle-read-only 1)
+ (unless bmk-mgr-inhibit-welcome-message
+ (message
+ "Emacs Bookmark Manager, version %s. Type `h' for help." bmk-mgr-version)))
+
+;;;;; Functions:
+
+;;;;;; Helper macros:
+(defmacro bmk-mgr-with-bookmarks-buffer (&rest body)
+ `(with-current-buffer (bmk-mgr-get-bookmark-buffer)
+ (unwind-protect
+ (prog1
+ (let ((inhibit-read-only t))
+ (bmk-mgr-unmark-current)
+ ,@body)
+ (if (not bmk-mgr-inhibit-minibuffer) (bmk-mgr-bookmark-info)))
+ (bmk-mgr-mark-current))))
+
+(defmacro bmk-mgr-with-current-node (&rest body)
+ `(bmk-mgr-with-bookmarks-buffer
+ (beginning-of-line)
+ (let ((bmk-node (bmk-mgr-get-node-at-point))
+ (bmk-path (bmk-mgr-get-path-at-point)))
+ ,@body)))
+
+(defmacro bmk-mgr-with-current-node-save (&rest body)
+ `(bmk-mgr-with-current-node
+ (prog1
+ (progn ,@body)
+ (if bmk-mgr-autosave
+ (progn
+ (bmk-mgr-save-current-tree)
+ (set-buffer-modified-p nil))))))
+
+(defmacro bmk-mgr-repeat (&rest body)
+ `(let ((count bmk-mgr-repeat-count))
+ (while (> count 0)
+ (decf count)
+ ,@body)))
+
+;;;;;; Helper functions:
+(defun bmk-mgr-outline-level ()
+ (save-excursion
+ (beginning-of-line)
+ (if (looking-at bmk-mgr-outline-regexp)
+ (length (match-string 0))
+ 0)))
+
+(defun bmk-mgr-mark-current ()
+ (let* ((inhibit-read-only 1)
+ (node (bmk-mgr-get-node-at-point))
+ (face (if (bmk-mgr-node-folder-p node) 'bmk-mgr-sel-folder-face
+ 'bmk-mgr-sel-bookmark-face)))
+ (beginning-of-line)
+ (save-excursion
+ (add-text-properties (progn (bmk-mgr-beginning) (point))
+ (progn (end-of-line) (point))
+ `(face ,face)))))
+
+(defun bmk-mgr-unmark-current ()
+ (let* ((inhibit-read-only 1)
+ (node (bmk-mgr-get-node-at-point))
+ (face (if (bmk-mgr-node-folder-p node) 'bmk-mgr-folder-face
+ 'bmk-mgr-bookmark-face)))
+ (add-text-properties (progn (bmk-mgr-beginning) (point))
+ (save-excursion (end-of-line) (point))
+ `(face ,face))))
+
+(defun bmk-mgr-unmark-all ()
+ (save-excursion
+ (goto-char 1)
+ (while (not (eobp))
+ (bmk-mgr-unmark-current)
+ (next-line 1))))
+
+(defun bmk-mgr-push-to-kill-ring (node)
+ (push (copy-list node) bmk-mgr-kill-ring)
+ (when (> (length bmk-mgr-kill-ring) bmk-mgr-kill-ring-size)
+ (setcdr (nthcdr (1- bmk-mgr-kill-ring-size) bmk-mgr-kill-ring) nil)))
+
+(defsubst bmk-mgr-pop-kill-ring () (pop bmk-mgr-kill-ring))
+
+(defsubst bmk-mgr-url-at-point ()
+ "Get the URL of the current bookmark, if any."
+ (bmk-mgr-node-url (bmk-mgr-get-node-at-point)))
+
+(defun bmk-mgr-save-current-tree ()
+ (bmk-mgr-save-to-file (bmk-mgr-get-root-node-in-buffer)
+ bmk-mgr-bookmark-file))
+
+(defun bmk-mgr-ask-path (prompt &optional path)
+ (let ((PC-word-delimiters ".")
+ (bmk-mgr-inhibit-minibuffer t)
+ (path (or path (list (bmk-mgr-node-name
+ (bmk-mgr-get-root-node-in-buffer))))))
+ (bmk-mgr-string-to-path
+ (completing-read prompt 'bmk-mgr-complete-path nil nil
+ (concat (bmk-mgr-path-to-string path) "/")))))
+
+(defun bmk-mgr-complete-path (pstr fun flag)
+ (bmk-mgr-with-bookmarks-buffer
+ (let* ((root (bmk-mgr-get-root-node-in-buffer))
+ (partial (not (string-match "/$" pstr)))
+ (pc (split-string pstr "/"))
+ (path (or pc (list (bmk-mgr-node-name root))))
+ (ppath (if partial (bmk-mgr-path-parent path) path))
+ (partstr (concat "^" (regexp-quote (bmk-mgr-path-leaf path))))
+ (str (concat (bmk-mgr-path-to-string ppath) "/"))
+ (children (bmk-mgr-node-child-folders root ppath))
+ (comp (mapcar (lambda (x) (concat str (bmk-mgr-node-name x) "/"))
+ (if partial
+ (remove-if-not
+ (lambda (x)
+ (string-match partstr (bmk-mgr-node-name x)))
+ children)
+ children)))
+ (len (length comp)))
+ (case flag
+ ((nil) (cond
+ ((and (not partial) (zerop len)) t)
+ ((= len 1) (car comp))
+ ((zerop len) nil)
+ (t pstr)))
+ ((lambda) (not partial))
+ (t comp)))))
+
+;;;;;; Mode functions:
+
+(defun bmk-mgr-version ()
+ "Display version."
+ (interactive)
+ (message "Emacs Bookmark Manager, version %s" bmk-mgr-version))
+
+(defun bmk-mgr-toggle-images ()
+ "Toggle image display."
+ (interactive)
+ (setq bmk-mgr-use-images (not bmk-mgr-use-images))
+ (bmk-mgr-refresh))
+
+(defun bmk-mgr-refresh (&optional tree)
+ "Refresh the bookmarks buffer."
+ (interactive)
+ (message "Redisplaying bookmarks...")
+ (bmk-mgr-with-bookmarks-buffer
+ (if window-system
+ (progn
+ (clear-image-cache
+ (window-frame (get-buffer-window (current-buffer))))
+ (setq bmk-mgr-url-img
+ (find-image
+ `((:file ,bmk-mgr-bookmark-image :type xpm :ascent center))))
+ (setq bmk-mgr-fopen-img
+ (find-image
+ `((:file ,bmk-mgr-folder-open-image :type xpm :ascent 95))))
+ (setq bmk-mgr-fclosed-img
+ (find-image
+ `((:file ,bmk-mgr-folder-closed-image :type xpm :ascent 95)))))
+ (setq bmk-mgr-url-img nil bmk-mgr-fopen-img nil bmk-mgr-fclosed-img nil
+ bmk-mgr-use-images nil))
+ (let ((tree (or tree (bmk-mgr-get-root-node-in-buffer))))
+ (save-excursion
+ (erase-buffer)
+ (if bmk-mgr-ignore-fold-state (bmk-mgr-node-close-all-children tree))
+ (bmk-mgr-print-tree tree)
+ (goto-char 1)
+ (bmk-mgr-unmark-all)
+ (bmk-mgr-refresh-open-close)))
+ (message "Redisplaying bookmarks... done.")))
+
+(defsubst bmk-mgr-beginning ()
+ "Go to beginning of current bookmark."
+ (interactive)
+ (beginning-of-line)
+ (re-search-forward "^ *"))
+
+(defun bmk-mgr-next-line (arg)
+ "Go to next visible bookmark line."
+ (interactive "P")
+ (bmk-mgr-with-bookmarks-buffer
+ (outline-next-visible-heading (if arg (prefix-numeric-value arg) 1))
+ (if (eobp) (outline-previous-visible-heading 1))))
+
+(defun bmk-mgr-previous-line (arg)
+ "Go to previous visible bookmark line."
+ (interactive "P")
+ (bmk-mgr-with-bookmarks-buffer
+ (outline-previous-visible-heading (if arg (prefix-numeric-value arg) 1))))
+
+(defun bmk-mgr-bookmark-info ()
+ "Show info about current bookmark or folder."
+ (interactive)
+ (let ((node (bmk-mgr-get-node-at-point)))
+ (if node
+ (if (bmk-mgr-node-url-p node)
+ (let ((url (bmk-mgr-node-url node)))
+ (and url (message "%s" url)))
+ (let ((children (bmk-mgr-node-child-folders node)))
+ (if children
+ (message
+ "%s"
+ (concat "Subfolders: "
+ (mapconcat 'bmk-mgr-node-name children ", ")))))))))
+
+(defun bmk-mgr-copy-url ()
+ "Put current URL in the kill ring."
+ (interactive)
+ (bmk-mgr-with-current-node
+ (let ((url (bmk-mgr-node-url bmk-node)))
+ (when url
+ (kill-new url)
+ (message "%s copied" url)))))
+
+(defun bmk-mgr-next-folder (arg)
+ "Go to next visible bookmark folder."
+ (interactive "P")
+ (bmk-mgr-with-bookmarks-buffer
+ (let ((count (if arg (prefix-numeric-value arg) 1))
+ (test (lambda () (bmk-mgr-node-url-p (bmk-mgr-get-node-at-point)))))
+ (while (> count 0)
+ (decf count)
+ (if (not (funcall test)) (outline-next-visible-heading 1))
+ (while (funcall test)
+ (outline-next-visible-heading 1))))
+ (if (eobp) (outline-previous-visible-heading 1))
+ (bmk-mgr-beginning)))
+
+(defun bmk-mgr-previous-folder (arg)
+ "Go to previous visible bookmark folder."
+ (interactive "P")
+ (bmk-mgr-with-bookmarks-buffer
+ (let ((count (if arg (prefix-numeric-value arg) 1))
+ (test (lambda () (bmk-mgr-node-url-p (bmk-mgr-get-node-at-point)))))
+ (while (> count 0)
+ (decf count)
+ (if (not (funcall test)) (outline-previous-visible-heading 1))
+ (while (funcall test)
+ (outline-previous-visible-heading 1))))
+ (bmk-mgr-beginning)))
+
+(defun bmk-mgr-browse-url ()
+ "Display current bookmark in browser."
+ (interactive)
+ (let ((browse-url-browser-function
+ (or bmk-mgr-browser-function browse-url-browser-function))
+ (url (bmk-mgr-node-url (bmk-mgr-get-node-at-point))))
+ (if url (browse-url url) (bmk-mgr-toggle-folder))))
+
+(defun bmk-mgr-browse-url-alt ()
+ "Display current bookmark in alternate browser."
+ (interactive)
+ (bmk-mgr-with-current-node
+ (let ((browse-url-browser-function
+ (or bmk-mgr-alt-browser-function browse-url-browser-function))
+ (url (bmk-mgr-node-url (bmk-mgr-get-node-at-point))))
+ (if url (browse-url url) (bmk-mgr-toggle-folder)))))
+
+(defun bmk-mgr-mouse-click (event)
+ "Visit the clicked bookmark or toogle the folder state."
+ (interactive "e")
+ (set-buffer (bmk-mgr-get-bookmark-buffer))
+ (goto-char (posn-point (event-start event)))
+ (let ((node (bmk-mgr-get-node-at-point)))
+ (if (bmk-mgr-node-url-p node)
+ (bmk-mgr-browse-url)
+ (if (bmk-mgr-node-folder-p node)
+ (bmk-mgr-toggle-folder)))))
+
+(defun bmk-mgr-mouse-click-alt (event)
+ "Visit the clicked bookmark or toogle the folder state."
+ (interactive "e")
+ (set-buffer (bmk-mgr-get-bookmark-buffer))
+ (goto-char (posn-point (event-start event)))
+ (let ((node (bmk-mgr-get-node-at-point)))
+ (if (bmk-mgr-node-url-p node)
+ (bmk-mgr-browse-url-alt)
+ (if (bmk-mgr-node-folder-p node)
+ (bmk-mgr-toggle-folder)))))
+
+(defun bmk-mgr-toggle-folder ()
+ "Toggle the open/closed status of folder at point, if any."
+ (interactive)
+ (bmk-mgr-with-current-node
+ (when (bmk-mgr-node-folder-p bmk-node)
+ (bmk-mgr-node-toggle-open-closed bmk-node)
+ (bmk-mgr-redraw-node-at-point))))
+
+(defun bmk-mgr-close-children ()
+ "Close all subfolders of folder at point, if any."
+ (interactive)
+ (bmk-mgr-with-current-node
+ (when (bmk-mgr-node-folder-p bmk-node)
+ (bmk-mgr-node-close-all-children bmk-node)
+ (bmk-mgr-update-tree-at-point)
+ (bmk-mgr-refresh-open-close))))
+
+(defun bmk-mgr-find-folder ()
+ "Find a bookmarks folder."
+ (interactive)
+ (bmk-mgr-with-bookmarks-buffer
+ (bmk-mgr-find-path-in-buffer (bmk-mgr-ask-path "Find folder: ") t)))
+
+(defun bmk-mgr-save-bookmarks ()
+ "Save current bookmars."
+ (interactive)
+ (when (y-or-n-p "Save current bookmarks? ")
+ (with-current-buffer (bmk-mgr-get-bookmark-buffer)
+ (bmk-mgr-save-current-tree)
+ (set-buffer-modified-p nil))))
+
+(defun bmk-mgr-edit-bookmark ()
+ "Edit the current bookmark."
+ (interactive)
+ (bmk-mgr-with-current-node-save
+ (when bmk-node
+ (let ((newtitle (read-string "Name: " (bmk-mgr-node-title bmk-node))))
+ (if (> (length newtitle) 0) (bmk-mgr-node-set-name bmk-node newtitle))
+ (if (bmk-mgr-node-url-p bmk-node)
+ (let ((newurl (read-string "URL: " (bmk-mgr-node-url bmk-node))))
+ (if (> (length newurl) 0) (bmk-mgr-node-set-url bmk-node newurl))))
+ (bmk-mgr-redraw-node-at-point
+ (append (bmk-mgr-path-parent bmk-path) (list newtitle)))
+ (if (bmk-mgr-node-folder-p bmk-node) ; update children paths
+ (save-excursion
+ (let ((cl (bmk-mgr-outline-level))
+ (pos (length (bmk-mgr-path-parent bmk-path))))
+ (forward-line 1)
+ (while (> (bmk-mgr-outline-level) cl)
+ (setf (nth pos (bmk-mgr-get-path-at-point)) newtitle)
+ (forward-line 1)))))
+ (beginning-of-line)))))
+
+(defun bmk-mgr-add-bookmark-at-folder (&optional url title)
+ (let ((path
+ (bmk-mgr-with-current-node
+ (bmk-mgr-ask-path "Add bookmark to folder: "
+ (if (bmk-mgr-node-folder-p bmk-node) bmk-path
+ (bmk-mgr-path-parent bmk-path))))))
+ (bmk-mgr-add-bookmark path nil url title t)))
+
+
+(defun bmk-mgr-add-bookmark (&optional path node url title after)
+ "Insert bookmark at a given path or current point."
+ (interactive)
+ (bmk-mgr-with-current-node-save
+ (let* ((title (or title
+ (and node (bmk-mgr-node-name node))
+ (read-string "Name of new bookmark: ")))
+ (url (or (and node "") url (read-string "URL: ")))
+ (node (or node (bmk-mgr-node-url-new title url))))
+ (if (and path (not (bmk-mgr-find-path-in-buffer path t)))
+ (error "Folder %s does not exist"
+ (bmk-mgr-path-to-string path)))
+ (message "adding with path %S (%S)" path after)
+ (if (not (or path bmk-path)) (outline-previous-visible-heading 1))
+ (if (and (bmk-mgr-node-folder-p (bmk-mgr-get-node-at-point))
+ (bmk-mgr-node-open-p (bmk-mgr-get-node-at-point)))
+ (bmk-mgr-insert-child-at-point node (not after))
+ (bmk-mgr-insert-sibling-at-point node nil))
+ (while (not (or (eobp) (eq node (bmk-mgr-get-node-at-point))))
+ (outline-next-visible-heading 1)))))
+
+(defun bmk-mgr-add-folder ()
+ "Insert new bookmarks folder."
+ (interactive)
+ (bmk-mgr-with-current-node-save
+ (let* ((fpath (if (bmk-mgr-node-folder-p bmk-node) bmk-path
+ (bmk-mgr-path-parent bmk-path)))
+ (npath (bmk-mgr-ask-path "New folder: " fpath))
+ (pnpath (bmk-mgr-path-parent npath))
+ (sibling (and (not (equal bmk-path fpath)) ; inserting besides a url
+ (equal fpath pnpath)))) ; in the same folder
+ (if (and (not (equal fpath pnpath))
+ (not (bmk-mgr-find-path-in-buffer pnpath t)))
+ (error "Folder %s does not exist" (bmk-mgr-path-to-string pnpath)))
+ (let ((node (bmk-mgr-node-folder-new (bmk-mgr-path-leaf npath))))
+ (if sibling
+ (bmk-mgr-insert-sibling-at-point node nil)
+ (bmk-mgr-insert-child-at-point node t))
+ (bmk-mgr-goto-node-around node)))))
+
+(defun bmk-mgr-yank-bookmark (arg)
+ "Yank last killed bookmark at point."
+ (interactive "P")
+ (let ((count (if arg (prefix-numeric-value arg) 1)))
+ (while (> count 0)
+ (decf count)
+ (bmk-mgr-with-current-node-save
+ (bmk-mgr-add-bookmark nil (bmk-mgr-pop-kill-ring))))))
+
+(defun bmk-mgr-delete-node-at-point ()
+ (let ((path (bmk-mgr-get-path-at-point)))
+ (beginning-of-line)
+ (hide-subtree)
+ (let ((a (point))
+ (b (save-excursion (outline-next-visible-heading 1) (point))))
+ (if bmk-mgr-use-images (remove-images a b))
+ (delete-region a b)
+ (if (eobp) (outline-previous-visible-heading 1)))
+ (bmk-mgr-delete-node (bmk-mgr-get-root-node-in-buffer) path)))
+
+(defun bmk-mgr-kill-bookmark (arg)
+ "Delete bookmark at point."
+ (interactive "P")
+ (let ((count (if arg (prefix-numeric-value arg) 1)))
+ (while (> count 0)
+ (decf count)
+ (bmk-mgr-with-current-node-save
+ (if (not (bmk-mgr-path-parent bmk-path))
+ (error "Cannot kill root node"))
+ (if (and (bmk-mgr-node-folder-p bmk-node)
+ (not (null (bmk-mgr-node-children bmk-node)))
+ (not (y-or-n-p
+ (format
+ "Killing `%s' and all its contents. Are you sure? "
+ (bmk-mgr-path-leaf bmk-path)))))
+ (error "Cancelled"))
+ (bmk-mgr-push-to-kill-ring bmk-node)
+ (bmk-mgr-delete-node-at-point)))))
+
+(defun bmk-mgr-transpose-lines (node path count &optional up)
+ (beginning-of-line)
+ (outline-next-visible-heading (if up count (* -1 count)))
+ (let ((eol (save-excursion (end-of-line) (point))))
+ (if bmk-mgr-use-images (remove-images (point) eol))
+ (delete-region (point) (1+ eol))
+ (outline-next-visible-heading (if up (* -1 count) count))
+ (bmk-mgr-print-single-node-at-point node path t)))
+
+(defun bmk-mgr-goto-node-around (node &optional width)
+ (let ((width (or width 2)))
+ (outline-previous-visible-heading (1+ width))
+ (do ((max (1+ (* 2 width))) (n 0 (incf n)))
+ ((or (> n max) (eq node (bmk-mgr-get-node-at-point))))
+ (outline-next-visible-heading 1))))
+
+(defun bmk-mgr-move-bookmark-up (arg)
+ "Move bookmark at point one line up."
+ (interactive "P")
+ (bmk-mgr-with-current-node-save
+ (let ((ppath (bmk-mgr-path-parent bmk-path))
+ (count (if arg (prefix-numeric-value arg) 1)))
+ (when (and (> count 0)
+ (bmk-mgr-node-url-p bmk-node)
+ (> (length bmk-path) 1))
+ (beginning-of-line)
+ (let ((p (point)))
+ (outline-previous-visible-heading count)
+ (if (= (bmk-mgr-outline-level) 1)
+ (progn
+ (outline-next-visible-heading 1)
+ (when (not (equal bmk-node (bmk-mgr-get-node-at-point)))
+ (goto-char p)
+ (bmk-mgr-delete-node-at-point)
+ (goto-char 1)
+ (bmk-mgr-insert-child-at-point bmk-node t)))
+ (let* ((current (bmk-mgr-get-node-at-point))
+ (iscl (bmk-mgr-node-closed-p current))
+ (isurl (bmk-mgr-node-url-p current))
+ (cpath (bmk-mgr-get-path-at-point))
+ (cppath (bmk-mgr-path-parent cpath)))
+ (cond
+ ((and (equal ppath cppath) (or isurl iscl))
+ (bmk-mgr-node-swap-children-at-path
+ (bmk-mgr-get-root-node-in-buffer) ppath bmk-node current)
+ (bmk-mgr-transpose-lines bmk-node bmk-path count t))
+ (t
+ (outline-next-visible-heading count)
+ (bmk-mgr-delete-node-at-point)
+ (outline-previous-visible-heading count)
+ (if (or isurl iscl (equal cpath ppath))
+ (bmk-mgr-insert-sibling-at-point bmk-node
+ (equal cpath ppath))
+ (bmk-mgr-insert-child-at-point bmk-node nil)))))))
+ (bmk-mgr-goto-node-around bmk-node)))))
+
+(defun bmk-mgr-move-bookmark-down (arg)
+ "Move bookmark at point one line down."
+ (interactive "P")
+ (bmk-mgr-with-current-node-save
+ (let ((ppath (bmk-mgr-path-parent bmk-path))
+ (count (if arg (prefix-numeric-value arg) 1)))
+ (when (and (> count 0)
+ (bmk-mgr-node-url-p bmk-node)
+ (> (length bmk-path) 1))
+ (beginning-of-line)
+ (let ((p (point)))
+ (outline-next-visible-heading count)
+ (if (null (bmk-mgr-get-node-at-point))
+ (progn
+ (outline-previous-visible-heading 1)
+ (when (not (equal bmk-node (bmk-mgr-get-node-at-point)))
+ (goto-char p)
+ (bmk-mgr-delete-node-at-point)
+ (goto-char 1)
+ (bmk-mgr-insert-child-at-point bmk-node nil)
+ (goto-char (point-max))))
+ (let* ((current (bmk-mgr-get-node-at-point))
+ (iscl (bmk-mgr-node-closed-p current))
+ (isurl (bmk-mgr-node-url-p current))
+ (cpath (bmk-mgr-get-path-at-point))
+ (isout (< (length cpath) (length bmk-path)))
+ (cppath (bmk-mgr-path-parent cpath)))
+ (cond
+ ((and (equal ppath cppath) (or isurl iscl))
+ (bmk-mgr-node-swap-children-at-path
+ (bmk-mgr-get-root-node-in-buffer) ppath bmk-node current)
+ (bmk-mgr-transpose-lines bmk-node bmk-path count nil))
+ (t
+ (outline-previous-visible-heading count)
+ (bmk-mgr-delete-node-at-point)
+ (outline-next-visible-heading (1- count))
+ (if (or isurl iscl isout)
+ (bmk-mgr-insert-sibling-at-point bmk-node isout)
+ (bmk-mgr-insert-child-at-point bmk-node t)))))))
+ (bmk-mgr-goto-node-around bmk-node)))))
+
+(defvar bmk-mgr-import-formats '(("xbel" . bmk-mgr-import-xbel)
+ ("bmk" . bmk-mgr-import-bmk)))
+
+(defun bmk-mgr-import-add-formatter (name fun)
+ (add-to-list 'bmk-mgr-import-formats `(,name . ,fun)))
+
+(defun bmk-mgr-import ()
+ "Import bookmarks file."
+ (interactive)
+ (let* ((formats bmk-mgr-import-formats)
+ (names (mapcar 'car formats))
+ (prompt (concat "Format (" (mapconcat 'identity names ", ") "): "))
+ (sel (completing-read prompt formats nil 1))
+ (fun (cdr (assoc sel formats))))
+ (if fun
+ (bmk-mgr-with-bookmarks-buffer
+ (let* ((file (read-file-name "File: " nil nil t))
+ (folder (bmk-mgr-ask-path "Import to folder: "))
+ (ign (message "Reading %s..." file))
+ (node (funcall fun file (bmk-mgr-path-leaf folder))))
+ (when node
+ (message "Importing bookmarks...")
+ (if (bmk-mgr-find-path-in-buffer folder t)
+ (let ((parent (bmk-mgr-get-node-at-point))
+ (children (bmk-mgr-node-children node)))
+ (if (bmk-mgr-node-folder-p parent)
+ (progn
+ (mapc (lambda (x)
+ (bmk-mgr-node-add-child parent x)) children)
+ (bmk-mgr-update-tree-at-point)
+ (bmk-mgr-refresh-open-close)
+ (message nil))
+ (message "`%s' is not a correct insertion point"
+ (bmk-mgr-node-name parent))))
+ (if (bmk-mgr-find-path-in-buffer (bmk-mgr-path-parent folder) t)
+ (progn
+ (bmk-mgr-insert-child-at-point node nil)
+ (message nil))))))))))
+
+(defun bmk-mgr-quit-ask ()
+ "Quit bookmarks buffer, asking for confirmation."
+ (interactive)
+ (when (y-or-n-p "Close bookmarks browser? ") (bmk-mgr-quit)))
+
+(defun bmk-mgr-quit ()
+ "Quit bookmarks buffer."
+ (interactive)
+ (with-current-buffer (bmk-mgr-get-bookmark-buffer)
+ (bmk-mgr-save-current-tree)
+ (kill-buffer (current-buffer))))
+
+;;;; Import/export:
+
+;;;;; xbel:
+(defun bmk-mgr-xbel-get-title (node def)
+ (let* ((title-node (car (xml-get-children node 'title)))
+ (title-body (or (and title-node (xml-node-children title-node))
+ '())))
+ (bmk-mgr-filter-html
+ (or (and title-body (stringp (car title-body)) (car title-body)) def))))
+
+(defun bmk-mgr-xbel-to-bmk (xbel &optional name)
+ (when (listp xbel)
+ (case (xml-node-name xbel)
+ (xbel (bmk-mgr-node-folder-new
+ (or name "xbel") nil
+ (mapcar 'bmk-mgr-xbel-to-bmk
+ (append (xml-get-children xbel 'bookmark)
+ (xml-get-children xbel 'folder)))))
+ (folder (bmk-mgr-node-folder-new
+ (bmk-mgr-xbel-get-title xbel "folder")
+ (equal (xml-get-attribute xbel 'folded) "yes")
+ (mapcar 'bmk-mgr-xbel-to-bmk
+ (append (xml-get-children xbel 'bookmark)
+ (xml-get-children xbel 'folder)))))
+ (bookmark
+ (let* ((href (bmk-mgr-filter-html (xml-get-attribute xbel 'href)))
+ (title (bmk-mgr-xbel-get-title xbel href)))
+ (bmk-mgr-node-url-new title href))))))
+
+(defun bmk-mgr-import-xbel (file name)
+ (save-current-buffer
+ (if (not (file-readable-p file)) (error "Cannot read file"))
+ (require 'xml)
+ (message "Reading XBEL file...")
+ (bmk-mgr-xbel-to-bmk
+ (car (with-temp-buffer
+ (insert-buffer (find-file-noselect file))
+ (beginning-of-buffer)
+ (while (re-search-forward "\n" nil t) (replace-match ""))
+ (beginning-of-buffer)
+ (while (re-search-forward "\"\"" nil t) (replace-match "\"empty\""))
+ (beginning-of-buffer)
+ (while (re-search-forward "> +<" nil t) (replace-match "><"))
+ (xml-parse-region (point-min) (point-max))))
+ name)))
+
+;;;;; aux:
+(defconst bmk-mgr-html-scp "&#[0-9]+\\;")
+
+(defun bmk-mgr-filter-html (str)
+ (let* ((str (substring-no-properties str))
+ (result "")
+ (p0 0)
+ (p1 (string-match bmk-mgr-html-scp str)))
+ (while p1
+ (let* ((p2 (match-end 0))
+ (ch
+ (char-to-string (bmk-string-to-int (substring
+ str (+ 2 p1) (1- p2))))))
+ (setf result (concat result (substring str p0 p1) ch))
+ (setf p0 p2)
+ (setf p1 (string-match bmk-mgr-html-scp str p2))))
+ (concat result (substring str p0))))
+
+;;;; Bookmarks buffer:
+
+;;;;; Functions:
+(defun bmk-mgr-print-single-node-at-point (node path &optional insert)
+ (beginning-of-line)
+ (let ((kill-whole-line nil)
+ (inhibit-read-only t)
+ (depth (* (- (length path) 1) bmk-mgr-indent-width))
+ (txt-mark "")
+ (img))
+ (if (bmk-mgr-node-folder-p node)
+ (if (bmk-mgr-node-open-p node)
+ (setq txt-mark bmk-mgr-open-mark img bmk-mgr-fopen-img)
+ (setq txt-mark bmk-mgr-closed-mark img bmk-mgr-fclosed-img))
+ (if (> (length (bmk-mgr-node-url node)) 0)
+ (setq txt-mark bmk-mgr-link-mark img bmk-mgr-url-img)))
+ (if insert
+ (progn (newline)
+ (forward-line -1))
+ (kill-line))
+ (delete-trailing-whitespace)
+ (remove-images (point) (save-excursion (end-of-line) (point)))
+ (insert (make-string depth 32))
+ (if bmk-mgr-use-images
+ (if img ; no image for separators
+ (progn (put-image img (point)) (insert " ")))
+ (insert txt-mark))
+ (insert (bmk-mgr-node-title node))
+ (bmk-mgr-set-path-at-point path)
+ (bmk-mgr-set-node-at-point node)))
+
+(defun bmk-mgr-print-tree (tree &optional path level)
+ (let* ((kill-whole-line nil)
+ (inhibit-read-only t)
+ (next-line-add-newlines nil)
+ (insertp
+ (lambda (node path)
+ (not
+ (and (equal path (bmk-mgr-get-path-at-point))
+ (equal (bmk-mgr-node-type node)
+ (bmk-mgr-node-type (bmk-mgr-get-node-at-point)))))))
+ (pfun
+ (lambda (n w)
+ (beginning-of-line)
+ (let* ((title (bmk-mgr-node-title n))
+ (neww (append w (list title))))
+ (bmk-mgr-print-single-node-at-point
+ n neww (funcall insertp n neww))
+ (if (eobp) (newline))
+ (next-line 1)
+ (cons neww t)))))
+ (bmk-mgr-visit-tree tree pfun path)))
+
+(defsubst bmk-mgr-update-tree-at-point ()
+ (save-excursion
+ (bmk-mgr-print-tree (bmk-mgr-get-node-at-point)
+ (bmk-mgr-path-parent (bmk-mgr-get-path-at-point)))))
+
+(defsubst bmk-mgr-set-path-at-point (path &optional buffer)
+ (let ((inhibit-field-text-motion t)
+ (pos (save-excursion (end-of-line) (point))))
+ (save-excursion
+ (beginning-of-line)
+ (add-text-properties (point) pos (list 'bmk-mgr-path path) buffer))))
+
+(defsubst bmk-mgr-set-node-at-point (node &optional buffer)
+ (let ((inhibit-field-text-motion t)
+ (pos (save-excursion (end-of-line) (point))))
+ (save-excursion
+ (beginning-of-line)
+ (add-text-properties (point) pos (list 'bmk-mgr-node node) buffer)
+ (when (bmk-mgr-node-url-p node)
+ (bmk-mgr-beginning)
+ (add-text-properties (point) (1- pos)
+ (list 'mouse-face 'bmk-mgr-sel-bookmark-face)
+ buffer)))))
+
+(defsubst bmk-mgr-get-path-at-point (&optional buffer)
+ (get-text-property (point) 'bmk-mgr-path buffer))
+
+(defsubst bmk-mgr-get-node-at-point (&optional buffer)
+ (get-text-property (point) 'bmk-mgr-node buffer))
+
+(defun bmk-mgr-get-root-node-in-buffer (&optional buffer)
+ (save-current-buffer
+ (if buffer (set-buffer buffer))
+ (save-excursion
+ (goto-char (point-min))
+ (bmk-mgr-get-node-at-point))))
+
+(defun bmk-mgr-refresh-open-close ()
+ (save-excursion
+ (let* ((node (bmk-mgr-get-node-at-point))
+ (path (bmk-mgr-get-path-at-point))
+ (cl (length path)))
+ (unless (eobp)
+ (bmk-mgr-unmark-current)
+ (if (bmk-mgr-node-open-p node)
+ (progn
+ (show-children)
+ (outline-next-visible-heading 1)
+ (while (> (length (bmk-mgr-get-path-at-point)) cl)
+ (bmk-mgr-refresh-open-close)
+ (outline-next-visible-heading 1)))
+ (hide-subtree))))))
+
+(defun bmk-mgr-redraw-node-at-point (&optional path)
+ (save-excursion
+ (let ((node (bmk-mgr-get-node-at-point)))
+ (when node
+ (show-children)
+ (bmk-mgr-print-single-node-at-point
+ node (or path (bmk-mgr-get-path-at-point)))
+ (beginning-of-line)
+ (when (bmk-mgr-node-folder-p node)
+ (if (bmk-mgr-node-open-p node)
+ (bmk-mgr-refresh-open-close)
+ (hide-subtree)))))))
+
+(defun bmk-mgr-find-path-in-buffer (path &optional begin)
+ (beginning-of-line)
+ (let ((ip (point))
+ (ppos)
+ (found))
+ (if begin (goto-char (point-min)))
+ (while (not (or found (eobp)))
+ (let* ((cp (bmk-mgr-get-path-at-point))
+ (node (bmk-mgr-get-node-at-point))
+ (isf (and node (bmk-mgr-node-folder-p node)))
+ (isclf (and isf (bmk-mgr-node-closed-p node))))
+ (cond
+ ((equal path cp)
+ (save-excursion
+ (mapc (lambda (p)
+ (goto-char p)
+ (bmk-mgr-toggle-folder)
+ (bmk-mgr-unmark-current))
+ (reverse (if isclf (cons (point) ppos) ppos))))
+ (setf found t))
+ ((or (and isf (bmk-mgr-path-contains cp path))
+ (and (not isf) (equal (bmk-mgr-path-parent cp)
+ (bmk-mgr-path-parent path))))
+ (if isclf (setf ppos (cons (point) ppos)))
+ (forward-line 1))
+ (t (let ((cl (bmk-mgr-outline-level)))
+ (forward-line 1)
+ (while (and (not (eobp))
+ (< cl (bmk-mgr-outline-level)))
+ (forward-line 1)))))))
+ (if (not found) (goto-char ip)
+ (save-excursion (goto-char ip) (bmk-mgr-unmark-current)))
+ (and found (point))))
+
+(defun bmk-mgr-insert-sibling-at-point (node before)
+ (let ((bmk-node (bmk-mgr-get-node-at-point))
+ (bmk-path (bmk-mgr-get-path-at-point))
+ (pos (point)))
+ (save-excursion
+ (if (and node
+ (bmk-mgr-find-path-in-buffer (bmk-mgr-path-parent bmk-path) t))
+ (let* ((path (list (bmk-mgr-path-leaf (bmk-mgr-get-path-at-point))
+ (bmk-mgr-path-leaf bmk-path)))
+ (newtree (bmk-mgr-insert-node (bmk-mgr-get-node-at-point)
+ node path t before)))
+ (if newtree
+ (progn
+ (goto-char pos)
+ (when (not before)
+ (outline-next-visible-heading 1)
+ (if (eobp) (newline)))
+ (save-excursion
+ (bmk-mgr-print-tree node
+ (bmk-mgr-path-parent bmk-path)))
+ (bmk-mgr-refresh-open-close))
+ (error "Internal error")))
+ (error "Path to node not found")))))
+
+
+(defun bmk-mgr-insert-child-at-point (node before)
+ (let ((bmk-node (bmk-mgr-get-node-at-point))
+ (bmk-path (bmk-mgr-get-path-at-point)))
+ (if (bmk-mgr-node-url-p bmk-node)
+ (bmk-mgr-insert-sibling-at-point node before)
+ (when node
+ (let* ((path (list (bmk-mgr-path-leaf bmk-path)))
+ (newtree (bmk-mgr-insert-node bmk-node node path nil before)))
+ (if newtree
+ (progn
+ (if (bmk-mgr-node-closed-p bmk-node) (bmk-mgr-toggle-folder))
+ (forward-line 1)
+ (if (and (not before)
+ (> (length (bmk-mgr-node-children bmk-node)) 1))
+ (condition-case nil
+ (while (not (eobp)) (outline-forward-same-level 1))
+ (error (forward-line 1))))
+ (save-excursion
+ (bmk-mgr-print-tree node bmk-path))
+ (bmk-mgr-refresh-open-close))))))))
+
+;;;; Bookmark tree datatype:
+
+;;;;; paths:
+
+(defsubst bmk-mgr-path-parent (path) (and (listp path) (subseq path 0 -1)))
+(defsubst bmk-mgr-path-leaf (path) (and (listp path) (car (subseq path -1))))
+(defsubst bmk-mgr-path-to-string (path)
+ (mapconcat (lambda (x) (and (stringp x) x))
+ (delete-if (lambda (x) (string= x "")) path) "/"))
+(defsubst bmk-mgr-string-to-path (path)
+ (delete-if (lambda (x) (string= x ""))
+ (split-string path "/")))
+(defsubst bmk-mgr-path-contains (parent child)
+ (equal parent (subseq child 0 (length parent))))
+
+;;;;; constructors:
+(defsubst bmk-mgr-node-url-new (title url) (list title url))
+(defsubst bmk-mgr-node-folder-new (name &optional closed children)
+ (cons name (cons (if closed :closed :open) children)))
+
+;;;;; accessors:
+(defsubst bmk-mgr-node-children (n) (cddr n))
+(defsubst bmk-mgr-node-name (n) (nth 0 n))
+(defsubst bmk-mgr-node-folder-p (n) (and n (symbolp (nth 1 n))))
+(defsubst bmk-mgr-node-open-p (n) (equal :open (nth 1 n)))
+(defsubst bmk-mgr-node-closed-p (n) (equal :closed (nth 1 n)))
+(defsubst bmk-mgr-node-url-p (n) (stringp (nth 1 n)))
+(defsubst bmk-mgr-node-url (n) (and (stringp (nth 1 n)) (nth 1 n)))
+(defsubst bmk-mgr-node-title (n) (nth 0 n))
+(defsubst bmk-mgr-node-type (n) (if (bmk-mgr-node-url-p n) 'url 'folder))
+
+(defun bmk-mgr-node-child-folders (node &optional path)
+ (let ((node (or (and (null path) node)
+ (and node path (bmk-mgr-find-node node path)))))
+ (when node
+ (remove-if 'bmk-mgr-node-url-p
+ (bmk-mgr-node-children node)))))
+
+(defun bmk-mgr-find-node (tree path)
+ (let* ((node nil)
+ (ffun (lambda (n p)
+ (if (equal (car p) (bmk-mgr-node-name n))
+ (if (null (cdr p))
+ (progn
+ (setq node n)
+ (cons nil nil))
+ (cons (cdr p) t))
+ (cons nil nil)))))
+ (bmk-mgr-visit-tree tree ffun path)
+ node))
+
+(defun bmk-mgr-find-node-and-parent (tree path)
+ (let* ((parent tree)
+ (node nil)
+ (fnode (lambda (n p)
+ (if (equal (car p) (bmk-mgr-node-name n))
+ (if (null (cdr p))
+ (progn (setq node n)
+ (cons nil nil))
+ (progn (setq parent n)
+ (cons (cdr p) t)))
+ (cons nil nil)))))
+ (bmk-mgr-visit-tree tree fnode path)
+ (cons (and node parent) node)))
+
+;;;;; modifiers:
+(defsubst bmk-mgr-node-set-name (node name)
+ (when (stringp name) (setf (car node) name)))
+
+(defsubst bmk-mgr-node-set-url (node url)
+ (when (and (bmk-mgr-node-url-p node) (stringp url)) (setf (nth 1 node) url)))
+
+(defun bmk-mgr-node-toggle-open-closed (node)
+ (when (bmk-mgr-node-folder-p node)
+ (setf (nth 1 node) (if (bmk-mgr-node-closed-p node) :open :closed))))
+
+(defsubst bmk-mgr-node-close (node)
+ (when (bmk-mgr-node-folder-p node) (setf (nth 1 node) :closed)))
+
+(defsubst bmk-mgr-node-close-all (tree)
+ (when (bmk-mgr-node-folder-p tree)
+ (bmk-mgr-node-close tree)
+ (mapc #'bmk-mgr-node-close-all (bmk-mgr-node-children tree))))
+
+(defsubst bmk-mgr-node-close-all-children (tree)
+ (when (bmk-mgr-node-folder-p tree)
+ (mapc #'bmk-mgr-node-close-all (bmk-mgr-node-children tree))))
+
+(defun bmk-mgr-node-set-children (node children)
+ (when (bmk-mgr-node-folder-p node)
+ (setf (nthcdr 2 node) children)))
+
+(defun bmk-mgr-node-swap-children (node c0 c1)
+ "Swap the positions of C0 and C1, which are children of NODE.
+
+If C0 is null, C1 gets promoted to the top of the children list.
+Conversely, if C1 is null, C0 goes to the tail."
+ (when (and (bmk-mgr-node-folder-p node) (or c0 c1))
+ (let* ((children (bmk-mgr-node-children node))
+ (p0 (position c0 children))
+ (p1 (position c1 children)))
+ (when (and children (or p0 p1))
+ (if (and c1 p1) (setf (nth (or p0 2) children) c1))
+ (if (and c0 p0)
+ (setf (nth (or p1 (1- (length children))) children) c0))))))
+
+(defun bmk-mgr-node-swap-children-at-path (tree path c0 c1)
+ "Calls `bmk-mgr-node-swap-children' on the node of TREE denoted by
+path."
+ (when tree
+ (let ((node (bmk-mgr-find-node tree path)))
+ (if node (bmk-mgr-node-swap-children node c0 c1)))))
+
+(defun bmk-mgr-node-add-child (tree node &optional prev before)
+ "Add NODE as a new child of TREE, after (or before, if BEFORE is not
+null) node PREV if it exists.
+
+Returns the updated TREE if successful, nil otherwise."
+ (when (bmk-mgr-node-folder-p tree)
+ (let* ((pos (or (position prev tree) (if before 2)))
+ (insp (if (not pos) (length tree) (if before pos (1+ pos)))))
+ (setf (nthcdr insp tree) (cons node (nthcdr insp tree)))
+ tree)))
+
+(defun bmk-mgr-insert-node (tree node path &optional sibling before)
+ "Insert the NODE at the given PATH of TREE.
+
+If SIBLING is not null, the new node will be inserted as a sibling of
+the one denoted by PATH. Otherwise, PATH is the path of NODE's parent.
+If BEFORE is not null, NODE is inserter before or as the first child
+denoted by path.
+
+Returns the updated parent of NODE if successful, nil otherwise."
+ (let* ((np (bmk-mgr-find-node-and-parent tree path))
+ (parent (and np (car np)))
+ (found (and np (cdr np))))
+ (when found
+ (if (or sibling (bmk-mgr-node-url-p found))
+ (bmk-mgr-node-add-child parent node found before)
+ (bmk-mgr-node-add-child found node nil before)))))
+
+(defun bmk-mgr-delete-node (tree path)
+ (let* ((np (bmk-mgr-find-node-and-parent tree path))
+ (parent (and np (car np)))
+ (found (and np (cdr np)))
+ (children (and found (bmk-mgr-node-children parent))))
+ (when children
+ (bmk-mgr-node-set-children parent (remove found children)))))
+
+;;;;; input/output:
+(defun bmk-mgr-read-from-file (filename)
+ (let ((rfname (expand-file-name filename)))
+ (if (file-readable-p rfname)
+ (with-temp-buffer
+ (insert-file-contents rfname)
+ (goto-char (point-min))
+ (let ((sexp (read (current-buffer))))
+ (and (bmk-mgr-node-folder-p sexp) sexp)))
+ '("Bookmarks" :open
+ ("Emacs bookmark manager"
+ "http://www.emacswiki.org/cgi-bin/wiki/EmacsBmkMgr")))))
+
+(defun bmk-mgr-save-to-file (bmks filename)
+ (require 'pp)
+ (when (bmk-mgr-node-folder-p bmks)
+ (let ((rfname (expand-file-name filename))
+ (b (if bmk-mgr-ignore-fold-state (subst :closed :open bmks) bmks)))
+ (with-temp-buffer
+ (insert ";;; File automatically generated by Emacs Bookmark Manager"
+ "\n")
+ (if bmk-mgr-ignore-fold-state (bmk-mgr-node-toggle-open-closed b))
+ (pp b (current-buffer))
+ (insert "\n;;; End of " (file-name-nondirectory rfname) "\n")
+ (write-region (point-min) (point-max) rfname)))))
+
+
+;;;;; aux functions:
+(defun bmk-mgr-visit-tree (tree fun arg)
+ "Visit a bookmarks tree aplying FUN to its nodes."
+ (when tree
+ (let ((arg (funcall fun tree arg)))
+ (when (cdr arg)
+ (mapc (lambda (n) (bmk-mgr-visit-tree n fun (car arg)))
+ (bmk-mgr-node-children tree))))))
+
+
+
+(provide 'bmk-mgr)
+
+
+
+
+
+;;; Local stuff:
+;;;; Local Variables: ;;
+;;;; mode: emacs-lisp ;;
+;;;; mode: outline-minor ;;
+;;;; outline-regexp: ";;[;\f]+ " ;;
+;;;; outline-heading-end-regexp: ":\n" ;;
+;;;; indent-tabs-mode: nil ;;
+;;;; End: ;;
+
+;;; bmk-mgr.el ends here
diff --git a/bmk/dot-emacs.el b/bmk/dot-emacs.el
new file mode 100644
index 0000000..01f00d0
--- /dev/null
+++ b/bmk/dot-emacs.el
@@ -0,0 +1,42 @@
+;;; sample initialisation file for bmk-mgr
+
+(if (require 'bmk-mgr nil t)
+ (progn
+ (setq bmk-mgr-bookmark-file "~/.emacs.d/bookmarks")
+ (setq bmk-mgr-inhibit-welcome-message nil)
+ (setq bmk-mgr-inhibit-minibuffer t)
+ (setq bmk-mgr-use-own-frame nil)
+ (setq bmk-mgr-use-images t)
+ (setq bmk-mgr-ignore-fold-state t)
+
+ (define-key bmk-mgr-mode-map "g" 'bmk-mgr-browse-url)
+ (define-key bmk-mgr-mode-map "G" 'bmk-mgr-browse-url-alt)
+ (global-set-key "\C-cB" 'bmk-mgr-show-bookmarks)
+ (global-set-key "\C-cA" 'bmk-mgr-add-url-at-point)
+
+ ;;;; integration with emacs-w3m (optional)
+ (when (require 'w3m nil t)
+ (require 'bmk-mgr-w3m)
+ (defun browse-bmk-w3m (url &rest ig)
+ (goto-w3m-buffer)
+ (w3m-goto-url url t))
+
+ (defun browse-bmk-new-tab-w3m (url &rest ig)
+ (goto-w3m-buffer)
+ (w3m-goto-url-new-session url t))
+
+ (defun goto-w3m-buffer () (interactive)
+ (let ((display-buffer-reuse-frames 1)
+ (pop-up-windows nil)
+ (buffer (w3m-alive-p)))
+ (if buffer (pop-to-buffer buffer))))
+
+ (define-key bmk-mgr-mode-map "w" 'goto-w3m-buffer)
+ (setq bmk-mgr-browser-function 'browse-bmk-w3m)
+ (setq bmk-mgr-alt-browser-function 'browse-bmk-new-tab-w3m))
+
+ ;; integration with w3
+ (require 'bmk-mgr-w3)))
+
+ (message "bookmark manager not available"))
+
diff --git a/bmk/folder-closed.xpm b/bmk/folder-closed.xpm
new file mode 100644
index 0000000..ece8a9e
--- /dev/null
+++ b/bmk/folder-closed.xpm
@@ -0,0 +1,31 @@
+/* XPM */
+static char *folder-closed[] = {
+/* columns rows colors chars-per-pixel */
+"16 16 9 1",
+" c gray100",
+". c #FFFFCC",
+"X c #CCCCFF",
+"o c #C0C0C0",
+"O c #9999FF",
+"+ c #6666CC",
+"@ c #222222",
+"# c black",
+"$ c None",
+/* pixels */
+"$$$$$$$$$$$$$$$$",
+"$$$$$$$$$$$$$$$$",
+"$$$$$$$$$$$$$$$$",
+"$$$$$$$$$$$$$$$$",
+"$$++++O$$$$$$$$$",
+"$+ XXO.++++++$$$",
+"+ XXXXXXXXXXXO$$",
+"+ OXOXOXOXOXO+$$",
+"+ XOXOXOXOXOX+#$",
+"+ OXOXOXOXOXO+#$",
+"+ XOXOXOXOXOX+#$",
+"+ OXOXOXOXOXO+#$",
+"+ XOXOXOXOXOX+#$",
+"+XOXOXOXOXOXO+#$",
+"++++++++++++++#$",
+"$#@@###########$"
+};
diff --git a/bmk/folder-open.xpm b/bmk/folder-open.xpm
new file mode 100644
index 0000000..f03f65c
--- /dev/null
+++ b/bmk/folder-open.xpm
@@ -0,0 +1,39 @@
+/* XPM */
+static char *folder-open[] = {
+/* columns rows colors chars-per-pixel */
+"16 16 17 1",
+" c gray100",
+". c #FFFFCC",
+"X c magenta",
+"o c #CCCCFF",
+"O c #C0C0C0",
+"+ c #9999FF",
+"@ c #6666CC",
+"# c #222222",
+"$ c black",
+"% c black",
+"& c black",
+"* c black",
+"= c black",
+"- c black",
+"; c black",
+": c black",
+"> c None",
+/* pixels */
+">>>>>>>>>>>>>>>>",
+">>>>>>>>>>>>>>>>",
+">>>>>>>>>>>>>>>>",
+">>>>>>>>>>>>>>>>",
+">>@@@@>>>>>>>>>>",
+">@ @@@@@@@@@>>",
+">@ +O.......#+@>",
+">@ O.......#+o@>",
+">+ .......#+o+@$",
+"@@@@@@@@@@#@+o@$",
+"@ O$o+@$",
+">@+O+O+O+O+O$o@$",
+">@O+O+O+O+O+#$@$",
+">>@O+O+O+O+O+#$$",
+">>@@@@@@@@@@@@@$",
+">>>$$$$$$$$$$$$$"
+};
diff --git a/bmk/url-alt.xpm b/bmk/url-alt.xpm
new file mode 100644
index 0000000..4cb2c14
--- /dev/null
+++ b/bmk/url-alt.xpm
@@ -0,0 +1,31 @@
+/* XPM */
+static char *document[] = {
+/* columns rows colors chars-per-pixel */
+"16 16 9 1",
+" c gray100",
+". c #CECEBF",
+"X c gray80",
+"o c #272724",
+"O c black",
+"+ c black",
+"@ c black",
+"# c black",
+"$ c None",
+/* pixels */
+"$oooooooooo$$$$$",
+"$o........oO$$$$",
+"$o........oXO$$$",
+"$o........oooo$$",
+"$o...........o$$",
+"$o...........o$$",
+"$o..o.oo.oo..o$$",
+"$o...........o$$",
+"$o..oooo.oo..o$$",
+"$o...........o$$",
+"$o..oo.oo.o..o$$",
+"$o...........o$$",
+"$o...........o$$",
+"$o...........o$$",
+"$o...........o$$",
+"$ooooooooooooo$$"
+};
diff --git a/bmk/url.xpm b/bmk/url.xpm
new file mode 100644
index 0000000..60cad93
--- /dev/null
+++ b/bmk/url.xpm
@@ -0,0 +1,39 @@
+/* XPM */
+static char *article[] = {
+/* columns rows colors chars-per-pixel */
+"16 16 17 1",
+" c black",
+". c #BF0000",
+"X c #00BF00",
+"o c #BFBF00",
+"O c #0000BF",
+"+ c #BF00BF",
+"@ c #00BFBF",
+"# c #C0C0C0",
+"$ c #808080",
+"% c red",
+"& c green",
+"* c yellow",
+"= c blue",
+"- c magenta",
+"; c cyan",
+": c gray100",
+"> c None",
+/* pixels */
+"OOOOOOOOOOO>>>>>",
+"O:::::::::O>>>>>",
+"O: #$ # #:OOO>>>",
+"O:$ # $ :O*O>>>",
+"O:::::::::O:O$>>",
+"O:#$:$$#$:O*O$>>",
+"O:::::::::O:O$>>",
+"O:$$:$#$$:O*O$>>",
+"O:::::::::O:O$>>",
+"O:#$:$$$#:O*O$>>",
+"O:::::::::O:O$>>",
+"OOOOOOOOOOO*O$>>",
+">>O:*:*:*:*:O$>>",
+">>OOOOOOOOOOO$>>",
+">>>>$$$$$$$$$$>>",
+">>>>>>>>>>>>>>>>"
+};
diff --git a/emms/jao-emms-info-track.el b/emms/jao-emms-info-track.el
new file mode 100644
index 0000000..5fac8f3
--- /dev/null
+++ b/emms/jao-emms-info-track.el
@@ -0,0 +1,123 @@
+;; jao-emms-info-track.el -- utilities to show tracks
+
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Sat Jul 04, 2009 13:47
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'emms)
+(require 'jao-osd)
+(require 'jao-emms)
+
+(defgroup jao-emms-faces nil "Faces"
+ :group 'faces
+ :group 'jao-emms)
+
+(defface jao-emms-font-lock-album '((t (:foreground "lightgoldenrod2")))
+ "Album name in EMMS track message."
+ :group 'jao-emms-faces)
+
+(defface jao-emms-font-lock-track '((t (:bold t)))
+ "Track number in EMMS track message."
+ :group 'jao-emms-faces)
+
+(defface jao-emms-font-lock-title '((t (:foreground "dodgerblue2")))
+ "Track title in EMMS track message."
+ :group 'jao-emms-faces)
+
+(defface jao-emms-font-lock-artist '((t (:foreground "dodgerblue3")))
+ "Artist name in EMMS track message."
+ :group 'jao-emms-faces)
+
+(defcustom jao-emms-show-osd-p nil
+ "Whether to show osd notices on track change"
+ :group 'jao-emms)
+
+
+
+(defun jao-emms-info-track-stream (track)
+ "Return track info for streams"
+ (let ((name (emms-track-name track))
+ (title (or (emms-track-get track 'title nil)
+ (car (emms-track-get track 'metadata nil)))))
+ (format "♪ %s (%s)" title (if title (emms-track-type track) name))))
+
+(defsubst jao--put-face (str face)
+ (put-text-property 0 (length str) 'face face str)
+ str)
+
+(defun jao-emms-info-track-file (track)
+ "Return a description of the current track."
+ (let ((no (string-to-number (emms-track-get track 'info-tracknumber "0")))
+ (time (emms-track-get track 'info-playing-time))
+ (artist (emms-track-get track 'info-artist ""))
+ (composer (emms-track-get track 'info-composer nil))
+ (title (emms-track-get track 'info-title ""))
+ (album (emms-track-get track 'info-album))
+ (last-played (or (emms-track-get track 'last-played) '(0 0 0)))
+ (play-count (or (emms-track-get track 'play-count) 0)))
+ (if (or (not title) (not album))
+ (emms-track-simple-description track)
+ (format "♪ %s%s%s%s%s %s"
+ (if time (format "[%02d:%02d] " (/ time 60) (mod time 60)) "")
+ (jao--put-face artist 'jao-emms-font-lock-artist)
+ (jao--put-face (if composer (format " [%s]" composer) "")
+ 'jao-emms-font-lock-artist)
+ (jao--put-face (if album (format " (%s)" album) " *")
+ 'jao-emms-font-lock-album)
+ (jao--put-face (if (zerop no) "" (format " %02d." no))
+ 'jao-emms-font-lock-track)
+ (jao--put-face title
+ 'jao-emms-font-lock-title)))))
+
+(defun jao-emms-info-track-description (track)
+ (if (memq (emms-track-type track) '(streamlist url))
+ (jao-emms-info-track-stream track)
+ (jao-emms-info-track-file track)))
+
+(defun jao-emms-toggle-osd ()
+ (interactive)
+ (setq jao-emms-show-osd-p (not jao-emms-show-osd-p))
+ (message "Emms OSD %s" (if jao-emms-show-osd-p "enabled" "disabled")))
+
+(defsubst jao-emms-current-track-str ()
+ (substring-no-properties (jao-emms-info-track-description
+ (emms-playlist-current-selected-track))))
+
+(defun jao-emms-show-osd ()
+ (interactive)
+ (let ((str (jao-emms-current-track-str)))
+ (when str (jao-osd-cat 'emms (substring str 2)))
+ t))
+
+(defun jao-emms-show-osd-hook ()
+ (interactive)
+ (when jao-emms-show-osd-p (jao-emms-show-osd))
+ t)
+
+(defun jao-emms-info-setup (&optional show-osd show-echo-line)
+ (setq emms-track-description-function 'jao-emms-info-track-description)
+ (setq jao-emms-show-osd-p show-osd)
+ (add-hook 'emms-player-started-hook 'jao-emms-show-osd-hook)
+ (unless show-echo-line
+ (eval-after-load 'emms-player-mpd
+ '(remove-hook 'emms-player-started-hook 'emms-player-mpd-show))))
+
+
+(provide 'jao-emms-info-track)
+;;; jao-emms-info-track.el ends here
diff --git a/emms/jao-emms-lyrics.el b/emms/jao-emms-lyrics.el
new file mode 100644
index 0000000..965f7cd
--- /dev/null
+++ b/emms/jao-emms-lyrics.el
@@ -0,0 +1,171 @@
+;; jao-emms-lyrics.el -- simple show lyrics in emms
+
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Sat Jul 04, 2009 13:41
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'emms)
+
+(defvar jao-emms-lyrics-cache-dir "~/.emacs.d/emms-lyrics")
+
+(defun jao-emms-lyrics--filename (artist title)
+ (expand-file-name (format "%s.lyr" title)
+ (jao-emms-lyrics--ensure-dir artist)))
+
+(defun jao-emms-lyrics--ensure-dir (artist)
+ (let ((candidate (expand-file-name artist jao-emms-lyrics-cache-dir)))
+ (unless (file-directory-p candidate)
+ (make-directory candidate t))
+ candidate))
+
+(defun jao-emms-lyrics--get-cached (artist title)
+ (let ((candidate (jao-emms-lyrics--filename artist title)))
+ (and (file-exists-p candidate)
+ (with-current-buffer (find-file-noselect candidate)
+ (prog1
+ (buffer-string)
+ (kill-buffer))))))
+
+(defun jao-emms-lyrics--cache (artist title lyrics)
+ (with-current-buffer
+ (find-file-noselect (jao-emms-lyrics--filename artist title))
+ (delete-region (point-min) (point-max))
+ (insert lyrics)
+ (save-buffer)
+ (kill-buffer)))
+
+(make-variable-buffer-local
+ (defvar jao-emms-lyrics--path nil))
+
+(defvar jao-emms-lyrics-mode-map)
+(setq jao-emms-lyrics-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (define-key map [?q] 'bury-buffer)
+ (define-key map [?g] 'jao-emms-show-lyrics)
+ (define-key map [?G] 'jao-emms-show-lyrics-force)
+ (define-key map [?e] 'jao-emms-edit-lyrics)
+ map))
+
+(defvar jao-emms-font-lock-artist 'bold)
+(defvar jao-emms-font-lock-title 'bold)
+
+(defun jao-emms-lyrics-mode ()
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map jao-emms-lyrics-mode-map)
+ (setq major-mode 'jao-emms-lyrics-mode)
+ (setq mode-name "lyrics")
+ (toggle-read-only 1))
+
+(defun jao-emms-lyrics-buffer ()
+ (or (get-buffer "*Emms Lyrics*")
+ (with-current-buffer (get-buffer-create "*Emms Lyrics*")
+ (jao-emms-lyrics-mode)
+ (current-buffer))))
+
+(defun jao-emms-lyrics-track-data ()
+ (let ((track (or (emms-playlist-current-selected-track)
+ (error "No playing track"))))
+ (cons (or (emms-track-get track 'info-artist nil)
+ (error "No artist"))
+ (or (emms-track-get track 'info-title nil)
+ (error "No artist")))))
+
+(defun jao-emms-edit-lyrics ()
+ (interactive)
+ (unless jao-emms-lyrics--path
+ (error "No track data available."))
+ (find-file-other-window jao-emms-lyrics--path))
+
+
+
+(defconst jao-emms--wiki-fmt
+ (concat"http://lyrics.wikia.com/api.php?action=lyrics&fmt=xml&func=getSong"
+ "&artist=%s&song=%s"))
+
+(defun jao-emms-show-lyrics/wiki ()
+ (interactive)
+ (let* ((a/t (jao-emms-lyrics-track-data))
+ (artist (car a/t))
+ (title (cdr a/t))
+ (buffer (jao-emms-lyrics-buffer))
+ (url (format jao-emms--wiki-fmt
+ (url-hexify-string artist)
+ (url-hexify-string title)))
+ (url-request-method "GET")
+ (data-buffer (url-retrieve-synchronously url))
+ (inhibit-read-only t))
+ (set-buffer data-buffer)
+ ;; (unless (re-search-forward "<pre>" nil t)
+ ;; (error "Lyrics not found"))
+ (let ((begin (point)))
+ ;; (unless (re-search-forward "</pre>" nil t)
+ ;; (error "Lyrics not found"))
+ (copy-to-buffer buffer begin (match-beginning 0)))
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (insert (format "♪ %s - %s\n" artist title)))
+ (pop-to-buffer buffer)))
+
+(defvar jao-emms-show-lyrics/script
+ (expand-file-name "lyricwiki.rb" (file-name-directory load-file-name)))
+
+(defun jao-emms-lyrics--download (artist title)
+ (message "Retrieving lyrics...")
+ (prog1
+ (shell-command-to-string (format "%s \"%s\" \"%s\""
+ jao-emms-show-lyrics/script
+ artist title))
+ (message nil)))
+
+(defun jao-emms-show-lyrics (&optional force)
+ (interactive "P")
+ (let* ((a/t (jao-emms-lyrics-track-data))
+ (artist (or (car a/t) ""))
+ (title (or (cdr a/t) ""))
+ (buffer (jao-emms-lyrics-buffer))
+ (cached (and (not force) (jao-emms-lyrics--get-cached artist title)))
+ (cached (and (not (zerop (length cached))) cached))
+ (lyrics (or cached (jao-emms-lyrics--download artist title)))
+ (inhibit-read-only t))
+ (with-current-buffer buffer
+ (delete-region (point-min) (point-max))
+ (insert (format "♪ %s - %s\n\n"
+ (propertize artist 'face jao-emms-font-lock-artist)
+ (propertize title 'face jao-emms-font-lock-title)))
+ (when lyrics
+ (insert lyrics)
+ (goto-char (point-min))
+ (when (not cached)
+ (save-excursion
+ (while (search-forward " " nil t)
+ (replace-match "" nil t)))))
+ (when (and lyrics (not cached))
+ (jao-emms-lyrics--cache artist title lyrics))
+ (setq jao-emms-lyrics--path (jao-emms-lyrics--filename artist title)))
+ (pop-to-buffer buffer)))
+
+(defun jao-emms-show-lyrics-force ()
+ (interactive)
+ (jao-emms-show-lyrics t))
+
+
+(provide 'jao-emms-lyrics)
+;;; jao-emms-lyrics.el ends here
diff --git a/emms/jao-emms-random-album.el b/emms/jao-emms-random-album.el
new file mode 100644
index 0000000..04dcd89
--- /dev/null
+++ b/emms/jao-emms-random-album.el
@@ -0,0 +1,113 @@
+;; jao-emms-random-album.el -- play random albums in emms
+
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Sat Jul 04, 2009 13:06
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(require 'emms)
+
+(defvar jao-emms-random-album-p t)
+(defvar jao-emms-random-lines nil)
+(defvar jao-emms-random-lines-file
+ (expand-file-name "~/.emacs.d/random-lines"))
+
+(defun jao-emms-random-lines ()
+ (or jao-emms-random-lines
+ (and (file-exists-p jao-emms-random-lines-file)
+ (with-current-buffer
+ (find-file-noselect jao-emms-random-lines-file)
+ (goto-char (point-min))
+ (setq jao-emms-random-lines (read (current-buffer)))))
+ (dotimes (n (1- (line-number-at-pos (point-max)))
+ jao-emms-random-lines)
+ (push (1+ n) jao-emms-random-lines))))
+
+(defun jao-emms-random-lines-save ()
+ (with-current-buffer (find-file-noselect jao-emms-random-lines-file)
+ (delete-region (point-min) (point-max))
+ (insert (format "%s\n" jao-emms-random-lines))
+ (save-buffer)))
+
+(defun jao-emms-goto-random-album ()
+ (let* ((pos (random (length (jao-emms-random-lines))))
+ (line (nth pos jao-emms-random-lines)))
+ (setq jao-emms-random-lines (remove line jao-emms-random-lines))
+ (jao-emms-random-lines-save)
+ (goto-line line)))
+
+(defun jao-emms-next-noerror ()
+ (interactive)
+ (when emms-player-playing-p
+ (error "A track is already being played"))
+ (cond (emms-repeat-track
+ (emms-start))
+ ((condition-case nil
+ (progn
+ (emms-playlist-current-select-next)
+ t)
+ (error nil))
+ (emms-start))
+ (t
+ (if jao-emms-random-album-p
+ (jao-emms-random-album-next)
+ (message "No next track in playlist")))))
+
+
+;; User interface
+(defun jao-emms-random-album-start ()
+ (interactive)
+ (setq jao-emms-random-album-p t)
+ (jao-emms-random-album-next))
+
+(defun jao-emms-random-album-stop ()
+ (interactive)
+ (setq jao-emms-random-album-p nil)
+ (emms-stop))
+
+(defun jao-emms-random-album-toggle ()
+ (interactive)
+ (setq jao-emms-random-album-p (not jao-emms-random-album-p))
+ (message "Random album %s"
+ (if jao-emms-random-album-p "enabled" "disabled")))
+
+(defun jao-emms-random-album-next ()
+ (interactive)
+ (let ((buffer (emms-browser-get-buffer)))
+ (save-excursion
+ (if buffer (set-buffer buffer) (emms-browser))
+ (ignore-errors (emms-browser-clear-playlist))
+ (emms-browse-by-album)
+ (jao-emms-goto-random-album)
+ (emms-browser-add-tracks-and-play)
+ (jao-osd-cat 'emms
+ (format "Next album %s"
+ (substring-no-properties (thing-at-point 'line)
+ 0 -1)))
+ (emms-browser-bury-buffer))))
+
+(defun jao-emms-random-album-reset ()
+ (interactive)
+ (setq jao-emms-random-lines nil)
+ (jao-emms-random-lines-save))
+
+(defun jao-emms-random-album-setup ()
+ (setq emms-player-next-function 'jao-emms-next-noerror))
+
+
+(provide 'jao-emms-random-album)
+;;; jao-emms-random-album.el ends here
diff --git a/emms/jao-emms.el b/emms/jao-emms.el
new file mode 100644
index 0000000..53b3513
--- /dev/null
+++ b/emms/jao-emms.el
@@ -0,0 +1,27 @@
+;; jao-emms.el -- shared bits
+
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Sat Jul 04, 2009 13:51
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(defgroup jao-emms nil "Emms extensions" :group 'emms)
+
+
+(provide 'jao-emms)
+;;; jao-emms.el ends here
diff --git a/emms/leoslyrics.py b/emms/leoslyrics.py
new file mode 100755
index 0000000..5e4f8c8
--- /dev/null
+++ b/emms/leoslyrics.py
@@ -0,0 +1,84 @@
+#!/usr/bin/python
+#
+# (c) 2004-2008 The Music Player Daemon Project
+# http://www.musicpd.org/
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+
+#
+# Load lyrics from leoslyrics.com
+#
+
+from sys import argv, exit
+from urllib import urlencode, urlopen
+from xml.sax import make_parser, SAXException
+from xml.sax.handler import ContentHandler
+
+class SearchContentHandler(ContentHandler):
+ def __init__(self):
+ self.code = None
+ self.hid = None
+
+ def startElement(self, name, attrs):
+ if name == 'response':
+ self.code = int(attrs['code'])
+ elif name == 'result':
+ if self.hid is None or attrs['exactMatch'] == 'true':
+ self.hid = attrs['hid']
+
+def search(artist, title):
+ query = urlencode({'auth': 'ncmpc',
+ 'artist': artist,
+ 'songtitle': title})
+ url = "http://api.leoslyrics.com/api_search.php?" + query
+ f = urlopen(url)
+ handler = SearchContentHandler()
+ parser = make_parser()
+ parser.setContentHandler(handler)
+ parser.parse(f)
+ return handler.hid
+
+class LyricsContentHandler(ContentHandler):
+ def __init__(self):
+ self.code = None
+ self.is_text = False
+ self.text = None
+
+ def startElement(self, name, attrs):
+ if name == 'text':
+ self.text = ''
+ self.is_text = True
+ else:
+ self.is_text = False
+
+ def characters(self, chars):
+ if self.is_text:
+ self.text += chars
+
+def lyrics(hid):
+ query = urlencode({'auth': 'ncmpc',
+ 'hid': hid})
+ url = "http://api.leoslyrics.com/api_lyrics.php?" + query
+ f = urlopen(url)
+ handler = LyricsContentHandler()
+ parser = make_parser()
+ parser.setContentHandler(handler)
+ parser.parse(f)
+ return handler.text
+
+hid = search(argv[1], argv[2])
+if hid is None:
+ exit(2)
+print lyrics(hid).encode('utf-8')
diff --git a/emms/lyricwiki.rb b/emms/lyricwiki.rb
new file mode 100755
index 0000000..db7b970
--- /dev/null
+++ b/emms/lyricwiki.rb
@@ -0,0 +1,51 @@
+#!/usr/bin/env ruby
+#
+# (c) 2004-2008 The Music Player Daemon Project
+# http://www.musicpd.org/
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+
+#
+# Load lyrics from lyrics.wikia.com, formerly lyricwiki.org
+#
+
+require 'uri'
+require 'net/http'
+require 'cgi'
+
+url = "http://lyrics.wikia.com/api.php?action=lyrics&fmt=xml&func=getSong" + \
+ "&artist=#{URI.escape(ARGV[0])}&song=#{URI.escape(ARGV[1])}"
+response = Net::HTTP.get(URI.parse(url))
+
+if not response =~ /<url>\s*(.*?)\s*<\/url>/im
+ $stderr.puts "No URL in response!"
+ exit(1)
+end
+
+url = $1
+exit(69) if url =~ /action=edit$/
+
+response = Net::HTTP.get(URI.parse(url))
+if not response =~ /<div class='lyricbox'>\s*(.*?)\s*<!--/im
+ $stderr.puts "No <div class='lyricbox'> in lyrics page!\n"
+ exit(1)
+end
+
+if not $1 =~ /^.*<\/div>(.*?)$/im
+ $stderr.puts "Couldn't remove leading XML tags in lyricbox!\n"
+ exit(1)
+end
+
+puts CGI::unescapeHTML($1.gsub(/<br \/>/, "\n"))
diff --git a/net/jao-frm.el b/net/jao-frm.el
new file mode 100644
index 0000000..1635f00
--- /dev/null
+++ b/net/jao-frm.el
@@ -0,0 +1,214 @@
+;;; jao-frm.el --- use frm to show mailbox
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: mail
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Little hack to see the contents of your mailbox using GNU mailutils'
+;; `frm' program.
+;;
+;; Just put (require 'jao-frm) in your .emacs, and M-x jao-frm will pop up a
+;; new window with your mailbox contents (from and subject) as
+;; printed by frm. In this buffer, use `n' and `p' to move, `q' to close
+;; the window. `g' will call Gnus.
+;;
+
+;;; Code:
+
+;;;; Customisation:
+
+(defgroup jao-frm nil
+ "Frm-base mailbox checker"
+ :prefix "jao-frm-")
+
+(defcustom jao-frm-exec-path "frm"
+ "frm executable path"
+ :group 'jao-frm
+ :type 'file)
+
+(defcustom jao-frm-mail-command 'gnus
+ "Emacs function to invoke when `g' is pressed on an frm buffer."
+ :group 'jao-frm
+ :type 'symbol)
+
+(defcustom jao-frm-mailboxes nil
+ "List of mailboxes to check, or directory containing them."
+ :group 'jao-frm
+ :type '(choice directory (repeat file)))
+
+(defface jao-frm-mailno-face '((t (:foreground "dark slate grey")))
+ "Face for the mail number."
+ :group 'jao-frm)
+
+(defface jao-frm-from-face '((t (:foreground "slate grey")))
+ "Face for From: header."
+ :group 'jao-frm)
+
+(defface jao-frm-subject-face '((t (:foreground "slate blue")))
+ "Face for Subject: header."
+ :group 'jao-frm)
+
+(defface jao-frm-mailbox-face '((t (:bold t :weight bold)))
+ "Face for mailbox name."
+ :group 'jao-frm)
+
+;;;; Mode:
+
+(defvar jao-frm-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (define-key map [?q] 'jao-frm-delete-window)
+ (define-key map [?n] 'next-line)
+ (define-key map [?p] 'previous-line)
+ (define-key map [?g] jao-frm-mail-command)
+ (define-key map [(control k)] 'jao-frm-delete-message)
+ map))
+
+(setq jao-frm-font-lock-keywords
+ '(("^[^ :]+:" . 'jao-frm-mailbox-face)
+ ("^\\([ 0-9]+\\):\t+\\([^\t]+\\)\t+\\([^\n]+$\\)"
+ (1 'jao-frm-mailno-face)
+ (2 'jao-frm-from-face)
+ (3 'jao-frm-subject-face))))
+
+(defvar jao-frm-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ st))
+
+(defun jao-frm-mode ()
+ "Major mode for displaying frm output."
+ (interactive)
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (use-local-map jao-frm-mode-map)
+ (set (make-local-variable 'font-lock-defaults)
+ '(jao-frm-font-lock-keywords))
+ (set (make-local-variable 'truncate-lines) t)
+ (set (make-local-variable 'kill-whole-line) t)
+ (set (make-local-variable 'next-line-add-newlines) nil)
+ (setq major-mode 'jao-frm-mode)
+ (setq mode-name "frm")
+ (toggle-read-only 1)
+ (goto-char 1))
+
+;;;; Mode commands:
+(defvar jao-frm-last-config nil)
+
+(defun jao-frm-delete-window ()
+ "Delete frm window and restore last win config"
+ (interactive)
+ (if (and (consp jao-frm-last-config)
+ (window-configuration-p (car jao-frm-last-config)))
+ (progn
+ (set-window-configuration (car jao-frm-last-config))
+ (goto-char (cadr jao-frm-last-config))
+ (setq jao-frm-last-config nil))
+ (bury-buffer)))
+
+(defun jao-frm-delete-message ()
+ "Delete message at point"
+ (interactive)
+ (when (eq (current-buffer) (get-buffer "*frm*"))
+ (beginning-of-line)
+ (when (search-forward-regexp "^ +\\([0-9]+\\):" nil t)
+ (let ((mn (string-to-number (match-string 1))))
+ (when (y-or-n-p (format "Delete message number %d? " mn))
+ (toggle-read-only -1)
+ (shell-command (format "echo 'd %d'|mail" mn) t)
+ (jao-frm)
+ (when (= (point-max) (point-min))
+ (jao-frm-delete-window)
+ (message "Mailbox is empty")))))))
+
+;;;; Activate frm:
+(defun jao-frm-mbox-mails (mbox)
+ (let ((no (ignore-errors
+ (substring
+ (shell-command-to-string (format "frm %s|wc -l" mbox)) 0 -1))))
+ (if (stringp no) (string-to-number no) 0)))
+
+(defun jao-frm-mail-number ()
+ (let ((no 0))
+ (dolist (b (jao-frm-mboxes) no) (setq no (+ no (jao-frm-mbox-mails b))))))
+
+(defun jao-frm-default-count-formatter (m n)
+ (format "%s: %s" (file-name-sans-extension (file-name-nondirectory m)) n))
+
+(defun jao-frm-mail-counts (fmt)
+ (let ((fmt (or fmt 'jao-frm-default-count-formatter)))
+ (remove nil
+ (mapcar (lambda (m)
+ (let ((n (jao-frm-mbox-mails m)))
+ (unless (zerop n) (funcall fmt m n))))
+ (jao-frm-mboxes)))))
+
+(defun jao-frm-display-mailbox (mbox)
+ (when (not (zerop (jao-frm-mbox-mails mbox)))
+ (insert (or (file-name-nondirectory mbox) mbox) ":\n\n")
+ (apply 'call-process
+ `(,jao-frm-exec-path nil ,(current-buffer) nil
+ "-n" "-t" ,@(and mbox (list mbox))))
+ (newline 2)))
+
+(defun jao-frm-mboxes ()
+ (cond ((null jao-frm-mailboxes) (list (getenv "MAIL")))
+ ((listp jao-frm-mailboxes) jao-frm-mailboxes)
+ ((stringp jao-frm-mailboxes)
+ (if (file-directory-p jao-frm-mailboxes)
+ (directory-files jao-frm-mailboxes t "^[^.]")
+ (list jao-frm-mailboxes)))
+ (t (error "Error in mbox specification. Check `jao-frm-mailboxes'"))))
+
+(defun jao-frm ()
+ "Run frm."
+ (interactive)
+ (let ((fbuff (get-buffer-create "*frm*"))
+ (inhibit-read-only t))
+ (if (not (eq fbuff (current-buffer)))
+ (setq jao-frm-last-config
+ (list (current-window-configuration) (point-marker))))
+ (with-current-buffer fbuff
+ (delete-region (point-min) (point-max))
+ (mapc 'jao-frm-display-mailbox (jao-frm-mboxes))
+ (unless (eq major-mode 'jao-frm-mode)
+ (jao-frm-mode))
+ (goto-char (point-min))
+ (if (= (point-min) (point-max))
+ (message "Mailbox is empty.")
+ (pop-to-buffer fbuff))
+ (when (and (boundp 'display-time-mode) display-time-mode)
+ (display-time-update)))))
+
+(defun jao-frm-show-mail-numbers ()
+ (interactive)
+ (let ((counts (jao-frm-mail-counts nil)))
+ (message (if counts (mapconcat 'identity counts ", ") "No mail"))))
+
+(defun jao-frm-mail-string ()
+ (let ((counts (jao-frm-mail-counts
+ (lambda (m n)
+ (let ((m (substring (file-name-nondirectory m) 0 1)))
+ (format "%s %s" m n))))))
+ (mapconcat 'identity counts " ")))
+
+(provide 'jao-frm)
+
+;;; jao-frm.el ends here
diff --git a/net/jao-w3m-session.el b/net/jao-w3m-session.el
new file mode 100644
index 0000000..7b8979b
--- /dev/null
+++ b/net/jao-w3m-session.el
@@ -0,0 +1,410 @@
+;;; w3m-session.el --- Persistent emacs-w3m sessions
+
+;; Copyright (C) 2003, 2004, 2006, 2007, 2008, 2009 Jose A Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@member.fsf.org>
+;; Version: 0.3.6
+;; Keywords: hypermedia, w3m, WWW
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; INTRODUCTION:
+;;
+;; jao-w3m-session provides persistent emacs-w3m browsing sessions. When
+;; quitting w3m (or, if you request it, at any other time while using
+;; it) you can save the current w3m session (that is, the set of open
+;; tabs and the URLs they're visiting). Upon restarting emacs-w3m
+;; (possibly after restarting Emacs itself) you'll have the possibity
+;; of recovering the saved session (that is, of re-opening the saved
+;; tabs and URLs). You also have at your disposal a command to recover
+;; the saved session at any other time.
+;;
+;; INSTALLATION:
+;;
+;; Just put this file somewhere on your Emacs load path and add the
+;; following line to your .emacs file:
+;;
+;; (require 'jao-w3m-session)
+;;
+;; After restarting Emacs (or evaluating the form above), each time
+;; you start emacs-w3m with 'w3m' you'll get a prompt asking whether
+;; your last browsing session should be loaded. Likewise, when
+;; quitting the browser, you'll have the possibility of saving your
+;; current session (overwriting the previous one).
+;;
+;; In addition, two new interactive functions are defined:
+;;
+;; jao-w3m-session-load -- load the last stored session
+;; jao-w3m-session-save -- save the current session
+;;
+;; These functions can be invoked at any time while running emacs-w3m.
+;; Optionally, you can bind them to key shortcuts with the proper
+;; variations of the following elisp magic in your .emacs:
+;; (defun w3m-add-keys ()
+;; (define-key w3m-mode-map "S" 'jao-w3m-session-save)
+;; (define-key w3m-mode-map "L" 'jao-w3m-session-load))
+;; (add-hook 'w3m-mode-hook 'w3m-add-keys)
+;;
+;; CUSTOMIZATION:
+;;
+;; A new customization group, jao-w3m-session, is available. There you can
+;; customize the following variables:
+;;
+;; jao-w3m-session-load-always -- if t, `jao-w3m-session-load' will *not* ask
+;; for confirmation (default nil)
+;; jao-w3m-session-save-always -- if t, `jao-w3m-session-save' will *not* ask
+;; for confirmation (default nil)
+;; jao-w3m-session-show-titles -- if t, the load prompt will list the
+;; session URL titles (default t)
+;; jao-w3m-session-duplicate-tabs -- what to do when loading a session that
+;; contains a URL already open
+;; jao-w3m-session-file -- the file where w3m session info
+;; is stored (default "~/.jao-w3m-session")
+;; jao-w3m-session-autosave-period -- the period, in seconds, for automatic
+;; session backup file updating.
+;;
+;;
+;; You can also customize them in your .emacs file, to wit:
+;;
+;; (setq jao-w3m-session-file "~/.emacs.d/jao-w3m-session")
+;; (setq jao-w3m-session-save-always nil)
+;; (setq jao-w3m-session-load-always nil)
+;; (setq jao-w3m-session-show-titles t)
+;; (setq jao-w3m-session-duplicate-tabs 'ask) ; 'never, 'always, 'ask
+;;
+;; HISTORY:
+;;
+;; Version 0.3.7 :
+;;
+;; - `jao-w3m-session-deactivate-builtin-sessions', to do what it
+;; says.
+;;
+;; Version 0.3.6 (Sat Apr 19, 2008):
+;;
+;; - w3m-session -> jao-w3m-session to avoid collisions with
+;; emacs-w3m's session manager.
+;;
+;; Version 0.3.5 (Sun Jan 14, 2007):
+;;
+;; - automatic session backup every `jao-w3m-session-autosave-period'
+;; seconds.
+;;
+;; Version 0.3.4 (Wed Jul 19, 2006):
+;;
+;; - save session file on quitting Emacs (without using
+;; desktop.el)
+;;
+;; Version 0.3.3 (Thu Jun 8, 2006):
+;;
+;; - save session file with pretty print.
+;; - handle correctly multiple emacs-w3m (re)starts during a
+;; single emacs session.
+;; - save URLs in hexified form to allow & in them.
+;; - code cleanup.
+;;
+;; Version 0.3.2 (Mon Sep 29, 2003):
+;;
+;; - bug fix: when searching or going to home/bookmarks/etc,
+;; keep the current tab's focus.
+;;
+;; Version 0.3.1 (Tue Aug 26, 2003):
+;;
+;; - type of `jao-w3m-session-file' set to 'file' in customisation
+;; buffer.
+;; - bug fix: syntax error due to a typo in `jao-w3m-session-file'
+;;
+;; Version 0.3 (Mon Aug 25, 2003):
+;;
+;; - the load session tab lists the titles of the session's pages
+;; (customizable via 'jao-w3m-session-show-titles').
+;; - the duplicated tab prompt displays also the URL's title.
+;; - bug fix: active tab in session now is correctly saved.
+;;
+;; Version 0.2 (Fri Aug 22, 2003):
+;;
+;; - the session info now includes the active tab, which gets
+;; displayed when the session is reloaded.
+;; - when reloading a session in a running emacs-w3m, if the
+;; session contains a URL that is already being displayed by the
+;; browser, the tab can be reused or duplicated (customizable
+;; via `jao-w3m-session-duplicate-tabs').
+;;
+;; Version 0.1 (Wed Aug 20, 2003) -- Initial release.
+;;
+
+
+;;; Code:
+
+;;; Dependencies:
+
+(require 'w3m)
+(require 'advice)
+(require 'url-util)
+
+;;; Custom variables:
+
+(defgroup jao-w3m-session nil
+ "w3m - session saving in w3m."
+ :group 'w3m
+ :prefix "jao-w3m-session-")
+
+(defcustom jao-w3m-session-save-always nil
+ "If on, always save w3m session without asking."
+ :group 'jao-w3m-session
+ :type 'boolean)
+
+(defcustom jao-w3m-session-load-always nil
+ "If on, always load w3m session without asking."
+ :group 'jao-w3m-session
+ :type 'boolean)
+
+(defcustom jao-w3m-session-show-titles t
+ "If on, show URL titles in the load prompt."
+ :group 'jao-w3m-session
+ :type 'boolean)
+
+(defcustom jao-w3m-session-duplicate-tabs 'never
+ "How to treat session URL already being visited.
+
+When loading a session with `jao-w3m-session-load', if one of the URLs in
+the session is already displayed in a w3m tab, jao-w3m-session can:
+- `never' create a new tab (just reload it), or
+- `always' duplicate the URL in a new tab, or
+- `ask' the user what to do."
+ :group 'jao-w3m-session
+ :type '(choice (const :value never)
+ (const :value always)
+ (const :value ask)))
+
+(defcustom jao-w3m-session-file "~/.jao-w3m-session"
+ "File to save the w3m session data."
+ :group 'jao-w3m-session
+ :type 'file)
+
+(defvar jao-w3m-session-autosave-period 180
+ "A backup of the current session is saved with this period (in secs).")
+
+(defvar jao-w3m-url-filters nil "URL filters.")
+
+;;; Interactive functions:
+
+(defun jao-w3m-session-save ()
+ "Save the current w3m session."
+ (interactive)
+ (when (and (w3m-alive-p)
+ (or jao-w3m-session-save-always
+ (y-or-n-p "Save current w3m session? ")))
+ (jao-w3m-session-current-to-file)
+ (jao-w3m-session--restart--autosave)))
+
+(defun jao-w3m-session-load ()
+ "Load last stored session into w3m."
+ (interactive)
+ (let ((s (jao-w3m-session-load-aux)))
+ (when s
+ (jao-w3m-session--restart--autosave)
+ (let* ((urls (jao-w3m-session-url s))
+ (offset (jao-w3m-session-offset s))
+ (buffers (unless (equal jao-w3m-session-duplicate-tabs 'always)
+ (jao-w3m-session-find-duplicated urls))))
+ (w3m-goto-url-new-session urls t)
+ (when buffers (jao-w3m-session-close-buffers buffers))
+ (unless (zerop offset) (w3m-next-buffer offset))))))
+
+(defun jao-w3m-session-set-autosave-period (secs)
+ "Set new value for the period between session backup autosaves."
+ (interactive "p")
+ (let ((secs (or secs (read-number "New period (secs): " 0))))
+ (when (> secs 0)
+ (setq jao-w3m-session-autosave-period secs)
+ (jao-w3m-session--restart--autosave))))
+
+(defun jao-w3m-session-deactivate-builtin-sessions ()
+ "Deactivate emacs-w3m's builtin session handling."
+ (setq w3m-session-deleted-save nil
+ w3m-session-autosave nil
+ w3m-session-deleted-keep-number 0
+ w3m-session-crash-recovery nil))
+
+;;; Internals:
+
+;;;; advice w3m to use session management
+
+(defadvice w3m (before jao-load-session activate)
+ "Optionally load last w3m session on startup."
+ (interactive
+ (let ((s (jao-w3m-session-load-aux)))
+ (list (or (and s (jao-w3m-session-url s)) w3m-home-page) t t))))
+
+(defadvice w3m (after jao-select-tab activate)
+ "Goto the saved focused tab"
+ (interactive)
+ (let ((offset (jao-w3m-session-offset)))
+ (unless (zerop offset)
+ (w3m-next-buffer offset))
+ (ad-deactivate 'w3m)))
+
+(defadvice w3m-quit (before jao-save-session activate)
+ "Save session before quitting."
+ (interactive)
+ (jao-w3m-session-save)
+ ;; this is a little hack: when quitting a w3m session with a tab
+ ;; selected other than the first, the frame is not automatically
+ ;; closed as should be when w3m-pop-up-frames is t:
+ (switch-to-buffer (car (w3m-list-buffers)))
+ (ad-activate 'w3m))
+
+;;;; save session on exit
+(add-to-list 'kill-emacs-query-functions
+ '(lambda () (jao-w3m-session-save) t))
+
+
+;;;; auxiliary functions
+
+(defvar jao-w3m-current-session '(jao-w3m-session 0 nil))
+
+(defun jao-w3m-session--filter (url filters)
+ (cond ((not filters) url)
+ ((string-match-p (caar filters) url)
+ (cond ((functionp (cdar filters)) (funcall (cadr filters) url))
+ ((stringp (cdar filters)) (cdar filters))))
+ (t (jao-w3m-session--filter url (cdr filters)))))
+
+(defun jao-w3m-session--current-urls ()
+ (let ((urls)
+ (current-buffer (w3m-alive-p))
+ (pos 0)
+ (count 0))
+ (dolist (b (w3m-list-buffers) (list pos (reverse urls)))
+ (set-buffer b)
+ (let ((url (jao-w3m-session--filter w3m-current-url jao-w3m-url-filters)))
+ (when url
+ (when (eq b current-buffer) (setq pos count))
+ (setq count (1+ count))
+ (push (cons (url-hexify-string url) (w3m-buffer-title b)) urls))))))
+
+(defun jao-w3m-session-url (&optional s)
+ (let ((s (or s jao-w3m-current-session)))
+ (concat "group:"
+ (mapconcat 'car (nth 2 s) "&"))))
+
+(defun jao-w3m-session-offset (&optional s)
+ (let ((s (or s jao-w3m-current-session)))
+ (nth 1 s)))
+
+(defun jao-w3m-session-titles (&optional s)
+ (let ((s (or s jao-w3m-current-session)))
+ (mapcar 'cdr (nth 2 s))))
+
+(defun jao-w3m-session-current (&optional s)
+ (save-current-buffer
+ (setq jao-w3m-current-session
+ (or s (cons 'jao-w3m-session (jao-w3m-session--current-urls))))))
+
+(defun jao-w3m-session-current-url ()
+ (when (w3m-alive-p)
+ (save-current-buffer
+ (concat "group:"
+ (mapconcat (lambda (b) (set-buffer b) w3m-current-url)
+ (w3m-list-buffers) "&")))))
+
+(defun jao-w3m-session-find-duplicated (urls)
+ (when (w3m-alive-p)
+ (save-current-buffer
+ (let* ((duplicate-p
+ (lambda (b)
+ (y-or-n-p
+ (format "'%s' (%s) is already open. Duplicate tab? "
+ (w3m-buffer-title b) w3m-current-url))))
+ (test-b
+ (lambda (b)
+ (set-buffer b)
+ (if (and
+ (string-match (regexp-quote w3m-current-url) urls)
+ (or (equal jao-w3m-session-duplicate-tabs 'never)
+ (not (funcall duplicate-p b))))
+ b 'not)))
+ (buffers (mapcar test-b (w3m-list-buffers))))
+ (delete 'not buffers)))))
+
+(defun jao-w3m-session-close-buffers (buffers)
+ (save-current-buffer
+ (mapc 'kill-buffer buffers)))
+
+(defun jao-w3m-session-load-aux ()
+ (let ((new-session (jao-w3m-session-from-file
+ (expand-file-name jao-w3m-session-file))))
+ (if (and new-session
+ (or jao-w3m-session-load-always
+ (y-or-n-p
+ (if jao-w3m-session-show-titles
+ (format "Load last w3m session %S? "
+ (jao-w3m-session-titles new-session))
+ "Load last w3m session? "))))
+ (jao-w3m-session-current new-session)
+ nil)))
+
+(defun jao-w3m-session-from-file (fname)
+ (let ((fname (jao-w3m-session--check--backup fname)))
+ (if (file-readable-p fname)
+ (with-temp-buffer
+ (insert-file-contents fname)
+ (goto-char (point-min))
+ (let ((sexp (read (current-buffer))))
+ (and (equal 'jao-w3m-session (car sexp)) sexp)))
+ nil)))
+
+(defsubst jao-w3m-session-current-to-file ()
+ (jao-w3m-session--to--file jao-w3m-session-file))
+
+(defun jao-w3m-session--to--file (filename &optional is-auto)
+ (require 'pp)
+ (let ((msg (if is-auto (current-message))))
+ (with-temp-buffer
+ (insert ";;;; File generated by jao-w3m-session. DO NOT EDIT!\n")
+ (pp (jao-w3m-session-current) (current-buffer))
+ (insert "\n" ";;;; End of "
+ (file-name-nondirectory jao-w3m-session-file) "\n")
+ (write-region (point-min) (point-max) (expand-file-name filename)))
+ (if is-auto (message msg))))
+
+(defvar jao-w3m-session--timer nil)
+
+(defun jao-w3m-session--backup-name (fname)
+ (concat (expand-file-name fname) ".bak"))
+
+(defun jao-w3m-session--check--backup (fname)
+ (let ((bfname (jao-w3m-session--backup-name fname)))
+ (if (and (file-newer-than-file-p bfname fname)
+ (y-or-n-p "A newer autosaved session exists. Use it? "))
+ bfname
+ fname)))
+
+(defun jao-w3m-session--restart--autosave ()
+ (when (> jao-w3m-session-autosave-period 0)
+ (if jao-w3m-session--timer (cancel-timer jao-w3m-session--timer))
+ (setq jao-w3m-session--timer
+ (run-at-time jao-w3m-session-autosave-period
+ jao-w3m-session-autosave-period
+ 'jao-w3m-session--to--file
+ (jao-w3m-session--backup-name jao-w3m-session-file)
+ t))))
+
+(provide 'jao-w3m-session)
+
+;;; jao-w3m-session.el ends here
diff --git a/net/jao-weather.el b/net/jao-weather.el
new file mode 100644
index 0000000..6760eb1
--- /dev/null
+++ b/net/jao-weather.el
@@ -0,0 +1,219 @@
+;; Based on code by Thierry Volpiatto
+;; (http://mercurial.intuxication.org/hg/xml-weather)
+
+(require 'xml)
+(require 'derived)
+
+
+;;; config:
+(defvar jao-weather-format-id-url
+ "http://xoap.weather.com/search/search?where=%s")
+
+(defvar jao-weather-format-xml-from-id-url ; id, unit=m,day-forecast=5,login,key
+ "http://xoap.weather.com/weather/local/%s?cc=*&unit=%s&dayf=%s&prod=xoap&par=%s&key=%s")
+
+(defvar jao-weather-unit "m"
+ "*m mean metric, you will have wind speed in km/h, temperature in °C and so on.")
+
+(defvar jao-weather-login nil)
+(defvar jao-weather-key nil)
+
+(defvar jao-weather-day-forecast-num 5
+ "*Number of days for forecast; Maximum 5.")
+
+(defvar jao-weather-default-id "SPXX0015")
+
+(defvar jao-weather-timer-delay 3600)
+
+(defvar jao-weather-last-data nil)
+
+
+;;; access:
+(defun jao-weather-authentify ()
+ "Authentify user from .authinfo file.
+You have to setup correctly `auth-sources' to make this function
+finding the path of your .authinfo file that is normally ~/.authinfo.
+Entry in .authinfo should be:
+machine xoap.weather.com port http login xxxxx password xxxxxx"
+ (let ((auth (auth-source-user-or-password '("login" "password")
+ "xoap.weather.com"
+ "http")))
+ (setq jao-weather-login (car auth)
+ jao-weather-key (cadr auth))))
+
+(defun jao-weather--url (id)
+ (unless (and jao-weather-login jao-weather-key)
+ (jao-weather-authentify))
+ (format jao-weather-format-xml-from-id-url
+ (or id jao-weather-default-id)
+ jao-weather-unit
+ (min jao-weather-day-forecast-num 5)
+ jao-weather-login
+ jao-weather-key))
+
+(defvar jao-weather-hook nil)
+
+;; http://xoap.weather.com/weather/local/[locid]
+;; Replace the [locid], of course, with the location ID obtained in the previous step.
+;; Appended to this URL is a mix of other parameters,
+;; some required and some optional. A typical example might be:
+;; http://xoap.weather.com/weather/local/NLXX0002?cc=*&dayf=5&prod=xoap&par=[partner id]&key=[license key]
+(defun jao-weather--get-info-async (&optional id)
+ (let ((url (jao-weather--url id))
+ (url-show-status nil))
+ (url-retrieve url (lambda (res)
+ (when (not res)
+ (let ((data (jao-weather-get-alist)))
+ (when data
+ (setq jao-weather-last-data data)
+ (run-hooks 'jao-weather-hook))))
+ (kill-buffer (current-buffer))))))
+
+(defun jao-weather--get-info-now (&optional id)
+ (let* ((url (jao-weather--url id))
+ (buffer (url-retrieve-synchronously url))
+ (data (and buffer
+ (with-current-buffer buffer
+ (jao-weather-get-alist)))))
+ (when buffer (kill-buffer buffer))
+ (when data
+ (setq jao-weather-last-data data)
+ (run-hooks 'jao-weather-hook))
+ data))
+
+
+;;; formatting:
+(defun jao-weather--flist (c fs)
+ (when c
+ (let (result)
+ (dolist (f fs result)
+ (let ((v (caddr (assoc (cadr f) c))))
+ (when (and (stringp v) (not (string-equal v "N/A")))
+ (push (cons (car f) v) result)))))))
+
+(defun jao-weather--parse-cc (cc)
+ (append (jao-weather--flist cc '((:date lsup)
+ (:observatory obst)
+ (:temperature tmp)
+ (:condition t)
+ (:pressure r)))
+ (jao-weather--flist (assoc 'wind cc) '((:windir d)
+ (:wind-tilt t)
+ (:gust gust)))))
+
+(defun jao-weather--parse-location (loc)
+ (jao-weather--flist loc '((:city dnam)
+ (:time tm)
+ (:latitude lat)
+ (:longitude lon)
+ (:sunrise sunr)
+ (:sunset suns))))
+
+(defun jao-weather--parse-day (d)
+ (let ((p2 (assoc 'part
+ (remove (assoc 'part (cdr d))
+ (cdr d))))
+ (wday (or (cdr (assoc 't (cadr d))) "day")))
+ `(,(cdr (assoc 'dt (cadr d)))
+ (:weekday . ,wday)
+ (:weekday-abbrev . ,(substring wday 0 3))
+ ,@(jao-weather--flist (cdr d) '((:max hi)
+ (:min low)
+ (:sunrise sunr)
+ (:sunset suns)
+ (:humidity hmid)))
+ ,@(jao-weather--flist (assoc 'wind (assoc 'part (cdr d)))
+ '((:wind-dir 't) (:wind-speed 's)))
+ ,@(jao-weather--flist (assoc 'wind p2) '((:night-wind-dir wea)
+ (:night-wind-speed s)))
+ ,@(jao-weather--flist p2
+ '((:night-condition t) (:night-humidity hmid))))))
+
+(defun jao-weather-get-alist ()
+ (let* ((pxml (car (xml-parse-region (point-min) (point-max))))
+ (loc (car (xml-get-children pxml 'loc)))
+ (cc (car (xml-get-children pxml 'cc)))
+ (dayf (xml-get-children pxml 'dayf))
+ (dayfs (xml-get-children (car dayf) 'day))
+ (today (append (jao-weather--parse-cc cc)
+ (jao-weather--parse-location loc)))
+ (forecast (mapcar 'jao-weather--parse-day dayfs)))
+ `((today ,@today) (forecast ,@forecast))))
+
+(defun jao-weather--format-fields (data fields sep)
+ (if data
+ (mapconcat '(lambda (kv)
+ (let ((v (cdr (assoc (car kv) data))))
+ (if (not v) ""
+ (format (or (cdr kv) "%s") v))))
+ fields
+ sep)
+ ""))
+
+(defsubst jao-weather--today-string (fields sep)
+ (jao-weather--format-fields (cdr (assoc 'today jao-weather-last-data))
+ fields sep))
+
+(defun jao-weather--forecast-string (n fields sep)
+ (jao-weather--format-fields (nth n (cdr (assoc 'forecast
+ jao-weather-last-data)))
+ fields sep))
+
+
+;;; update daemon:
+(defvar jao-weather--timer nil)
+(defun jao-weather-start (&optional delay)
+ (interactive)
+ (jao-weather-stop)
+ (setq jao-weather--timer
+ (run-with-timer (or delay 0)
+ jao-weather-timer-delay
+ 'jao-weather--get-info-async)))
+
+(defun jao-weather-stop ()
+ (interactive)
+ (when jao-weather--timer
+ (cancel-timer jao-weather--timer)
+ (setq jao-weather--timer nil)))
+
+
+;;; today
+(defun jao-weather-today-msg (&optional arg)
+ (interactive "p")
+ (when (> arg 4) (jao-weather--get-info-now))
+ (if (= 4 arg) (jao-weather-forecast-msg)
+ (message "%s" (jao-weather--today-string '((:temperature . " %s°C")
+ (:condition . "(%s)")
+ (:sunrise . "↑ %s")
+ (:sunset . "↓ %s")
+ (:date . "[%s]"))
+ " "))))
+
+(defun jao-weather-forecast-msg (&optional arg)
+ (interactive "P")
+ (when arg (jao-weather--get-info-now))
+ (message " %s" (mapconcat
+ (lambda (n)
+ (jao-weather--forecast-string n
+ '((:weekday-abbrev . "%s ")
+ (:max . "%s°/")
+ (:min . "%s°")
+ (:condition . ", %s")
+ (:night-condition . ", %s"))
+ ""))
+ '(1 2 3 4) " | ")))
+
+(defun jao-weather-temperature ()
+ (string-to-number (jao-weather--today-string '((:temperature)) "")))
+
+
+(defun jao-weather-temperature* (&optional sep)
+ (concat (jao-weather--today-string '((:temperature . "%s°")) "")
+ (or sep " ")
+ (jao-weather--forecast-string 1
+ '((:max . "%s°/") (:min . "%s°")
+ (:night-condition . " %s"))
+ "")))
+
+;; Provide
+(provide 'jao-weather)
diff --git a/org/jao-org-gnus.el b/org/jao-org-gnus.el
new file mode 100644
index 0000000..8891e20
--- /dev/null
+++ b/org/jao-org-gnus.el
@@ -0,0 +1,72 @@
+;; Support for saving Gnus messages by Message-ID
+(defun mde-org-gnus-save-by-mid ()
+ (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
+ (when (eq major-mode 'gnus-article-mode)
+ (gnus-article-show-summary))
+ (let* ((group gnus-newsgroup-name)
+ (method (gnus-find-method-for-group group)))
+ (when (eq 'nnml (car method))
+ (let* ((article (gnus-summary-article-number))
+ (header (gnus-summary-article-header article))
+ (from (mail-header-from header))
+ (message-id
+ (save-match-data
+ (let ((mid (mail-header-id header)))
+ (if (string-match "<\\(.*\\)>" mid)
+ (match-string 1 mid)
+ (error "Malformed message ID header %s" mid)))))
+ (date (mail-header-date header))
+ (subject (gnus-summary-subject-string)))
+ (org-store-link-props :type "mid" :from from :subject subject
+ :message-id message-id :group group
+ :link (org-make-link "mid:" message-id))
+ (apply 'org-store-link-props
+ :description (org-email-link-description)
+ org-store-link-plist)
+ t)))))
+
+(defvar mde-mid-resolve-methods '()
+ "List of methods to try when resolving message ID's. For Gnus,
+it is a cons of 'gnus and the select (type and name).")
+(setq mde-mid-resolve-methods
+ '((gnus nnml "")))
+
+(defvar mde-org-gnus-open-level 1
+ "Level at which Gnus is started when opening a link")
+(defun mde-org-gnus-open-message-link (msgid)
+ "Open a message link with Gnus"
+ (require 'gnus)
+ (require 'org-table)
+ (catch 'method-found
+ (message "[MID linker] Resolving %s" msgid)
+ (dolist (method mde-mid-resolve-methods)
+ (cond
+ ((and (eq (car method) 'gnus)
+ (eq (cadr method) 'nnml))
+ (funcall (cdr (assq 'gnus org-link-frame-setup))
+ mde-org-gnus-open-level)
+ (when gnus-other-frame-object
+ (select-frame gnus-other-frame-object))
+ (let* ((msg-info (nnml-find-group-number
+ (concat "<" msgid ">")
+ (cdr method)))
+ (group (and msg-info (car msg-info)))
+ (message (and msg-info (cdr msg-info)))
+ (qname (and group
+ (if (gnus-methods-equal-p
+ (cdr method)
+ gnus-select-method)
+ group
+ (gnus-group-full-name group (cdr method))))))
+ (when msg-info
+ (gnus-summary-read-group qname nil t)
+ (gnus-summary-goto-article message nil t))
+ (throw 'method-found t)))
+ (t (error "Unknown link type"))))))
+
+(eval-after-load 'org-gnus
+ '(progn
+ (add-to-list 'org-store-link-functions 'mde-org-gnus-save-by-mid)
+ (org-add-link-type "mid" 'mde-org-gnus-open-message-link)))
+
+(provide 'jao-org-gnus)
diff --git a/org/jao-org-links.el b/org/jao-org-links.el
new file mode 100644
index 0000000..ca57f69
--- /dev/null
+++ b/org/jao-org-links.el
@@ -0,0 +1,29 @@
+(require 'org)
+
+;; doc links
+(defvar jao-org--sink-dir "./")
+(org-add-link-type "doc" 'jao-org-follow-doc 'identity)
+(defun jao-org-follow-doc (link)
+ (let ((dest-path (concat "./doc/"
+ (and (boundp 'docs-dir)
+ (concat (symbol-name docs-dir) "/"))
+ link)))
+ (when (not (file-exists-p dest-path))
+ (let* ((sink-file (expand-file-name link jao-org--sink-dir))
+ (real-file (if (file-exists-p sink-file) sink-file
+ (read-file-name "Import file: "
+ jao-org--sink-dir link link))))
+ (shell-command (format "mv %s %s" real-file dest-path))))
+ (browse-url (format "file://%s" (expand-file-name dest-path)))))
+
+(defsubst jao-org--title->file (title)
+ (concat (mapconcat 'downcase (split-string title nil t) "-") ".pdf"))
+
+(defun jao-org-insert-doc (title)
+ (interactive "sDocument title: ")
+ (insert (format "[[doc:%s][%s]]" (jao-org--title->file title) title)))
+
+(defun jao-org-links-setup (sink-dir)
+ (setq jao-org--sink-dir (file-name-as-directory sink-dir)))
+
+(provide 'jao-org-links) \ No newline at end of file
diff --git a/org/jao-org-popup.el b/org/jao-org-popup.el
new file mode 100644
index 0000000..eb5b24d
--- /dev/null
+++ b/org/jao-org-popup.el
@@ -0,0 +1,31 @@
+;;; frame popups
+;; http://metajack.im/2008/12/30/gtd-capture-with-emacs-orgmode/
+(defsubst jao-remember--frame-p ()
+ (equal "*Remember*" (frame-parameter nil 'name)))
+
+(defadvice remember-finalize (after delete-remember-frame activate)
+ "Advise remember-finalize to close the frame if it is the remember frame"
+ (when (jao-remember--frame-p) (delete-frame)))
+
+(defadvice remember-destroy (after delete-remember-frame activate)
+ "Advise remember-destroy to close the frame if it is the remember frame"
+ (when (jao-remember--frame-p) (delete-frame)))
+
+;; make the frame contain a single window. by default org-remember
+;; splits the window.
+(defun jao-remember--delete-other-windows ()
+ (when (jao-remember--frame-p) (delete-other-windows)))
+
+(add-hook 'remember-mode-hook 'jao-remember--delete-other-windows)
+
+(defun make-remember-frame ()
+ "Create a new frame and run org-remember"
+ (interactive)
+ (make-frame-on-display (getenv "DISPLAY")
+ '((name . "*Remember*")
+ (width . 80)
+ (height . 10)))
+ (select-frame-by-name "*Remember*")
+ (org-remember nil ?x))
+
+(provide 'jao-org-popup) \ No newline at end of file
diff --git a/org/jao-org-tags.el b/org/jao-org-tags.el
new file mode 100644
index 0000000..b00276d
--- /dev/null
+++ b/org/jao-org-tags.el
@@ -0,0 +1,61 @@
+;; lifted from http://orgmode.org/worg/org-hacks.php
+
+(require 'org)
+
+(defvar ba/org-adjust-tags-column nil)
+
+(defun ba/org-adjust-tags-column-reset-tags ()
+ "In org-mode buffers it will reset tag position according to
+`org-tags-column'."
+ (when (and
+ (not (string= (buffer-name) "*Remember*"))
+ (eql major-mode 'org-mode))
+ (let ((b-m-p (buffer-modified-p)))
+ (condition-case nil
+ (save-excursion
+ (goto-char (point-min))
+ (command-execute 'outline-next-visible-heading)
+ ;; disable (message) that org-set-tags generates
+ (flet ((message (&rest ignored) nil))
+ (org-set-tags 1 t))
+ (set-buffer-modified-p b-m-p))
+ (error nil)))))
+
+(defun ba/org-adjust-tags-column-now ()
+ "Right-adjust `org-tags-column' value, then reset tag position."
+ (set (make-local-variable 'org-tags-column)
+ (- (- (window-width) 3)))
+ (ba/org-adjust-tags-column-reset-tags))
+
+(defun ba/org-adjust-tags-column-maybe ()
+ "If `ba/org-adjust-tags-column' is set to non-nil, adjust tags."
+ (when ba/org-adjust-tags-column
+ (ba/org-adjust-tags-column-now)))
+
+(defun ba/org-adjust-tags-column-before-save ()
+ "Tags need to be left-adjusted when saving."
+ (when ba/org-adjust-tags-column
+ (setq org-tags-column 1)
+ (ba/org-adjust-tags-column-reset-tags)))
+
+(defun ba/org-adjust-tags-column-after-save ()
+ "Revert left-adjusted tag position done by before-save hook."
+ (ba/org-adjust-tags-column-maybe)
+ (set-buffer-modified-p nil))
+
+;; automatically align tags on right-hand side
+(defun jao-org-tags-setup ()
+ (setq ba/org-adjust-tags-column t)
+ (add-hook 'window-configuration-change-hook
+ 'ba/org-adjust-tags-column-maybe)
+ (add-hook 'before-save-hook 'ba/org-adjust-tags-column-before-save)
+ (add-hook 'after-save-hook 'ba/org-adjust-tags-column-after-save))
+
+(defun jao-org-tags-uninstall ()
+ (setq ba/org-adjust-tags-column nil)
+ (remove-hook 'window-configuration-change-hook
+ 'ba/org-adjust-tags-column-maybe)
+ (remove-hook 'before-save-hook 'ba/org-adjust-tags-column-before-save)
+ (remove-hook 'after-save-hook 'ba/org-adjust-tags-column-after-save))
+
+(provide 'jao-org-tags)
diff --git a/org/jao-org-utils.el b/org/jao-org-utils.el
new file mode 100644
index 0000000..535e8f4
--- /dev/null
+++ b/org/jao-org-utils.el
@@ -0,0 +1,37 @@
+(require 'org)
+
+;;; links
+(defun jao-org-link-at-point ()
+ (when (thing-at-point-looking-at "\\[\\[\\([^]]+\\)\\]\\[[^]]+\\]\\]")
+ (match-string-no-properties 1)))
+
+(defun jao-org-copy-link-at-point ()
+ (interactive)
+ (message "%s" (or (jao-org-link-at-point) "No link at point")))
+
+;;; eldoc
+(defun jao-org-eldoc--hook ()
+ (set (make-local-variable 'eldoc-documentation-function)
+ 'jao-org-link-at-point)
+ (eldoc-mode))
+
+(defun jao-org-utils-eldoc-setup ()
+ (add-hook 'org-mode-hook 'jao-org-eldoc--hook))
+
+;;; play fair with saveplace
+(defun jao-org--show-if-hidden ()
+ (when (outline-invisible-p)
+ (save-excursion
+ (outline-previous-visible-heading 1)
+ (org-show-subtree))))
+
+;;; verifying org refile targets
+(defun jao-org--refile-target-verify ()
+ (not (looking-at-p ".*\\[\\[.+$")))
+
+(defun jao-org-utils-setup ()
+ (setq org-refile-target-verify-function 'jao-org--refile-target-verify)
+ (add-hook 'org-mode-hook 'jao-org--show-if-hidden t))
+
+
+(provide 'jao-org-utils)
diff --git a/prog/jao-cabal.el b/prog/jao-cabal.el
new file mode 100644
index 0000000..699fa1b
--- /dev/null
+++ b/prog/jao-cabal.el
@@ -0,0 +1,22 @@
+(require 'jao-dominating-file)
+
+(defun jao-haskell-locate-cabal-file ()
+ (jao-locate-dominating-file ".+\\.cabal"))
+
+(eval-after-load 'haskell-mode
+ '(add-hook 'haskell-mode-hook
+ (lambda ()
+ (set (make-local-variable 'compile-command) "cabal build"))))
+
+(defun jao-haskell-cabal-build ()
+ (interactive)
+ (let ((cabal-file (jao-haskell-locate-cabal-file)))
+ (unless cabal-file
+ (error "Couldn't find associated cabal file"))
+ (let ((default-directory (file-name-directory cabal-file)))
+ (call-interactively 'compile))))
+
+;;(eval-after-load 'haskell-mode
+;; '(define-key haskell-mode-map [?\C-c ?c] 'jao-haskell-cabal-build))
+
+(provide 'jao-cabal)
diff --git a/prog/jao-dominating-file.el b/prog/jao-dominating-file.el
new file mode 100644
index 0000000..f845abc
--- /dev/null
+++ b/prog/jao-dominating-file.el
@@ -0,0 +1,34 @@
+(defun jao-locate-dominating-files (regexp &optional file)
+ "Look up the directory hierarchy from FILE for a file matching REGEXP.
+ Stop at the first parent where a matching file is found and return the list
+ of files that that match in this directory."
+ (catch 'found
+ (let ((dir (file-name-as-directory (or file (buffer-file-name))))
+ files)
+ (while (and dir
+ (not (string-match locate-dominating-stop-dir-regexp
+ dir)))
+ (if (setq files (condition-case nil
+ (directory-files dir 'full regexp 'nosort)
+ (error nil)))
+ (throw 'found files)
+ (if (equal dir
+ (setq dir (file-name-directory
+ (directory-file-name dir))))
+ (setq dir nil))))
+ nil)))
+
+
+(defun jao-locate-dominating-file (regexp &optional from)
+ (car (jao-locate-dominating-files regexp from)))
+
+(defun jao-relative-path (regexp &optional from)
+ (let* ((from (or from (buffer-file-name)))
+ (dfile (jao-locate-dominating-file regexp from))
+ (ddir (and dfile (file-name-directory dfile)))
+ (fdir (file-name-directory from)))
+ (when ddir
+ (and (string-match (format "%s\\(.+\\)/" (regexp-quote ddir)) fdir)
+ (match-string-no-properties 1 fdir)))))
+
+(provide 'jao-dominating-file)
diff --git a/prog/jao-java-ant.el b/prog/jao-java-ant.el
new file mode 100644
index 0000000..27c6420
--- /dev/null
+++ b/prog/jao-java-ant.el
@@ -0,0 +1,20 @@
+(require 'jao-dominating-file)
+
+(eval-after-load 'cc-mode
+ '(progn
+ (add-hook 'java-mode-hook
+ (lambda ()
+ (set (make-local-variable 'compile-command) "ant")))
+ (define-key java-mode-map "\C-cc" 'jao-java-ant-build)))
+
+(defun jao-java-ant-build ()
+ (interactive)
+ (let ((build-file (jao-locate-dominating-file "build\\.xml")))
+ (unless build-file
+ (error "Couldn't find associated build file"))
+ (let ((default-directory (file-name-directory build-file)))
+ (call-interactively 'compile))))
+
+(provide 'jao-java-ant)
+
+;; End of jao-java-ant.el
diff --git a/skels/all-skels.el b/skels/all-skels.el
new file mode 100644
index 0000000..720b08e
--- /dev/null
+++ b/skels/all-skels.el
@@ -0,0 +1,49 @@
+;;; all-skels.el --- Convenience package loading all skels
+
+;; Copyright (C) 2008 Jose Ortega
+
+;; Author: Jose Ortega <jao@google.com>
+;; Keywords: languages
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Require this file to load all defined skels
+
+;;; Code:
+
+(require 'init-skel)
+
+(require 'cpp-skel)
+(require 'cppunit-skel)
+(require 'perl-skel)
+(require 'readme-skel)
+(require 'make-skel)
+(require 'caml-skel)
+(require 'latex-skel)
+(require 'noweb-skel)
+(require 'lisp-skel)
+(require 's48-skel)
+(require 'haskell-skel)
+(require 'scsh-skel)
+(require 'lisa-skel)
+(require 'texinfo-skel)
+(require 'python-skel)
+(require 'muse-skel)
+(require 'asdf-skel)
+
+(provide 'all-skels)
+
+;;; all-skels.el ends here
diff --git a/skels/asdf-skel.el b/skels/asdf-skel.el
new file mode 100644
index 0000000..939eb8d
--- /dev/null
+++ b/skels/asdf-skel.el
@@ -0,0 +1,52 @@
+;;; asdf-skel.el --- Skels for ASDF system definition files
+
+;; Copyright (C) 2007 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: lisp
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-asdf-file
+ "ASDF file header"
+ "Description: "
+ '(setq sys (jao-basename))
+ '(lisp-mode)
+ ";; -*- lisp -*- " sys " definition"
+ \n \n
+ "(defpackage " sys "-system" \n " (:use :common-lisp :asdf))"
+ \n \n
+ "(in-package " sys "-system)"
+ \n \n
+ "(defsystem " sys
+ > \n ":description \"" str "\""
+ > \n ":version \"0.1\""
+ > \n ":author \"" (user-full-name) " <" user-mail-address ">\""
+ > \n ":maintainer \"" (user-full-name) " <" user-mail-address ">\""
+ > \n ":licence \"GPL\""
+ > \n ":depends-on ()"
+ > \n ":components ((:file \"packages\")))"
+ \n \n)
+
+(add-to-list 'auto-insert-alist '("\\.asd\\'" . jao-skel-asdf-file))
+
+
+(provide 'asdf-skel)
+;;; asdf-skel.el ends here
diff --git a/skels/caml-skel.el b/skels/caml-skel.el
new file mode 100644
index 0000000..65a5db2
--- /dev/null
+++ b/skels/caml-skel.el
@@ -0,0 +1,42 @@
+;; Copyright (C) 2004, 2005, 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Caml skeletons
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-caml-file
+ "OCaml file header"
+ "Brief description: "
+ "(* " (file-name-nondirectory (buffer-file-name)) ": " str " *)"
+ > \n \n
+ (jao-copyright-line "(* " " *)")
+ > ?\n
+ (jao-insert-copyright-file)
+ "(* $" "Id$ *)" \n \n _)
+
+(jao-provide-skel "\\.ml[i]?" 'jao-skel-caml-file)
+
+(provide 'caml-skel)
+
diff --git a/skels/common-skel.el b/skels/common-skel.el
new file mode 100644
index 0000000..97ee301
--- /dev/null
+++ b/skels/common-skel.el
@@ -0,0 +1,151 @@
+;; common definitions and functions
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Aux functions used in other skeletons
+
+;;; Code:
+
+(require 'skeleton)
+
+(defvar jao-company-name nil
+ "Company name used in copyright notice")
+
+(defvar jao-copyright-file ".copyright"
+ "Basename of the raw (uncommented) copyright file")
+
+(defvar jao-skels-default-scm nil
+ "Default SCM system")
+
+(defun jao-prefix (pref) (or pref (concat comment-start " ")))
+(defun jao-suffix (suff) (or suff (concat " " comment-end)))
+
+(defun jao-copyright-line (prefix &optional suffix omit-cpy)
+ "Create a brief copyright notice with given PREFIX and SUFFIX"
+ (concat (jao-prefix prefix)
+ (if omit-cpy "" "Copyright ")
+ "(c) " (format-time-string "%Y") " "
+ (or jao-company-name (user-full-name))
+ (jao-suffix suffix) "\n"))
+
+(defun jao-date-line (prefix &optional suffix)
+ "Create a start date line"
+ (concat (jao-prefix prefix)
+ "Start date: " (format-time-string "%a %b %d, %Y %H:%M")
+ (jao-suffix suffix) "\n"))
+
+(defun jao-author-line (prefix &optional suffix)
+ "Create an author date line"
+ (concat (jao-prefix prefix)
+ "Author: " (user-full-name) " <" user-mail-address "> "
+ (jao-suffix suffix) "\n"))
+
+(defun jao-cvs-line (prefix &optional suffix)
+ "Create a CVS ID line"
+ (concat (jao-prefix prefix) "$" "Id$" (jao-suffix suffix) "\n"))
+
+(defun jao-svn-line (prefix &optional suffix)
+ "Create a SVN ID line"
+ (concat (jao-prefix prefix) "X-SVN: $" "Id$" (jao-suffix suffix) "\n"))
+
+(defun jao-arch-line (&optional prefix suffix)
+ "Create an arch-tag line"
+ (let ((uuid (shell-command-to-string "uuidgen")))
+ (concat (jao-prefix prefix) "arch-tag: " uuid (jao-suffix suffix) "\n")))
+
+(defun jao-insert-arch-line ()
+ (interactive)
+ (insert (jao-arch-line)))
+
+(defun jao-scm-line (prefix &optional suffix)
+ "Create an scm line"
+ (let* ((formats '(("arch" . jao-arch-line)
+ ("svn" . jao-svn-line)
+ ("cvs" . jao-cvs-line)
+ ("none" . (lambda (p f) ""))))
+ (names (mapcar 'car formats))
+ (prompt (concat "SCM (" (mapconcat 'identity names ", ") "): "))
+ (sel (or jao-skels-default-scm
+ (completing-read prompt formats nil 1)))
+ (fun (cdr (assoc sel formats))))
+ (when fun (concat (funcall fun prefix suffix)))))
+
+(defun jao-c&co-line (&optional prefix suffix)
+ (concat (jao-scm-line prefix suffix) "\n"
+ (jao-co-line prefix suffix)))
+
+(defun jao-co-line (&optional prefix suffix)
+ (concat (jao-copyright-line prefix suffix) "\n"
+ (jao-author-line prefix suffix)
+ (jao-date-line prefix suffix)))
+
+;; aux functions ---------------------------------------------------------
+(defun jao-basename ()
+ "Get buffer file name without dir nor extension"
+ (file-name-sans-extension (file-name-nondirectory (buffer-file-name))))
+
+(defun jao-basedir ()
+ "Base directory"
+ (file-name-nondirectory
+ (substring (file-name-directory (buffer-file-name)) 0 -1)))
+
+(defun jao-dir-level (l)
+ (let ((elems (split-string
+ (file-name-sans-extension (buffer-file-name)) "/")))
+ (mapconcat 'identity (nthcdr (- (length elems) (+ 1 l)) elems) "/")))
+
+(defun jao-extension ()
+ "Find the extension of the currently visited file"
+ (let ((elems (split-string (file-name-nondirectory (buffer-file-name))
+ "\\.")))
+ (nth (- (length elems) 1) elems)))
+
+(defun jao-other-file-name (ext1 ext2)
+ "Find the complimentary file name of header/source file"
+ (let ((extension (jao-extension))
+ (basename (jao-basename)))
+ (if (string= extension ext1) (concat basename "." ext2)
+ (concat basename "." ext1))))
+
+(defun jao-insert-commented-file (file-name)
+ (let* ((start (point))
+ (end (+ start (cadr (insert-file-contents file-name)))))
+ (goto-char end)
+ (comment-region start (point))))
+
+(defun jao-insert-copyright-file ()
+ (let ((dir (locate-dominating-file (buffer-file-name) jao-copyright-file)))
+ (when dir
+ (let ((file (expand-file-name jao-copyright-file dir)))
+ (when (file-exists-p file)
+ (jao-insert-commented-file file))))))
+
+(defun jao-provide-skel (regexp skel)
+ (let ((ex (assoc regexp auto-insert-alist)))
+ (if ex (setf (cdr ex) skel)
+ (add-to-list 'auto-insert-alist (cons regexp skel)))))
+
+(defsubst jao-skel-provide (lst)
+ (mapc (lambda (x) (apply #'jao-provide-skel x)) lst))
+
+(provide 'common-skel)
diff --git a/skels/cpp-skel.el b/skels/cpp-skel.el
new file mode 100644
index 0000000..806f1df
--- /dev/null
+++ b/skels/cpp-skel.el
@@ -0,0 +1,255 @@
+;;; cpp-skel.el
+
+;; Copyright (C) 2004, 2005, 2008, 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; C++ skeletons.
+
+;;; Code:
+
+(require 'common-skel)
+(require 'thingatpt)
+
+;;; Variables
+(defvar jao-skel-cpp-root-namespace nil
+ "The root C++ namespace")
+
+(defvar jao-skel-cpp-brief-header-p nil
+ "If non-nil, generate brief header comments")
+
+(defvar jao-skel-cpp-make-guard-function #'jao-skel-cpp-make-guard-name
+ "Function generating #include guards")
+
+(defvar jao-skel-cpp-use-namespaces t
+ "Whether to generate namespaces")
+
+(defvar jao-skel-cpp-single-line-namespaces t
+ "Whether to put consecutive namespace decls in a single line")
+
+(defvar jao-skel-cpp-header-extension "hpp")
+
+;;; Auxiliar functions
+(defun jao-skel-cpp--find-other (ext)
+ (file-name-nondirectory
+ (or (ff-other-file-name)
+ (concat (file-name-sans-extension (buffer-name)) "." ext))))
+
+(defun jao-skel-cpp-make-guard-name (ns)
+ "Create a standard include guard name"
+ (upcase (mapconcat #'identity
+ `(,@ns ,(jao-basename) ,(jao-extension)
+ ,(user-login-name)
+ ,(format-time-string "%y%m%d%H%M"))
+ "_")))
+
+;; namespaces
+(defsubst jao-skel-cpp--read-ns (curr)
+ (read-string (format "Add namespace (current: %s): " (or curr "[none]"))))
+
+(defsubst jao-skel-cpp--ns2str (ns) (mapconcat 'identity ns "::"))
+
+(defun jao-skel-cpp--get-ns-list (&optional acc)
+ (do* ((result acc (cons next result))
+ (next (jao-skel-cpp--read-ns (jao-skel-cpp--ns2str acc))
+ (jao-skel-cpp--read-ns (jao-skel-cpp--ns2str (reverse result)))))
+ ((string= next "") (reverse result))))
+
+(defun jao-skel-cpp--insert-open-ns-list (ns)
+ (dolist (n ns)
+ (insert (format "namespace %s {%s"
+ n
+ (if jao-skel-cpp-single-line-namespaces " " "\n")))
+ (indent-according-to-mode))
+ (when jao-skel-cpp-single-line-namespaces
+ (newline)
+ (indent-according-to-mode)))
+
+(defun jao-skel-cpp--insert-close-ns-list (ns)
+ (if jao-skel-cpp-single-line-namespaces
+ (insert (format "%s // namespace %s\n"
+ (make-string (length ns) ?})
+ (jao-skel-cpp--ns2str ns)))
+ (dolist (n (reverse ns))
+ (insert (format "} // namespace %s\n" n)))))
+
+(defun jao-skel-cpp--copy-ns-lines ()
+ (let ((lines))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "namespace\\s-\\w+\\s-{\\|}+\\s-//\\s-namespace"
+ nil t)
+ (push (thing-at-point 'line) lines)
+ (next-line)))
+ lines))
+
+(defun jao-skel-cpp--copy-namespace ()
+ (let* ((name (ff-other-file-name))
+ (buff (and name (find-file-noselect name)))
+ (nlines))
+ (when buff
+ (let ((lines (save-current-buffer
+ (set-buffer buff)
+ (jao-skel-cpp--copy-ns-lines))))
+ (dolist (line lines)
+ (push line nlines)
+ (when (string-match "}" line)
+ (push "\n\n\n\n" nlines)))))
+ (mapconcat #'identity nlines "\n")))
+
+(defsubst jao-skel-cpp--get-new-namespace ()
+ (when jao-skel-cpp-use-namespaces
+ (jao-skel-cpp--get-ns-list
+ (and jao-skel-cpp-root-namespace (list jao-skel-cpp-root-namespace)))))
+
+;; skeletons
+(define-skeleton jao-skel-cpp-header-long
+ "Initial file header blurb"
+ "Brief file description: "
+ "/**"
+ > \n
+ "* @file " (file-name-nondirectory (buffer-file-name))
+ > \n
+ "* @brief " str
+ > \n
+ "* @author " (user-full-name) " <"user-mail-address">"
+ > \n
+ "* @date " (format-time-string "%a %b %d, %Y %H:%M")
+ > \n
+ "*"
+ > \n
+ (jao-copyright-line "* " "")
+ "*"
+ > ?\n
+ (jao-insert-copyright-file)
+ > \n \n _)
+
+(define-skeleton jao-skel-cpp-header-brief
+ "Brief initial header blurb"
+ nil
+ (jao-copyright-line "/* " " */")
+ \n)
+
+(define-skeleton jao-skel-cpp-header-comment
+ "Insert a standard comment block"
+ nil
+ '(if jao-skel-cpp-brief-header-p
+ (jao-skel-cpp-header-brief)
+ (jao-skel-cpp-header-long)))
+
+;; source C/C++ file ------------------------------------------------------
+(define-skeleton jao-skel-cpp-source-header
+ "Insert a standard C++ source header"
+ nil
+ '(jao-skel-cpp-header-comment)
+ ? \n
+ "#include \"" (jao-skel-cpp--find-other jao-skel-cpp-header-extension) "\""
+ > \n \n _
+ (jao-skel-cpp--copy-namespace)
+ \n)
+
+(define-skeleton jao-skel-c-source-header
+ "Insert a standard C source header"
+ nil
+ '(jao-skel-cpp-header-comment)
+ "#include \"" (jao-skel-cpp--find-other "h") "\""
+ > _ \n \n \n \n
+ (jao-scm-line "/* " " */")
+ > \n)
+
+
+;; header C/C++ files ------------------------------------------------------
+;; header guard
+
+;; class definition
+(define-skeleton jao-skel-cpp-class-def
+ "Insert a class definition"
+ nil
+ '(setq v1 (jao-basename))
+ > \n
+ "/**"
+ > \n
+ "*"
+ > \n
+ "*"
+ > \n
+ "*/"
+ > \n
+ "class " v1
+ > \n
+ "{"
+ > \n
+ "public:"
+ > \n
+ "~" v1 "();"
+ > \n
+ v1 "();"
+ > \n
+ v1 "(const " v1 "& other);"
+ > \n \n
+ "private:"
+ > \n
+ "};"
+ > \n)
+
+(define-skeleton jao-skel-cpp-header
+ "Insert a standard C++ header (hpp files)"
+ nil
+ '(setq v1 (jao-skel-cpp--get-new-namespace))
+ '(setq v2 (funcall jao-skel-cpp-make-guard-function v1))
+ '(jao-skel-cpp-header-comment)
+ > \n
+ "#ifndef " v2
+ > \n
+ "#define " v2
+ > \n \n
+ '(when v1 (jao-skel-cpp--insert-open-ns-list v1))
+ _ '(jao-skel-cpp-class-def)
+ > \n \n
+ '(when v1 (jao-skel-cpp--insert-close-ns-list v1))
+ > \n \n
+ "#endif // " v2
+ > \n)
+
+(define-skeleton jao-skel-c-header
+ "Insert a standard C header (.h files)"
+ nil
+ '(jao-skel-cpp-header-comment)
+ > \n
+ '(setq v1 (funcall jao-skel-cpp-make-guard-function nil))
+ "#ifndef " v1
+ > \n
+ "#define " v1
+ > _ \n \n \n \n
+ "#endif /* " v1 " */"
+ > \n \n
+ (jao-scm-line "/* " " */")
+ > \n)
+
+(jao-skel-provide
+ '(("\\.cpp$" jao-skel-cpp-source-header)
+ ("\\.hpp$" jao-skel-cpp-header)
+ ("\\.c$" jao-skel-c-source-header)
+ ("\\.h$" jao-skel-c-header)))
+
+(provide 'cpp-skel)
+
+;;; cpp-skel.el ends here
diff --git a/skels/cppunit-skel.el b/skels/cppunit-skel.el
new file mode 100644
index 0000000..729f392
--- /dev/null
+++ b/skels/cppunit-skel.el
@@ -0,0 +1,91 @@
+;;; cppunit-skel.el
+
+;; Copyright (C) 2004, 2005 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Skeletons creating cppunit classes.
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-cppunit-main
+ "Insert CPPUNIT main function"
+ nil
+ "#include <cppunit/extensions/TestFactoryRegistry.h>" > \n
+ "#include <cppunit/ui/text/TestRunner.h>" > \n \n
+ "int" > \n
+ "main(int argc, char* argv[])" > \n
+ "{" > \n
+ "CppUnit::TextUi::TestRunner runner;" > \n
+ "CppUnit::TestFactoryRegistry& registry =" > \n
+ "CppUnit::TestFactoryRegistry::getRegistry();" > \n \n
+ "runner.addTest(registry.makeTest());" > \n \n
+ "return !runner.run(\"\", false);" > \n
+ "}" > \n)
+
+(define-skeleton jao-cppunit-class
+ "Create a CPPUNIT class definition preamble"
+ nil
+ >
+ "CPPUNIT_TEST_SUITE(" (jao-basename) ");"
+ > \n
+ "CPPUNIT_TEST(test);"
+ > \n
+ "CPPUNIT_TEST_SUITE_END();"
+ > \n \n
+ "private:"
+ > \n \n
+ "void test();"
+ > \n \n
+ "private:"
+ > \n \n
+ "void set_up();"
+ > \n
+ "void tear_down();"
+ > \n)
+
+(define-skeleton jao-cppunit-classdef
+ "Create a CPPUNIT class implementation preamble"
+ nil
+ >
+ "CPPUNIT_TEST_SUITE_REGISTRATION(" (jao-basename) ");"
+ > \n \n
+ "void"
+ > \n
+ (jao-basename) "::set_up()"
+ > \n
+ "{"
+ > \n
+ "}"
+ > \n \n
+ "void"
+ > \n
+ (jao-basename) "::tear_down()"
+ > \n
+ "{"
+ > \n
+ "}"
+ > \n)
+
+(provide 'cppunit-skel)
+
diff --git a/skels/dot.emacs.el b/skels/dot.emacs.el
new file mode 100644
index 0000000..a82e500
--- /dev/null
+++ b/skels/dot.emacs.el
@@ -0,0 +1,11 @@
+;; boilerplate skels configuration:
+
+;;; add skels directory to your load path
+(add-to-list 'load-path "~/lib/emacs/skels")
+(load "init-skel")
+
+;;; set configuration variables
+(setq jao-company-name "Free Software Foundation, Inc.")
+(setq jao-cpp-root-namespace "")
+(setq jao-copyright-file ".copyright")
+
diff --git a/skels/fsf-copyright b/skels/fsf-copyright
new file mode 100644
index 0000000..af83705
--- /dev/null
+++ b/skels/fsf-copyright
@@ -0,0 +1,12 @@
+This file is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3 of the License, or
+(at your option) any later version.
+
+This file is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program. If not, see <http://www.gnu.org/licenses/>.
diff --git a/skels/fuel-skel.el b/skels/fuel-skel.el
new file mode 100644
index 0000000..786f4ec
--- /dev/null
+++ b/skels/fuel-skel.el
@@ -0,0 +1,45 @@
+;;; fuel-skel.el --- skeleton for fuel elisp files
+
+;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: lisp
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-fuel-file
+ "Fuel file header"
+ "Brief description: "
+ ";;; " (file-name-nondirectory (buffer-file-name)) " -- " str ""
+ \n \n
+ (jao-copyright-line ";; ")
+ ";; See http://factorcode.org/license.txt for BSD license."
+ \n \n (jao-author-line ";; ") ";; Keywords: languages, fuel, factor"
+ \n (jao-date-line ";; ")
+ \n ";;; Comentary: " \n \n ";; " _ \n
+ \n ";;; Code: " \n \n \n \n
+ " " \n "(provide '" (jao-basename) ")" \n
+ ";;; " (file-name-nondirectory (buffer-file-name)) " ends here"
+ \n
+ \n)
+
+(jao-provide-skel "misc/fuel/.+\\.el\\'" 'jao-skel-fuel-file)
+
+
+(provide 'fuel-skel)
+;;; fuel-skel.el ends here
diff --git a/skels/geiser-skel.el b/skels/geiser-skel.el
new file mode 100644
index 0000000..3c9181a
--- /dev/null
+++ b/skels/geiser-skel.el
@@ -0,0 +1,50 @@
+;; geiser-skel.el -- geiser skeletons
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Fri Sep 11, 2009 00:31
+
+(require 'common-skel)
+
+(defconst jao-skel-geiser--bsd
+ ";; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+")
+
+(defsubst jao-skel-geiser--end-line ()
+ (format ";;; %s ends here\n\n" (file-name-nondirectory (buffer-file-name))))
+
+(define-skeleton jao-skel-geiser--common
+ "Geiser elisp header"
+ "Brief description: "
+ ";;; " (file-name-nondirectory (buffer-file-name)) " -- " str ""
+ \n \n
+ (jao-copyright-line ";; ") \n
+ jao-skel-geiser--bsd
+ \n (jao-date-line ";; ") \n)
+
+(define-skeleton jao-skel-geiser-elisp
+ "Geiser elisp header"
+ nil
+ '(jao-skel-geiser--common)
+ " " \n _ \n \n " " \n "(provide '" (jao-basename) ")" \n
+ (jao-skel-geiser--end-line))
+
+(jao-provide-skel "geiser/elisp/.+\\.el\\'" 'jao-skel-geiser-elisp)
+
+(define-skeleton jao-skel-geiser-scheme
+ "Geiser scheme header"
+ nil
+ '(jao-skel-geiser--common) _
+ \n (jao-skel-geiser--end-line))
+
+(jao-provide-skel "geiser/scheme/.+\\.\\(scm\\|ss\\|sls\\)\\'"
+ 'jao-skel-geiser-scheme)
+
+
+
+(provide 'geiser-skel)
+;;; geiser-skel.el ends here
diff --git a/skels/haskell-skel.el b/skels/haskell-skel.el
new file mode 100644
index 0000000..e105f31
--- /dev/null
+++ b/skels/haskell-skel.el
@@ -0,0 +1,69 @@
+;;; haskell-skel.el --- skeleton for haskell source files
+;; Copyright (C) 2003, 2004, 2005, 2009, 2010 Jose A Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@member.fsf.org>
+;; Keywords: languages
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'common-skel)
+(require 'jao-dominating-file)
+
+;;; Auxiliar
+(defun jao-skel--read-haskell-module ()
+ (let* ((ddir (jao-relative-path "\\.cabal\\'"))
+ (mbase (and ddir (concat (replace-in-string ddir "/" ".") ".")))
+ (m (read-string "Module prefix (empty for no module): "
+ (concat (or mbase "") (jao-basename)))))
+ (or m "")))
+
+(defconst jao-skel--haskell-line (make-string 78 ?-))
+
+;;; Skeletons
+(define-skeleton jao-skel-haskell-file
+ "Haskell hs file header"
+ "Brief description: "
+ '(setq v (jao-skel--read-haskell-module))
+ jao-skel--haskell-line \n
+ "-- |" \n
+ "-- Module: " v \n
+ (jao-copyright-line "-- Copyright: " "" t)
+ "-- License: BSD3-style (see LICENSE)" \n
+ "--" \n
+ "-- Maintainer: " user-mail-address \n
+ "-- Stability: unstable" \n
+ "-- Portability: portable" \n
+ "-- Created: " (format-time-string "%a %b %d, %Y %H:%M") \n
+ "--" \n
+ "--" \n
+ "-- " str \n
+ "--" \n
+ jao-skel--haskell-line
+ \n \n \n
+ "module " v " where " \n \n \n)
+
+(jao-provide-skel "\\.hs\\'" 'jao-skel-haskell-file)
+;; (jao-provide-skel "\\.lhs\\'" 'jao-skel-lit-haskell-file)
+
+(provide 'haskell-skel)
+
+;;; haskell-skel.el ends here
diff --git a/skels/init-skel.el b/skels/init-skel.el
new file mode 100644
index 0000000..7612f92
--- /dev/null
+++ b/skels/init-skel.el
@@ -0,0 +1,39 @@
+;; skeleton configuration
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Initialisation file for jao skeletons
+
+;;; Code:
+
+(require 'autoinsert)
+(setq auto-insert t)
+(add-hook 'find-file-hooks 'auto-insert)
+(setq auto-insert-directory "~/.autoinsert/")
+(setq auto-insert-query t)
+
+(require 'common-skel)
+
+(provide 'init-skel)
+
+;;;; init-skel.el ends here
diff --git a/skels/latex-skel.el b/skels/latex-skel.el
new file mode 100644
index 0000000..330be22
--- /dev/null
+++ b/skels/latex-skel.el
@@ -0,0 +1,52 @@
+;; latex skeletons
+
+;; Copyright (C) 2004, 2005, 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; LaTeX skeletons
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-latex
+ "Latex standard header"
+ nil
+ "%%"
+ \n
+ "%% Author: " (user-full-name) " <"user-mail-address">"
+ \n
+ "%% Start date: " (format-time-string "%a %b %d, %Y %H:%M")
+ \n
+ "%% $" "Id$"
+ \n
+ "%%"
+ ?\n
+ (jao-copyright-line "% ")
+ \n
+ "%%"
+ \n \n)
+
+(jao-provide-skel "\\.tex$\\|\\.sty$\\|\\.cls$" 'jao-skel-latex)
+
+(provide 'latex-skel)
+
diff --git a/skels/lisa-skel.el b/skels/lisa-skel.el
new file mode 100644
index 0000000..6cf3083
--- /dev/null
+++ b/skels/lisa-skel.el
@@ -0,0 +1,157 @@
+;;; lisa variants of c skeletons
+
+;; Copyright (C) 2004, 2005, 2006 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Lisa variants for c skeletons
+
+;;; Code:
+
+(require 'common-skel)
+
+(defun jao-lisa-filename ()
+ (let* ((fname (expand-file-name (buffer-file-name)))
+ (parts (split-string fname "/"))
+ (dirs (member "src" parts)))
+ (mapconcat 'identity dirs "/")))
+
+
+(defun jao-lisa-guard ()
+ (upcase (concat (jao-basename)
+ "_" (jao-extension) "_"
+ (format-time-string "%y%m%d%H%M"))))
+
+(defun jao-lisa-header (&optional desc group prf)
+ (concat "/**"
+ "\n * @file " (jao-lisa-filename)
+ "\n * @author " (user-full-name) " <"user-mail-address">"
+ "\n * @date " (format-time-string "%a %b %d, %Y %H:%M")
+ "\n * @brief " (or desc (read-string "Description: "))
+ (if group (concat "\n * @ingroup " group) "")
+ (if prf (concat "\n * @uutrx " prf) "")
+ "\n **/\n\n"
+ (jao-arch-line "// " "")))
+
+(define-skeleton jao-skel-lisa-h
+ "Standard lisa c header"
+ nil
+ '(setq guard (jao-lisa-guard))
+ (jao-lisa-header)
+ \n \n
+ "#ifndef " guard \n
+ "#define " guard \n
+ \n \n "#include \"" _ "\"" \n \n \n
+ " " \n "// Types" \n \n \n
+ " " \n "// Constants" \n \n \n
+ " " \n "// Functions" \n \n \n
+ \n \n
+ "#endif // " guard
+ \n \n)
+
+(define-skeleton jao-skel-lisa-c
+ "Standard lisa c body"
+ nil
+ (jao-lisa-header (concat (jao-other-file-name "h" "c") " implementation"))
+ \n \n
+ "#include \""
+ (jao-basename)
+ ".h\"" >
+ > \n \n \n
+ " " \n "// Private" \n \n \n
+ _
+ " " \n "// Public" \n \n \n
+ )
+
+(define-skeleton jao-skel-lisa-test
+ "Cantata++ test file"
+ nil
+ '(setq v1 (read-string "File under test (sans extension): "))
+ '(setq v0 (read-string "Doxygen group under test: "))
+ '(setq v2 (concat "UnitTest" v0))
+ (jao-lisa-header (concat "Unit tests for " v1)
+ v2
+ (read-string "Prefix of functions being tested (e.g. 'rtos_?+'): "))
+ \n \n
+ "#include \"test/test.h\"" > \n
+ "#include \"" v1 ".h\"" > \n \n \n
+ "// Test name" > \n
+ "char const *test_name = \"" (concat v1 "_test") "\";" > \n \n
+ "// Prototypes for test functions" > \n
+ "/**" \n
+ "* @defgroup " v2 " Unit tests" > \n
+ "* @ingroup " v0 > \n
+ "**/" > \n
+ "//@{" > \n
+ "//@}" > \n
+ \n \n \n
+ "void" > \n
+ "run_tests (void)" > \n
+ "{" > \n
+ "}" > \n \n
+ "// Test functions" > \n \n \n)
+
+(defun jao-add-cantata-test ()
+ "Call this function inside a test buffer to add a new test fun"
+ (interactive)
+ (let* ((fn (read-string "Function under test: "))
+ (tfn (concat "test_" fn)))
+ (goto-char (point-min))
+ (if (not (search-forward-regexp "^// Prototypes for test functions$" nil t))
+ (error "No beginning of test fun declarations found"))
+ (if (not (search-forward-regexp "//@\\}$" nil t))
+ (error "Missing doxygen group marks in prototype function decls"))
+ (beginning-of-line)
+ (open-line 1)
+ (insert "/**\n * Unit tests for @ref " fn "\n */\n")
+ (insert "static void " tfn " (void);\n")
+ (if (not (search-forward-regexp "run_tests (void)$" nil t))
+ (error "No run_tests() definition found"))
+ (if (not (search-forward-regexp "^}" nil t))
+ (error "End of run_tests() not found"))
+ (beginning-of-line)
+ (insert "\n")
+ (previous-line 1)
+ (insert tfn " ();")
+ (indent-according-to-mode)
+ (goto-char (point-max))
+ (jao-insert-cantata-test-fun tfn)))
+
+(defun jao-insert-cantata-test-fun (fn)
+ (beginning-of-line)
+ (insert "void\n" fn " (void)\n{\n")
+ (insert "START_TEST (\"" fn
+ "\", \"" (read-string "Test case description: ") "\");")
+ (indent-according-to-mode)
+ (insert "\n\n\nEND_TEST ();")
+ (indent-according-to-mode)
+ (insert "\n}\n"))
+
+
+(defun jao-skel-lisa-activate ()
+ (interactive)
+ (jao-provide-skel "\\.c$" 'jao-skel-lisa-c)
+ (jao-provide-skel "\\.h$" 'jao-skel-lisa-h)
+ (jao-provide-skel "tests/.*\\.c$" 'jao-skel-lisa-test))
+
+
+(provide 'lisa-skel)
+
diff --git a/skels/lisp-skel.el b/skels/lisp-skel.el
new file mode 100644
index 0000000..e5bb91a
--- /dev/null
+++ b/skels/lisp-skel.el
@@ -0,0 +1,50 @@
+;;; lisp-skel.el --- skeleton for lisp-like languages
+
+;; Copyright (C) 2003, 2004, 2005, 2008, 2009 Jose A Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: lisp
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Skeleton for lisp like languages
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-lisp-file
+ "Lisp file header"
+ "Brief description: "
+ ";; " (file-name-nondirectory (buffer-file-name)) " -- " str ""
+ ?\n
+ (jao-c&co-line ";; ")
+ ?\n
+ (jao-insert-copyright-file)
+ \n ";;; Comentary: " \n \n ";; " _ \n
+ \n ";;; Code: " \n \n \n \n
+ '(when (eq major-mode 'emacs-lisp-mode)
+ (insert (format " \n(provide '%s)\n" (jao-basename))))
+ ";;; " (file-name-nondirectory (buffer-file-name)) " ends here"
+ \n
+ \n)
+
+(jao-provide-skel "\\.\\(scm\\|ss\\|lisp\\|cl\\|el\\)\\'" 'jao-skel-lisp-file)
+
+(provide 'lisp-skel)
+;;; lisp-skel.el ends here
diff --git a/skels/make-skel.el b/skels/make-skel.el
new file mode 100644
index 0000000..5607dbe
--- /dev/null
+++ b/skels/make-skel.el
@@ -0,0 +1,53 @@
+;; makefile skeletons
+
+;; Copyright (C) 2004, 2005, 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Makefile skeletons
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-makefile
+ "Makefile standard header"
+ nil
+ "#"
+ \n
+ "# $" "Id$"
+ \n
+ "# "
+ \n
+ "# Author: " (user-full-name) " <"user-mail-address">"
+ \n
+ "# Start date: " (format-time-string "%a %b %d, %Y %H:%M")
+ \n
+ "#"
+ ?\n
+ (jao-copyright-line "# ")
+ \n
+ (jao-insert-copyright-file))
+
+(jao-provide-skel "\\.mk$\\|Makefile\\(\\.am\\)?\\|configure\\.in" 'jao-skel-makefile)
+
+(provide 'make-skel)
+
diff --git a/skels/muse-skel.el b/skels/muse-skel.el
new file mode 100644
index 0000000..86686d9
--- /dev/null
+++ b/skels/muse-skel.el
@@ -0,0 +1,41 @@
+;;; muse-skel.el --- muse pages
+
+;; Copyright (C) 2006 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-muse-file
+ "Muse file skeleton"
+ "Documents (sub)dir: "
+ _ \n \n \n \n \n \n \n
+ "----" \n
+ ";;; Local Variables:" \n
+ ";;; wiki-docs: " str \n
+ ";;; End:" \n \n
+ '(hack-local-variables))
+
+(add-to-list 'auto-insert-alist
+ '("\\.muse\\'" . jao-skel-muse-file))
+
+(provide 'muse-skel)
+;;; muse-skel.el ends here
diff --git a/skels/noweb-skel.el b/skels/noweb-skel.el
new file mode 100644
index 0000000..0e37702
--- /dev/null
+++ b/skels/noweb-skel.el
@@ -0,0 +1,48 @@
+;;; noweb-skel.el --- skeleton for noweb files
+
+;; Copyright (C) 2003, 2004, 2005 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Skeleton for noweb files
+
+;;; Code:
+
+(require 'common-skel)
+(require 'latex-skel)
+
+(define-skeleton jao-skel-noweb
+ "Noweb standard header"
+ "Code mode (without -mode suffix): "
+ "% -*- mode: Noweb; noweb-code-mode: " str "-mode -*-"
+ '(setq noweb-code-mode (intern (concat str "-mode")))
+ \n
+ '(jao-skel-latex)
+ \n _ \n \n
+ "%%% end of file"
+ \n)
+
+(add-to-list 'auto-insert-alist '("\\.nw$" . jao-skel-noweb))
+
+(provide 'noweb-skel)
+
+
+;;; noweb-skel.el ends here
diff --git a/skels/perl-skel.el b/skels/perl-skel.el
new file mode 100644
index 0000000..a5b5bb4
--- /dev/null
+++ b/skels/perl-skel.el
@@ -0,0 +1,78 @@
+;;; perl-skel.el
+
+;; Copyright (C) 2004, 2005, 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Perl skeletons
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-perl-script
+ "Standard perl script header"
+ "Brief file description: "
+ "#! /usr/bin/perl -w"
+ > \n
+ "#"
+ > \n
+ "# $Id" "$"
+ > \n
+ "# " (file-name-nondirectory (buffer-file-name)) ": " str
+ > \n
+ "#"
+ > ?\n
+ (jao-copyright-line "# ")
+ > ?\n
+ (jao-insert-copyright-file)
+ > \n
+ "use strict;"
+ > \n \n
+ > \n _)
+
+(define-skeleton jao-skel-perl-module
+ "Standard perl module header"
+ "Brief module description: "
+ "#"
+ > \n
+ "# " (file-name-nondirectory (buffer-file-name)) ": "str
+ > \n
+ "#"
+ > ?\n
+ (jao-copyright-line "# ")
+ > ?\n
+ (jao-insert-copyright-file)
+ "# "
+ > \n \n
+ "package "
+ (read-string (concat "Module name (" (jao-basename) "): ")
+ nil nil (jao-basename))
+ ";"
+ > \n \n _ \n \n
+ "1;"
+ > \n)
+
+(jao-provide-skel "\\.pl$" 'jao-skel-perl-script)
+(jao-provide-skel "\\.pm$" 'jao-skel-perl-module)
+
+(provide 'perl-skel)
+
diff --git a/skels/pika-skel.el b/skels/pika-skel.el
new file mode 100644
index 0000000..654792d
--- /dev/null
+++ b/skels/pika-skel.el
@@ -0,0 +1,88 @@
+;;; pika variants of c skeletons
+
+;; Copyright (C) 2004, 2005 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Pika variants for c skeletons
+
+;;; Code:
+
+(require 'common-skel)
+
+(defun jao-pika-guard ()
+ (upcase (concat "include__" (jao-basedir) "__" (jao-basename) "_h")))
+
+(define-skeleton jao-pika-header
+ ""
+ "Brief file description: "
+ "/* " (file-name-nondirectory (buffer-file-name)) ": " str
+ \n "*" > \n
+ "****************************************************************"
+ > \n (jao-copyright-line "* ")
+ > \n "*" > \n
+ "* See the file \"COPYING\" for further information about"
+ > n
+ "* the copyright and warranty status of this work."
+ > n
+ "*/" \n " " \n _)
+
+(define-skeleton jao-skel-pika-h
+ "Standard pika c header"
+ nil
+ (jao-pika-header)
+ '(setq guard (jao-pika-guard))
+ "#ifndef " guard \n
+ "#define " guard \n
+ " "
+ \n \n "#include \"" _ "\""\n \n
+ " "
+ \n \n \n
+ " "
+ \n
+ "#endif /* " guard " */"
+ \n \n " " \n
+ (jao-arch-line "/* " "*/")
+ \n)
+
+(define-skeleton jao-skel-pika-c
+ "Standard pika c body"
+ nil
+ (jao-pika-header)
+ \n "#include \"" (jao-dir-level 2) ".h\"" \n
+ \n
+ " "
+ \n \n _ \n \n " " \n
+ (jao-arch-line "/* " "*/")
+ \n)
+
+(defun jao-skel-pika-activate ()
+ (interactive)
+ (let ((c (assoc "\\.c$" auto-insert-alist))
+ (h (assoc "\\.h$" auto-insert-alist)))
+ (if c (setf (cdr c) 'jao-skel-pika-c)
+ (add-to-list 'auto-insert-alist '("\\.c$" . jao-skel-pika-c)))
+ (if h (setf (cdr h) 'jao-skel-pika-h)
+ (add-to-list 'auto-insert-alist '("\\.h$" . jao-skel-pika-h)))))
+
+
+(provide 'pika-skel)
+
diff --git a/skels/python-skel.el b/skels/python-skel.el
new file mode 100644
index 0000000..536f825
--- /dev/null
+++ b/skels/python-skel.el
@@ -0,0 +1,53 @@
+;;; python-skel.el
+
+;; Copyright (C) 2004, 2005, 2009 Aleix Conchillo Flaque
+
+;; Author: Aleix Conchillo Flaque <aleix@member.fsf.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Python skeletons
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-python-module
+ "Standard python module header"
+ "Brief file description: "
+ "#! /usr/bin/env python"
+ > \n
+ "#"
+ > \n
+ "# $Id" "$"
+ > \n \n
+ "# " (file-name-nondirectory (buffer-file-name)) ": " str
+ > \n
+ "#"
+ > ?\n
+ (jao-copyright-line "# ")
+ > ?\n
+ (jao-insert-copyright-file)
+ > \n
+ > \n _)
+
+(jao-provide-skel "\\.py$" 'jao-skel-python-module)
+
+(provide 'python-skel)
+
diff --git a/skels/readme-skel.el b/skels/readme-skel.el
new file mode 100644
index 0000000..9c22cce
--- /dev/null
+++ b/skels/readme-skel.el
@@ -0,0 +1,44 @@
+;; Copyright (C) 2004, 2005 Jose Antonio Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: tools
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Simple skeleton for README files.
+
+;;; Code:
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-readme-file
+ "README file header"
+ "Brief description: "
+ \n str
+ \n "-----------------------------------------------------" \n
+ _ \n \n \n
+ "-----------------------------------------------------" \n
+ (jao-copyright-line "" "")
+ \n \n
+ "$Id" "$"
+ \n)
+
+(add-to-list 'auto-insert-alist '("README" . jao-skel-readme-file))
+
+(provide 'readme-skel)
+
diff --git a/skels/s48-skel.el b/skels/s48-skel.el
new file mode 100644
index 0000000..30e749f
--- /dev/null
+++ b/skels/s48-skel.el
@@ -0,0 +1,61 @@
+;;; s48-skel.el --- skeleton for s48
+
+;; Copyright (C) 2003, 2004, 2005, 2006, 2008, 2009 Jose A Ortega Ruiz
+
+;; Author: Jose A Ortega Ruiz <jao@gnu.org>
+;; Keywords: lisp
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Skeleton for s48/slime48 like languages
+
+;;; Code:
+
+(require 'common-skel)
+(require 'lisp-skel)
+
+(define-skeleton jao-skel-s48-file
+ "Slime/Scheme48 file header"
+ "Package: "
+ ";; -*- mode: scheme48; scheme48-package: " str " -*-"
+ ?\n
+ (jao-co-line ";; ")
+ ?\n
+ (jao-insert-copyright-file)
+ \n ";;; Comentary: " \n \n ";; " _ \n
+ \n ";;; Code: " \n \n \n \n
+ ";;; " (file-name-nondirectory (buffer-file-name)) " ends here"
+ '(scheme48-mode)
+ \n
+ \n)
+
+(define-skeleton jao-skel-s48-file-maybe
+ "Choose between a s48 file and a plain scheme one"
+ nil
+ '(if (y-or-n-p "Is this a s48 file? ") (jao-skel-s48-file)
+ (jao-skel-lisp-file))
+ '(hack-local-variables))
+
+
+(jao-provide-skel "\\.scm\\'" 'jao-skel-s48-file-maybe)
+
+
+(provide 's48-skel)
+
+
+;;; lisp-skel.el ends here
diff --git a/skels/scsh-skel.el b/skels/scsh-skel.el
new file mode 100644
index 0000000..495925f
--- /dev/null
+++ b/skels/scsh-skel.el
@@ -0,0 +1,45 @@
+;;; scsh-skel.el --- skeleton for scsh scripts
+
+;; Copyright (C) 2003, 2004, 2005, 2006, 2008 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: abbrev
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+(require 'common-skel)
+
+(define-skeleton jao-skel-scsh
+ "Scsh script skeleton"
+ "Brief description: "
+ "#! " (executable-find "scsh") " \\" \n
+ "-e " (file-name-nondirectory (buffer-file-name)) " -s" \n
+ "!#" \n \n
+ ";;;; " str \n
+ "(define (" (file-name-nondirectory (buffer-file-name)) " args)"
+ \n
+ > _ " )"
+ > \n \n \n
+ ";; Local Variables:" \n
+ ";; mode: scheme" \n
+ ";; End:"
+ '(hack-local-variables)
+ \n \n)
+
+(provide 'scsh-skel)
+
+
+;;; scsh-skel.el ends here
diff --git a/skels/texinfo-skel.el b/skels/texinfo-skel.el
new file mode 100644
index 0000000..dc73835
--- /dev/null
+++ b/skels/texinfo-skel.el
@@ -0,0 +1,131 @@
+;;; texinfo-skel.el --- skeletons for texinfo files
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: languages
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Skeletons to generate texinfo files templates.
+
+;;; Code:
+
+(require 'common-skel)
+
+(defun jao-dir-entry ()
+ "Read dir file entry"
+ (let ((cat (read-string "Dir file category: "))
+ (ent (read-string "Direntry name: "))
+ (desc (read-string "Direntry description: ")))
+ (concat "@dircategory " cat
+ "\n@direntry\n" ent
+ ": (" (jao-basename) "). " desc "."
+ "\n@end direntry\n")))
+
+(define-skeleton jao-skel-main-texinfo
+ "Main texinfo file skeleton"
+ "Document title: "
+ "\\input texinfo"
+ \n "@ignore" >
+ \n (jao-scm-line "")
+ "@end ignore" >
+ \n > "@c %**start of header"
+ \n "@setfilename " (jao-basename) ".info" >
+ \n "@settitle " str >
+ \n "@syncodeindex pg cp" >
+ \n "@setchapternewpage odd" >
+ \n "@footnotestyle separate" >
+ \n "@c %**end of header" >
+ \n \n
+ (jao-dir-entry)
+ \n
+ "@set UPDATED " (format-time-string "%B %Y")
+ \n "@set EDITION 0.1"
+ \n "@set VERSION 0.1"
+ \n "@set AUTHOR " (user-full-name)
+ \n \n "@copying"
+ \n "This manual is for " str " (version @value{VERSION}, @value{UPDATED})."
+ \n
+ \n "Copyright @copyright{} " (format-time-string "%Y") " " jao-company-name
+ \n
+ \n "@quotation"
+ \n "Permission is granted to copy, distribute and/or modify this document"
+ \n "under the terms of the GNU Free Documentation License, Version 1.1 or"
+ \n "any later version published by the Free Software Foundation; with no"
+ \n "Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,''"
+ \n "and with the Back-Cover Texts as in (a) below. A copy of the"
+ \n "license is included in the section entitled ``GNU Free Documentation"
+ \n "License.''"
+ \n
+ \n "(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify"
+ \n "this GNU Manual, like GNU software. Copies published by the Free"
+ \n "Software Foundation raise funds for GNU development.''"
+ \n "@end quotation"
+ \n "@end copying"
+ \n \n "@titlepage"
+ \n "@title " str
+ \n "@subtitle Edition @value{EDITION}, for version @value{VERSION}"
+ \n "@subtitle @value{UPDATED}"
+ \n "@author by @value{AUTHOR} (@email{jao@@gnu.org})"
+ \n "@page"
+ \n "@vskip 0pt plus 1filll"
+ \n "@insertcopying"
+ \n "@end titlepage"
+ \n
+ \n "@shortcontents"
+ \n "@contents"
+ \n
+ \n "@ifnottex"
+ \n "@node Top, , (dir), (dir)"
+ \n \n "@insertcopying"
+ \n "@end ifnottex"
+ \n \n
+ "@menu" > \n "@detailmenu" \n \n > "@end detailmenu" > \n "@end menu"
+ \n \n \n
+ "@include intro.texi" >
+ \n \n \n
+ "@bye"
+ \n)
+
+(define-skeleton jao-skel-child-texinfo
+ "Template for child texinfo docs"
+ "Node name: "
+ "@node " str \n
+ > "@chapter " str \n
+ > "@ignore" \n
+ (jao-scm-line "")
+ > "@end ignore" \n \n
+ _ \n \n
+ "@c This is part of the " (read-string "Main doc title: ") \n
+ "@c See the main file for copying conditions."
+ \n \n)
+
+(define-skeleton jao-skel-texinfo
+ "Skeleton for texinfo files"
+ nil
+ '(if (y-or-n-p "Is this the main texinfo file? ")
+ (jao-skel-main-texinfo)
+ (jao-skel-child-texinfo))
+ _)
+
+(add-to-list 'auto-insert-alist '("\\.texi$" . jao-texinfo-skel))
+
+
+(provide 'texinfo-skel)
+
+
+;;; texinfo-skel.el ends here
diff --git a/sys/furl.applescript b/sys/furl.applescript
new file mode 100644
index 0000000..6823ff0
--- /dev/null
+++ b/sys/furl.applescript
@@ -0,0 +1 @@
+tell application "Firefox" to get Çclass curlÈ of window 1
diff --git a/sys/jao-applescript.el b/sys/jao-applescript.el
new file mode 100644
index 0000000..233186c
--- /dev/null
+++ b/sys/jao-applescript.el
@@ -0,0 +1,65 @@
+;;; AppleScript and some macish bits
+(autoload 'applescript-mode "applescript-mode"
+ "major mode for editing AppleScript source." t)
+(setq auto-mode-alist
+ (cons '("\\.applescript$" . applescript-mode) auto-mode-alist))
+
+(defun do-applescript (script)
+ (with-temp-buffer
+ (insert script)
+ (shell-command-on-region (point-min) (point-max) "osascript" t)
+ (buffer-string)))
+
+(defun jao-as-tell-app (app something)
+ (let ((res (do-applescript (format "tell application \"%s\"\n%s\nend tell"
+ app something))))
+ (or (and (stringp res) (substring res 0 -1)) "")))
+
+(defmacro jao-as-get-doc (name application &optional doc)
+ `(defun ,name ()
+ (interactive)
+ (let ((url (jao-as-tell-app ,application
+ ,(format "get the URL of %s 1"
+ (or doc "document"))))
+ (name (jao-as-tell-app ,application "get the name of document 1")))
+ (cons url name))))
+(jao-as-get-doc jao-as-safari-doc "Safari")
+(jao-as-get-doc jao-as-webkit-doc "WebKit")
+(jao-as-get-doc jao-as-camino-doc "Camino" "window")
+
+(defun jao-as-firefox-doc ()
+ (interactive)
+ (let ((url (shell-command-to-string
+ (concat "osascript "
+ (expand-file-name "furl.applescript"
+ (file-name-directory load-file-name)))))
+ (name (jao-as-tell-app "Firefox" "get the name of window 1")))
+ (cons (substring url 0 -1) name)))
+
+
+;;; quicksilver
+(defun jao-qs-buffer ()
+ "Opens the current file in Quicksilver"
+ (interactive)
+ (cond ((and buffer-file-name (file-exists-p buffer-file-name))
+ (call-process-shell-command (concat "qs \"" buffer-file-name "\"")))
+ ;; dired handling
+ ((eq major-mode 'dired-mode)
+ (dired-do-shell-command "qs * "
+ current-prefix-arg
+ (dired-get-marked-files t current-prefix-arg)))
+ ;; buffer-menu mode
+ ((and (eq major-mode 'Buffer-menu-mode)
+ (file-exists-p (buffer-file-name (Buffer-menu-buffer nil))))
+ (call-process-shell-command
+ (concat "qs \"" (buffer-file-name (Buffer-menu-buffer nil)) "\"")))
+ (t
+ (error "Not visiting a file or file doesn't exist"))))
+
+ (defun jao-qs-region (start end)
+ "Opens the contents of the region in Quicksilver as text."
+ (interactive "r")
+ (call-process-region start end "qs" nil 0 nil "-"))
+
+
+(provide 'jao-applescript)
diff --git a/sys/jao-devon.el b/sys/jao-devon.el
new file mode 100644
index 0000000..417cb6d
--- /dev/null
+++ b/sys/jao-devon.el
@@ -0,0 +1,42 @@
+;; DEVONthink interaction
+
+(require 'jao-applescript)
+
+(defconst *jao-devon-sep* "####")
+
+(defun jao-devon-path (dvp)
+ (car (split-string dvp *jao-devon-sep*)))
+(defun jao-devon-url (dvp)
+ (cadr (split-string dvp *jao-devon-sep*)))
+(defun jao-devon-name (dvp)
+ (car (last (split-string (jao-devon-path dvp) "/"))))
+
+(defun jao-devon-make-dvp (path url) (concat path *jao-devon-sep* name))
+(defun jao-devon-dvp-p (dvp)
+ (and (stringp dvp)
+ (string-match (concat "^/.+" *jao-devon-sep*) dvp)))
+
+(defconst *jao-devon-sel-as*
+ (concat "set rs to the selection
+ set r to item 1 of rs
+ set rn to the name of r
+ set rl to the location of r
+ set ru to the URL of r
+ rl & rn & \"" *jao-devon-sep* "\" & ru"))
+
+(defun jao-devon-selection ()
+ (interactive)
+ (jao-as-tell-app "DEVONThink Pro" *jao-devon-sel-as*))
+
+(defun jao-devon-open-as (path)
+ (concat "set r to get record at \"" path "\""
+ "\n open window for record r\n activate"))
+
+(defun jao-devon-open (dvp)
+ (if (eq system-type 'darwin)
+ (let ((path (jao-devon-path dvp)))
+ (when path
+ (jao-as-tell-app "DEVONThink Pro" (jao-devon-open-as path) t)))
+ (browse-url (jao-devon-url dvp))))
+
+(provide 'jao-devon)
diff --git a/sys/jao-osd.el b/sys/jao-osd.el
new file mode 100644
index 0000000..0b2c433
--- /dev/null
+++ b/sys/jao-osd.el
@@ -0,0 +1,55 @@
+;; candy
+(defvar jao-osd-cat-color-fg "black")
+(defvar jao-osd-cat-color-bg "white")
+(defvar jao-osd-cat-font "Andika Basic 16")
+(defun jao-osd-cat-font (&optional font)
+ (or font jao-osd-cat-font))
+
+(defun jao-osd-process-args (&optional font fg bg)
+ `("-n" ,(jao-osd-cat-font font)
+ "-R" ,(or bg jao-osd-cat-color-fg) "-B" ,(or fg jao-osd-cat-color-bg)
+ "-b" "200" "-r" "255"
+ "-e" "0" "-t" "2" "-d" "10" "-p" "0" "-x" "10" "-y" "10" "-u" "5000"))
+
+(setq jao-osd-processes (make-hash-table))
+
+(defsubst jao-osd--delete-process (name)
+ (remhash name jao-osd-processes))
+
+(defun jao-osd-process (name &optional font color)
+ (let ((proc (gethash name jao-osd-processes)))
+ (or (and proc (eq (process-status proc) 'run) proc)
+ (puthash name
+ (apply 'start-process
+ `("notifications"
+ ,(format "*notifications/%s*" name)
+ "aosd_cat"
+ ,@(jao-osd-process-args)))
+ jao-osd-processes))))
+
+(defun jao-osd-cat (name lines)
+ (let* ((proc (jao-osd-process name))
+ (lines (if (listp lines) lines (list lines)))
+ (trail (- 5 (length lines))))
+ (when proc
+ (dolist (line lines)
+ (send-string proc (format "%s\n" line))))))
+ ; (when (> trail 0) (send-string proc (make-string trail ?\n))))))
+
+(defun jao-osd--names ()
+ (let (names)
+ (maphash (lambda (n k) (push n names)) jao-osd-processes)
+ (reverse names)))
+
+(defun jao-osd-kill (name)
+ (let ((proc (gethash name jao-osd-processes)))
+ (when (processp proc)
+ (kill-process proc))))
+
+(defun jao-osd-kill-notifiers ()
+ (interactive)
+ (maphash (lambda (n p) (ignore-errors (kill-process p))) jao-osd-processes)
+ (clrhash jao-osd-processes))
+
+(provide 'jao-osd)
+
diff --git a/themes/autumn-ec b/themes/autumn-ec
new file mode 100755
index 0000000..ca63787
--- /dev/null
+++ b/themes/autumn-ec
@@ -0,0 +1,40 @@
+#!/bin/bash
+
+font=${EC_TERM_FACE:-xft:Inconsolata:size=11,[codeset=iso8859-7]xft:Andale Mono:size=12}
+
+frg="grey55"
+bkg="grey1"
+bw=4
+bw=${EC_TERM_BORDER:-3}
+tr="-tr -sh 8"
+tr="+tr"
+
+exec urxvtcd -cr tomato -sl 0 +rv +ptab +ssr -b $bw -bd "$bkg" \
+ -bg "$bkg" -fg "$frg" \
+ +sbg $tr -fn "${font}" -name "emacsclient" \
+ -xrm "*colorBD: ${frg}" \
+ -xrm "*colorUL: ${frg}" \
+ -xrm "*color0: ${frg}" \
+ -xrm "*color8: grey20" \
+ -xrm "*color1: tan3" \
+ -xrm "*color9: sienna3" \
+ -xrm "*color2: peachpuff4" \
+ -xrm "*color10: navajowhite4" \
+ -xrm "*color3: grey40" \
+ -xrm "*color11: darkseagreen4" \
+ -xrm "*color4: #9D9064" \
+ -xrm "*color12: #BAA68F" \
+ -xrm "*color5: cornsilk3" \
+ -xrm "*color13: sienna4" \
+ -xrm "*color6: grey40" \
+ -xrm "*color14: tan4" \
+ -xrm "*color7: ${frg}" \
+ -xrm "*color15: grey50" \
+ -e emacsclient -t $*
+
+
+
+# fname=${EC_XTERM_FN:-Inconsolata}
+# fsize=${EC_XTERM_FS:-11}
+# exec xterm -cr tomato -sl 0 +rv -b 4 -bg "$bkg" -bd "$bkg" -fg "$frg" \
+# -bdc -ulc -u8 -fa "$fname" -fs $fsize -name "emacsclient" \
diff --git a/themes/dark-ec b/themes/dark-ec
new file mode 100755
index 0000000..caed4f4
--- /dev/null
+++ b/themes/dark-ec
@@ -0,0 +1,42 @@
+#!/bin/bash
+
+# font=${EC_TERM_FACE:-xft:Andale Mono:size=11}
+font=${EC_TERM_FACE:-xft:Inconsolata:size=11,[codeset=iso8859-7]xft:Andale Mono:size=12}
+# font=${EC_TERM_FACE:-xft:Terminus:size=12,[codeset=iso8859-7]xft:Andale Mono:size=12}
+# font=${EC_TERM_FACE:-xft:DejaVu Sans Mono:size=11}
+
+frg="grey50"
+bkg="black"
+bw=${EC_TERM_BORDER:-2}
+tr=${EC_TRANS_SPEC}
+
+exec urxvtcd -cr tomato -sl 0 +ptab +rv +ssr -b $bw -bd "$bkg" \
+ -bg "$bkg" -fg "$frg" \
+ +sbg $tr -fn "${font}" -name "emacsclient" \
+ -xrm "*colorBD: ${frg}" \
+ -xrm "*colorUL: ${frg}" \
+ -xrm "*color0: ${bkg}" \
+ -xrm "*color8: grey20" \
+ -xrm "*color1: lightgoldenrod3" \
+ -xrm "*color9: sienna3" \
+ -xrm "*color2: darkslategray" \
+ -xrm "*color10: #44836e" \
+ -xrm "*color3: grey40" \
+ -xrm "*color11: #648f81" \
+ -xrm "*color4: lightcyan4" \
+ -xrm "*color12: darkseagreen4" \
+ -xrm "*color5: paleturquoise4" \
+ -xrm "*color13: aquamarine4" \
+ -xrm "*color6: grey7" \
+ -xrm "*color14: azure4" \
+ -xrm "*color7: ${frg}" \
+ -xrm "*color15: grey50" \
+ -e emacsclient -t $*
+
+
+# -xrm "*color6: #3F4D5C" \
+
+# fname=${EC_XTERM_FN:-Inconsolata}
+# fsize=${EC_XTERM_FS:-11}
+# exec xterm -cr tomato -sl 0 +rv -b 4 -bg "$bkg" -bd "$bkg" -fg "$frg" \
+# -bdc -ulc -u8 -fa "$fname" -fs $fsize -name "emacsclient" \
diff --git a/themes/jao-dark-theme.el b/themes/jao-dark-theme.el
new file mode 100644
index 0000000..7976337
--- /dev/null
+++ b/themes/jao-dark-theme.el
@@ -0,0 +1,63 @@
+(jao-define-custom-theme jao-dark-theme
+ (:palette (fg unspecified "grey55")
+ (bg unspecified "grey2")
+ (box "yellow" "grey30")
+ (button ((c 11) nul))
+ (hilite ((c nil 8)))
+ (strike-through ((c 8)))
+ (italic ((c 13)))
+ (link ((c 5) ul))
+ (visited-link ((c 3) ul))
+ (tab-sel ((c 9 8) nbf))
+ (tab-unsel ((c 15 6) bx))
+ (comment ((c 3)))
+;; (keyword ((c 12) nbf))
+ (keyword ((c 11) nbf))
+ (type ((c 11) nbf))
+;; (function ((c 10) nbf))
+ (function ((c 10) nbf))
+ (variable-name ((c nil)))
+ (constant ((c 3)))
+ (string ((c 14)))
+ (warning ((c 1)))
+ (error ((c 9)))
+ (dimm ((c 3)))
+ (gnus-mail ((c 15 nil)))
+ (gnus-news ((c 15 nil)))
+ (outline ((c 7)))
+ (f00 ((c 5)))
+ (f01 ((c 11)))
+ (f02 ((c 10)))
+ (f10 ((p f00)))
+ (f11 ((p f01)))
+ (f12 ((p f02))))
+ (:faces (bold (c nil nil) nul)
+ (gnus-button (c nil nil) nul)
+ (gnus-summary-selected (c nil nil) ul nbf)
+ (mm-uu-extract (c nil 6))
+ (mode-line (c 7 8) nbf nul)
+ (mode-line-inactive (c 8 6) nbf nul)
+ (org-hide (c 0 nil))
+ (rcirc-other-nick (c 14))
+ (vertical-border (c 8 nil) :inherit nil)
+ (w3m-image (c 1))
+ (w3m-tab-background (c 0 0))
+ (w3m-tab-line (c 0 0))
+ (widget-button (c nil nil) nul))
+ (:x-faces (gnus-button (c nil nil) nul)
+ (gnus-summary-selected (c "grey40" nil) ul)
+ (mode-line (c 14 8) bf nul bx)
+ (mode-line-inactive (c 3 8) nbf nul bx)
+ (org-hide (c 0 nil))
+ (fringe (p dimm))
+ (rcirc-other-nick (c 6))
+ (vertical-border (c 8 nil) :inherit nil)
+ (w3m-image (c 9))
+ (w3m-tab-background (c 0 0))
+ (widget-button (c nil nil) nul))
+ (:x-colors "black" "lightgoldenrod3" "darkslategray" "grey40" "lightcyan4"
+ "paleturquoise4" "#3F4D5C" "grey55"
+ "grey20" "lightgoldenrod4" "#44836e" "#648f81" "darkseagreen4"
+ "aquamarine4" "azure4" "grey60"))
+
+(provide 'jao-dark-theme)
diff --git a/themes/jao-light-theme.el b/themes/jao-light-theme.el
new file mode 100644
index 0000000..3b826b0
--- /dev/null
+++ b/themes/jao-light-theme.el
@@ -0,0 +1,74 @@
+(jao-define-custom-theme jao-light-theme
+ (:palette (fg "black" "black")
+ (bg "white" "#efebe7")
+ (box "color-86" "antiquewhite3")
+ (button ((c 13 nil) nbf nul) (bx))
+ (hilite ((c nil 5)))
+ (strike-through ((c 1)) (st))
+ (italic ((c 4) nbf it) (dfg dbg it))
+ (link ((c 8) ul nbf))
+ (visited-link (link))
+ (tab-sel ((~ mode-line)))
+ (tab-unsel ((~ mode-line-inactive)))
+ (comment ((c 11) it)) ;; italic
+ (keyword ((c 14) nul bf))
+ (type ((c 4) nbf nul) ((c "grey30") bf))
+ (function ((c 0 nil) bf))
+ (variable-name ((c 0)))
+ (constant ((c 8)) ((c "grey40")))
+ (string ((c 10)) ((c "dark olive green")))
+ (warning ((c 9)))
+ (error ((c 1)))
+ (dimm ((c 12)))
+ (gnus-mail ((c 0)))
+ (gnus-news ((c 0)))
+ (outline ((c 0)))
+ (f00 ((c 14)))
+ (f01 ((c 10)))
+ (f02 ((c 8)))
+ (f10 ((p f00)))
+ (f11 ((p f01)))
+ (f12 ((p f02))))
+ (:faces (bold (c 80) bf)
+ (company-tooltip-common (c 1 6) nbf)
+ (company-tooltip-common-selection (~ company-tooltip-selection)
+ (c nil 6) bf)
+ (company-tooltip-selection (~ company-tooltip) bf nul)
+ (compilation-info (c nil nil) bf)
+ (diary (c 14) bf)
+ (gnus-summary-selected (c nil 79))
+ (jao-gnus-face-tree (c nil 78))
+ (header-line (c nil 79) nul)
+ (italic it)
+ (mode-line (c 0 5) nbf nul)
+ (mode-line-inactive (c 12 5) nbf nul)
+ (org-hide (c 7 nil))
+ (vertical-border (c 11 nil) :inherit nil)
+ (w3m-bold (c nil nil) bf)
+ (w3m-image (c 3))
+ (w3m-tab-background (c 12 5)))
+ (:x-faces (button (c 10 nil) nbf)
+ (gnus-button (c nil nil) nbf)
+ (company-tooltip-common (c 1 6) nbf)
+ (company-tooltip-common-selection (~ company-tooltip-selection)
+ (c nil 6) bf)
+ (company-tooltip-selection (~ company-tooltip) bf nul)
+ (compilation-info (c nil nil) bf)
+ (fringe (c 9 nil))
+ (gnus-summary-selected (c nil "white"))
+ (header-line (~ mode-line-inactive) (c 14))
+ (mode-line (c 0 7) :box (:line-width -1 :color "grey60"))
+ (mode-line-inactive (~ mode-line) (c 12))
+ (org-hide (c 7 nil))
+ (vertical-border (c 12 nil))
+ (w3m-image (c 3))
+ (w3m-tab-selected (c nil "white") nbf)
+ (w3m-tab-selected-retrieving (~ w3m-tab-selected) (c 1))
+ (w3m-tab-background (c 7 7) nul))
+ (:x-colors "black" "sienna3" "#597B59" "#D38108" "#3B3152"
+ "#E0DACC" "lightyellow3"
+ "#EFEBE7" "grey20" "orangered4" "darkslategray" "#59513A"
+ "lemonchiffon4" "#386858" "#223142" "#EFEBE7"))
+
+(provide 'jao-light-theme)
+
diff --git a/themes/jao-themes.el b/themes/jao-themes.el
new file mode 100644
index 0000000..bcedc36
--- /dev/null
+++ b/themes/jao-themes.el
@@ -0,0 +1,682 @@
+;;; palette
+(defvar jao-themes--face-family "Inconsolata")
+(defvar jao-themes--fg "black")
+(defvar jao-themes--bg "white")
+(defvar jao-themes--box "grey75")
+(defvar jao-themes--hilite nil)
+(defvar jao-themes--italic '(it))
+(defvar jao-themes--button '(ul))
+(defvar jao-themes--strike-through '(:strike-through t))
+(defvar jao-themes--outline '((c "darkslategrey")))
+(defvar jao-themes--link '((c "darkgoldenrod4")))
+(defvar jao-themes--visited-link '((c "darkolivegreen4") nul))
+(defvar jao-themes--gnus-mail '(dfg))
+(defvar jao-themes--gnus-news '(dfg))
+(defvar jao-themes--tab-sel '((c nil "grey90") bx))
+(defvar jao-themes--tab-unsel '((c "grey30" "grey85") nbf bx))
+(defvar jao-themes--comment '((c "grey30")))
+(defvar jao-themes--warning '((c "indianred3") nbf))
+(defvar jao-themes--error '((c "indianred3") bf))
+(defvar jao-themes--constant '((c "darkolivegreen") nbf))
+(defvar jao-themes--function '((c "darkolivegreen") nbf))
+(defvar jao-themes--keyword '((c "darkslategrey") nbf))
+(defvar jao-themes--string '((c "skyblue4")))
+(defvar jao-themes--type '((c "darkslategrey")))
+(defvar jao-themes--variable-name '((c "DodgerBlue4")))
+(defvar jao-themes--dimm '((c "grey30") nbf))
+(defvar jao-themes--f00 '((c "dodgerblue4")))
+(defvar jao-themes--f01 '((c "cadetblue4")))
+(defvar jao-themes--f02 '((c "darkslategrey")))
+(defvar jao-themes--f10 '((c "dodgerblue4")))
+(defvar jao-themes--f11 '((c "cadetblue4")))
+(defvar jao-themes--f12 '((c "darkslategrey")))
+
+(defsubst jao-themes--palette-face (face)
+ (intern (format "jao-themes--%s" face)))
+
+(defun jao-themes--normalize-body (body)
+ (dolist (p '(:inverse-video :underline :inherit) body)
+ (unless (member p body)
+ (setq body (append body (list p nil))))))
+
+(defun jao-themes--parse-face-body (f)
+ (cond ((null f) nil)
+ ((listp f)
+ (jao-themes--normalize-body
+ (apply 'append (mapcar 'jao-themes--parse-face-sym f))))))
+
+(defvar jao-themes--cidxs
+ '("black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"
+ "brightblack" "brightred" "brightgreen" "brightyellow" "brightblue"
+ "brightmagenta" "brightcyan" "brightwhite"))
+
+(defvar jao-themes--x-colors nil)
+
+(defun jao-themes--color (clr)
+ (cond ((stringp clr) clr)
+ ((numberp clr) (or (nth clr jao-themes--cidxs)
+ (format "color-%s" clr)))
+ (t 'unspecified)))
+
+(defun jao-themes--parse-face-sym (s)
+ (cond ((listp s)
+ (case (car s)
+ (c `(:foreground ,(jao-themes--color (cadr s))
+ :background ,(jao-themes--color (caddr s))))
+ (p (let ((var (jao-themes--palette-face (cadr s))))
+ (when (boundp var)
+ (let ((val (symbol-value var)))
+ (if (listp val)
+ (jao-themes--parse-face-body val)
+ val)))))
+ (~ (cdr (assq (cadr s) *jao--parsed-faces*)))
+ (t (list s))))
+ ((atom s)
+ (case s
+ (~ '(:inherit))
+ (dbg `(:background ,jao-themes--bg))
+ (dfg `(:foreground ,jao-themes--fg))
+ (link (jao-themes--parse-face-body jao-themes--link))
+ (vlink (jao-themes--parse-face-body jao-themes--visited-link))
+ (bf '(:bold t :weight bold))
+ (nbf '(:bold t :weight normal))
+ (it '(:italic t :slant italic))
+ (nit '(:italic nil :slant normal))
+ (niv '(:inverse-video nil))
+ (ul '(:underline t))
+ (nul '(:underline nil))
+ (st '(:strike-through t))
+ (bx `(:box (:line-width -1 :color ,jao-themes--box)))
+ (t (list s))))))
+
+(defun jao-themes--make-faces (fs &optional cidxs)
+ (let ((*jao--parsed-faces* nil)
+ (jao-themes--cidxs (or cidxs jao-themes--cidxs))
+ (result nil))
+ (dolist (f (sort (jao-themes--dfs fs) 'jao--cmp-faces) (reverse result))
+ (let ((body (jao-themes--parse-face-body (cdr f))))
+ (push (cons (car f) body) *jao--parsed-faces*)
+ (push (list (car f) body) result)))))
+
+(defun jao--cmp-faces (a b)
+ (let ((ai (cadr (assq '~ a)))
+ (bi (cadr (assq '~ b))))
+ (cond ((and ai (not bi)) nil)
+ ((and bi (not ai)) t)
+ ((eq (car a) bi) t)
+ ((eq (car b) ai) nil)
+ (t (string< (symbol-name (car a))
+ (symbol-name (car b)))))))
+
+(defun jao-themes--dfs (fs)
+ (let ((dfs
+ (append
+ `((bbdb-company)
+ (bbdb-field-name bf)
+ (bbdb-field-value nil)
+ (bbdb-name ul)
+ (bmk-mgr-bookmark-face nil)
+ (bmk-mgr-folder-face bf)
+ (bmk-mgr-sel-bookmark-face link)
+ (bmk-mgr-sel-folder-face bf)
+ (bold bf)
+ (bold-italic bf)
+ (border (c nil nil))
+ (buffer-menu-buffer bf)
+ (button (p button)))
+ `((calendar-holiday-marker (p f00))
+ (cursor (p error)))
+ `((diredp-compressed-file-suffix (~ diredp-file-suffix))
+ (diredp-date-time (p f01))
+ (diredp-deletion (p error))
+ (diredp-deletion-file-name (~ diredp-deletion))
+ (diredp-dir-heading bf dfg dbg)
+ (diredp-dir-priv dfg dbg bf)
+ (diredp-display-msg (p f00))
+ (diredp-exec-priv dfg dbg bf)
+ (diredp-executable-tag (p error))
+ (diredp-file-name dfg dbg)
+ (diredp-file-suffix (~ diredp-file-name))
+ (diredp-flag-mark (p f00) bf)
+ (diredp-flag-mark-line (p hilite))
+ (diredp-ignored-file-name (p dimm))
+ (diredp-link-priv (~ diredp-symlink))
+ (diredp-no-priv (~ diredp-read-priv))
+ (diredp-other-priv dfg dbg)
+ (diredp-rare-priv dfg dfg)
+ (diredp-read-priv dfg dbg bf)
+ (diredp-symlink (p warning))
+ (diredp-write-priv dfg dbg bf))
+ `((change-log-acknowledgement (p f02))
+ (change-log-conditionals (p f02))
+ (change-log-date (p f01))
+ (change-log-email (p f00))
+ (change-log-file (p f10))
+ (change-log-function (p function))
+ (change-log-list (p f11))
+ (change-log-name (p keyword))
+ (comint-highlight-input (p f01) nbf)
+ (comint-highlight-prompt (p f00))
+ (company-tooltip (~ highlight))
+ (company-tooltip-selection (~ company-tooltip) ul)
+ (company-tooltip-common (~ company-tooltip) bf)
+ (company-tooltip-common-selection
+ (~ company-tooltip-selection) bf)
+ (company-preview (~ highlight))
+ (company-preview-common (~ company-preview) bf)
+ (compilation-column-number (p f00) nul)
+ (compilation-error nbf (p error) nul)
+ (compilation-info nbf (p f02) nul)
+ (compilation-line-number (p f01) nul)
+ (compilation-warning nbf (p warning) nul)
+ (completions-common-part nbf :width normal)
+ (completions-first-difference bf dfg dbg)
+ (cursor dfg dbg)
+ (custom-button (~ button))
+ (custom-button-mouse (~ button))
+ (custom-button-pressed (~ button))
+ (custom-button-pressed-unraised (~ button))
+ (custom-button-unraised (~ button))
+ (custom-changed (p warning))
+ (custom-comment (p string))
+ (custom-comment-tag (p keyword))
+ (custom-documentation (p string))
+ (custom-face-tag nbf)
+ (custom-group-tag bf (p f00) :height 11)
+ (custom-group-tag-1 bf :family ,jao-themes--face-family
+ (p f00) :height 11)
+ (custom-invalid (p error))
+ (custom-link link)
+ (custom-modified (p f10))
+ (custom-rogue (p error))
+ (custom-saved ul)
+ (custom-set (p f11))
+ (custom-state (p f12))
+ (custom-themed (p f00))
+ (custom-variable-button (~ button))
+ (custom-variable-tag (p variable-name) bf)
+ (cvs-handled (p dimm)))
+ `((darcsum-change-line-face (p warning))
+ (darcsum-filename-face (p f00))
+ (darcsum-header-face (p f01))
+ (darcsum-marked-face (p f00) bf)
+ (darcsum-need-action-face (p warning))
+ (darcsum-need-action-marked-face bf (p warning))
+ (diary (p f02))
+ (diff-added (p warning))
+ (diff-changed (p f02))
+ (diff-context (p dimm))
+ (diff-file-header dfg dbg nbf)
+ (diff-function (p function))
+ (diff-header nbf dfg dbg)
+ (diff-hunk-header (~ diff-file-header))
+ (diff-index bf dfg dbg)
+ (diff-indicator-added (~ diff-added))
+ (diff-indicator-changed (~ diff-changed))
+ (diff-indicator-removed (~ diff-removed))
+ (diff-nonexistent bf (p error))
+ (diff-refine-change (~ diff-changed) ul)
+ (diff-removed (p error))
+ (dired-directory (p f02))
+ (dired-flagged bf)
+ (dired-header (p f01))
+ (dired-ignored (p dimm))
+ (dired-mark (p f00) bf)
+ (dired-marked bf (p f00))
+ (dired-symlink (p f11))
+ (dired-warn-writable (p warning))
+ (dired-warning (p warning)))
+ `((ediff-current-diff-A (~ diff-added))
+ (ediff-current-diff-Ancestor (c nil ,jao-themes--box))
+ (ediff-current-diff-B (~ ediff-current-diff-A))
+ (ediff-current-diff-C (~ ediff-current-diff-A))
+ (ediff-even-diff-A (~ diff-added) bf)
+ (ediff-even-diff-Ancestor (c nil ,jao-themes--box))
+ (ediff-even-diff-B (~ ediff-even-diff-A))
+ (ediff-even-diff-C (~ ediff-even-diff-A))
+ (ediff-fine-diff-A (~ ediff-current-diff-A) nbf ul)
+ (ediff-fine-diff-Ancestor (c nil ,jao-themes--box))
+ (ediff-fine-diff-B (~ ediff-fine-diff-A))
+ (ediff-fine-diff-C (~ ediff-fine-diff-A))
+ (ediff-odd-diff-A (~ ediff-even-diff-A))
+ (ediff-odd-diff-Ancestor (~ ediff-odd-diff-A) nbf)
+ (ediff-odd-diff-B (~ ediff-odd-diff-A))
+ (ediff-odd-diff-C (~ ediff-odd-diff-A))
+ (emms-browser-album-face (p f00) :height 1.0)
+ (emms-browser-artist-face (p f01) :height 1.0)
+ (emms-browser-composer-face (p f02) :height 1.0)
+ (emms-browser-track-face (p f10) :height 1.0)
+ (emms-browser-year/genre-face (p f11) :height 1.0)
+ (emms-metaplaylist-mode-current-face (p f00) bf)
+ (emms-metaplaylist-mode-face (p f00))
+ (emms-playlist-selected-face (p f00) bf)
+ (emms-playlist-track-face (p f00) nbf)
+ (emms-stream-name-face (p f00))
+ (emms-stream-url-face link)
+ (epa-field-body)
+ (epa-field-name bf)
+ (epa-mark bf (p f00))
+ (epa-string (p f01))
+ (epa-validity-disabled)
+ (epa-validity-high bf)
+ (epa-validity-low)
+ (epa-validity-medium)
+ (escape-glyph (p dimm))
+ (eshell-ls-archive (p f12))
+ (eshell-ls-backup (p dimm))
+ (eshell-ls-clutter (p dimm))
+ (eshell-ls-directory (p f02))
+ (eshell-ls-executable (p warning))
+ (eshell-ls-missing (p dimm))
+ (eshell-ls-product (p f01))
+ (eshell-ls-readonly (p f01) bf)
+ (eshell-ls-special bf (p f10))
+ (eshell-ls-symlink bf (p f11))
+ (eshell-ls-unreadable (p dimm))
+ (eshell-prompt (p f00)))
+ `((factor-font-lock-comment (~ font-lock-comment-face))
+ (factor-font-lock-constructor (~ font-lock-function-name-face))
+ (factor-font-lock-declaration (~ font-lock-type-face))
+ (factor-font-lock-getter-word (~ font-lock-function-name-face))
+ (factor-font-lock-parsing-word (~ font-lock-keyword-face))
+ (factor-font-lock-setter-word (~ font-lock-function-name-face))
+ (factor-font-lock-stack-effect (~ font-lock-comment-face))
+ (factor-font-lock-string (~ font-lock-string-face))
+ (factor-font-lock-symbol (~ font-lock-keyword-face))
+ (factor-font-lock-symbol-definition (~ font-lock-builtin-face))
+ (factor-font-lock-type-definition (~ font-lock-type-face))
+ (factor-font-lock-type-name (~ font-lock-type-face))
+ (factor-font-lock-vocabulary-name (~ font-lock-constant-face))
+ (factor-font-lock-word (~ font-lock-function-name-face))
+ (ffap)
+ (file-name-shadow (p dimm))
+ (fixed-pitch :family ,jao-themes--face-family)
+ (flyspell-duplicate nbf (p warning))
+ (flyspell-incorrect nbf (p error))
+ (font-lock-builtin-face (p keyword))
+ (font-lock-comment-delimiter-face (p comment))
+ (font-lock-comment-face (p comment))
+ (font-lock-constant-face (p constant))
+ (font-lock-doc-face (p comment))
+ (font-lock-function-name-face (p function))
+ (font-lock-keyword-face (p keyword))
+ (font-lock-negation-char-face nil)
+ (font-lock-preprocessor-face (p constant))
+ (font-lock-regexp-grouping-backslash bf)
+ (font-lock-regexp-grouping-construct bf)
+ (font-lock-string-face (p string))
+ (font-lock-type-face (p type))
+ (font-lock-variable-name-face (p variable-name))
+ (font-lock-warning-face (p warning))
+ (fringe nil)
+ (fuel-font-lock-debug-error (p error) nul)
+ (fuel-font-lock-debug-info (p f01) nul)
+ (fuel-font-lock-stack-region (p hilite))
+ (fuel-font-lock-xref-link link nul)
+ (fuel-font-lock-xref-vocab italic nul)
+ (fuel-font-lock-markup-link link)
+ (fuel-font-lock-markup-title (~ outline-1))
+ (fuel-font-lock-markup-emphasis (~ italic))
+ (fuel-font-lock-markup-heading (~ outline-1))
+ (fuel-font-lock-markup-strong (~ bold)))
+ `((geiser-font-lock-autodoc-current-arg (~ highlight))
+ (geiser-font-lock-autodoc-identifier
+ (~ font-lock-function-name-face))
+ (geiser-font-lock-doc-button (~ button))
+ (geiser-font-lock-doc-link link)
+ (geiser-font-lock-doc-title bf)
+ (geiser-font-lock-xref-header bf)
+ (geiser-font-lock-xref-link link nul)
+ (gnus-button (~ button))
+ (gnus-cite-attribution nil)
+ (gnus-cite-1 (p f10))
+ (gnus-cite-2 (p f11))
+ (gnus-cite-3 (p f12))
+ (gnus-cite-4 (p dimm))
+ (gnus-cite-5 (p dimm))
+ (gnus-cite-6 (p dimm))
+ (gnus-cite-7 (p dimm))
+ (gnus-cite-8 (p dimm))
+ (gnus-cite-9 (p dimm))
+ (gnus-cite-10 (p dimm))
+ (gnus-cite-11 (p dimm))
+ (gnus-emphasis-bold bf)
+ (gnus-emphasis-bold-italic bf)
+ (gnus-emphasis-highlight-words (p hilite))
+ (gnus-emphasis-italic nil)
+ (gnus-emphasis-strikethru st)
+ (gnus-emphasis-underline ul)
+ (gnus-emphasis-underline-bold bf ul)
+ (gnus-emphasis-underline-bold-italic bf ul)
+ (gnus-emphasis-underline-italic ul)
+ (gnus-group-mail-1 (p gnus-mail) bf)
+ (gnus-group-mail-1-empty (p gnus-mail) nbf)
+ (gnus-group-mail-2 (~ gnus-group-mail-1))
+ (gnus-group-mail-2-empty (~ gnus-group-mail-1-empty))
+ (gnus-group-mail-3 (~ gnus-group-mail-1))
+ (gnus-group-mail-3-empty (~ gnus-group-mail-1-empty))
+ (gnus-group-mail-4 (~ gnus-group-mail-1))
+ (gnus-group-mail-4-empty (~ gnus-group-mail-1-empty))
+ (gnus-group-mail-5 (p f00) bf)
+ (gnus-group-mail-5-empty (p f00))
+ (gnus-group-mail-6 (p dimm) bf)
+ (gnus-group-mail-6-empty (p dimm))
+ (gnus-group-mail-low bf (p dimm))
+ (gnus-group-mail-low-empty (p dimm))
+ (gnus-group-news-low bf (p dimm))
+ (gnus-group-news-low-empty (p dimm))
+ (gnus-group-news-1 (p gnus-news) bf)
+ (gnus-group-news-1-empty (p gnus-news) nbf)
+ (gnus-group-news-2 (~ gnus-group-news-1))
+ (gnus-group-news-2-empty (~ gnus-group-news-1-empty))
+ (gnus-group-news-3 (~ gnus-group-news-1))
+ (gnus-group-news-3-empty (~ gnus-group-news-1-empty))
+ (gnus-group-news-4 (~ gnus-group-news-1))
+ (gnus-group-news-4-empty (~ gnus-group-news-1-empty))
+ (gnus-group-news-5 (p f00) bf)
+ (gnus-group-news-5-empty (p f00))
+ (gnus-group-news-6 (p dimm) bf)
+ (gnus-group-news-6-empty (p dimm))
+ (gnus-header-content (p f02))
+ (gnus-header-from (p f01))
+ (gnus-header-name nbf (p f02))
+ (gnus-header-newsgroups (p dimm))
+ (gnus-header-subject (p f00) nbf)
+ (gnus-mouse-face nil)
+ (gnus-server-agent nbf)
+ (gnus-server-closed (p warning))
+ (gnus-server-denied bf (p error))
+ (gnus-server-offline (p dimm))
+ (gnus-server-opened bf)
+ (gnus-signature nit (p f10))
+ (gnus-splash dfg dbg)
+ (gnus-summary-high-undownloaded bf nit dfg dbg)
+ (gnus-summary-cancelled (p strike-through))
+ (gnus-summary-high-unread bf nit)
+ (gnus-summary-normal-ancient (p dimm))
+ (gnus-summary-normal-read (p dimm))
+ (gnus-summary-high-ticked bf nit dfg dbg)
+ (gnus-summary-low-ancient (p dimm))
+ (gnus-summary-low-read (p dimm) st)
+ (gnus-summary-low-ticked (p dimm))
+ (gnus-summary-low-unread (p dimm))
+ (gnus-summary-low-undownloaded (p dimm))
+ (gnus-summary-normal-ancient (p dimm))
+ (gnus-summary-normal-read (p dimm))
+ (gnus-summary-normal-ticked (p f10) nbf)
+ (gnus-summary-normal-undownloaded bf dfg dbg)
+ (gnus-summary-normal-unread dfg dbg)
+ (gnus-summary-selected (p hilite))
+ (gnus-x-face)
+ (gui-button-face (~ button))
+ (gui-element (~ gui-button-face)))
+ `((header-line (~ mode-line))
+ (help-argument-name)
+ (highlight (p hilite)))
+ `((ido-first-match (p warning))
+ (ido-incomplete-regexp (p error))
+ (ido-indicator (p error) nbf)
+ (ido-only-match (p f00))
+ (ido-subdir (p f01))
+ (info-header-node bf dfg)
+ (info-header-xref dfg)
+ (info-menu-header bf)
+ (info-menu-star bf dfg)
+ (info-node (p f00))
+ (info-title-1 (~ outline-1) bf)
+ (info-title-2 (~ outline-2) bf)
+ (info-title-3 (~ outline-3) bf)
+ (info-title-4 (~ outline-4) bf)
+ (info-xref link)
+ (info-xref-visited vlink)
+ (isearch bf (p hilite))
+ (isearch-fail (p error))
+ (italic (p italic)))
+ `((jabber-activity-face dbg dfg nbf)
+ (jabber-activity-personal-face (p warning) nbf)
+ (jabber-chat-error (p error))
+ (jabber-chat-prompt-foreign (p f00) nbf)
+ (jabber-chat-prompt-local (p f01) nbf)
+ (jabber-chat-prompt-system (p f02) nbf)
+ (jabber-rare-time-face (p dimm))
+ (jabber-roster-user-away (p dimm))
+ (jabber-roster-user-chatty (p warning) nbf)
+ (jabber-roster-user-offline (p dimm))
+ (jabber-roster-user-online (p f01) nbf)
+ (jabber-roster-user-xa (p dimm))
+ (jabber-title-large (~ default) bf)
+ (jabber-title-medium bf)
+ (jabber-title-roster bf (p warning))
+ (jao-emms-font-lock-album (p f01))
+ (jao-emms-font-lock-artist (p f02))
+ (jao-emms-font-lock-title (p f01))
+ (jao-emms-font-lock-track dfg dbg)
+ (jao-frm-from-face (p f00))
+ (jao-frm-mailbox-face bf)
+ (jao-frm-subject-face (p f01))
+ (jao-frm-mailno-face bf)
+ (jao-gnus-face-tree (p dimm))
+ (jde-java-font-lock-constant-face (~ font-lock-constant-face))
+ (jde-java-font-lock-doc-tag-face (p f02))
+ (jde-java-font-lock-package-face (p f02))
+ (jde-java-font-lock-link-face (p link))
+ (jde-java-font-lock-number-face (~ font-lock-constant-face))
+ (jde-java-font-lock-public-face (~ font-lock-keyword-face))
+ (jde-java-font-lock-private-face (~ font-lock-keyword-face))
+ (jde-java-font-lock-protected-face (~ font-lock-keyword-face))
+ (jde-java-font-lock-modifier-face (~ font-lock-keyword-face)))
+ `((lazy-highlight (p hilite))
+ (link link nul)
+ (link-visited vlink nul))
+ `((magit-diff-add (~ diff-added))
+ (magit-diff-del (~ diff-removed))
+ (magit-diff-file-header (~ diff-file-header))
+ (magit-diff-hunk-header (~ diff-hunk-header))
+ (magit-diff-none (p dimm))
+ (magit-item-highlight (p hilite))
+ (magit-item-mark (p warning))
+ (magit-log-head-label (p keyword) bf)
+ (magit-log-tag-label (p keyword))
+ (match (p hilite))
+ (menu nil)
+ (message-cited-text (p f01) nbf)
+ (message-header-cc (p f00) nbf)
+ (message-header-name (p f01) nbf)
+ (message-header-newsgroups (p dimm) nbf)
+ (message-header-other (p f00) nbf)
+ (message-header-subject (p f00) nbf)
+ (message-header-to (p f00) nbf)
+ (message-header-xheader (p f00) nbf)
+ (message-mml (p warning) nbf)
+ (message-separator (p warning) nbf)
+ (mm-uu-extract (p hilite))
+ (minibuffer-prompt (p f00))
+ (mode-line-buffer-id nbf (c nil nil))
+ (mode-line-emphasis (p warning))
+ (mode-line-highlight (~ mode-line))
+ (modeline-mousable (~ mode-line-active))
+ (modeline-mousable-minor-mode (~ modeline-mousable))
+ (mouse dfg dbg ul)
+ (muse-link link)
+ (muse-verbatim (p f02)))
+ `((next-error (p hilite))
+ (nobreak-space dbg dfg ul))
+ `((org-agenda-date-weekend (p dimm))
+ (org-agenda-done (p dimm))
+ (org-agenda-restriction-lock (~ default))
+ (org-agenda-structure (p f00))
+ (org-archived (p dimm))
+ (org-code (p f02))
+ (org-column dfg dbg :height 1.0)
+ (org-date (p f02) nul)
+ (org-done (p dimm) nbf niv)
+ (org-drawer (p f02))
+ (org-ellipsis (p dimm))
+ (org-formula (p f02))
+ (org-headline-done (p dimm))
+ (org-hide (c ,jao-themes--bg))
+ (org-latex-and-export-specials (~ default))
+ (org-level-1 (~ outline-1))
+ (org-level-2 (~ outline-2))
+ (org-level-3 (~ outline-3))
+ (org-level-4 (~ outline-4))
+ (org-level-5 (~ outline-5))
+ (org-level-6 (~ outline-6))
+ (org-level-7 (~ outline-7))
+ (org-level-8 (~ outline-8))
+ (org-link link)
+ (org-property-value nil)
+ (org-scheduled (p f01))
+ (org-scheduled-previously (p warning) nbf)
+ (org-scheduled-today (p f00))
+ (org-sexp-date (p f01))
+ (org-special-keyword (p keyword))
+ (org-table (p f01))
+ (org-tag (p dimm) nbf)
+ (org-target ul)
+ (org-time-grid dfg dbg)
+ (org-todo bf niv (p warning))
+ (org-upcoming-deadline (p f02))
+ (org-verbatim (p hilite))
+ (org-warning bf (p warning))
+ (outline-1 bf (p outline))
+ (outline-2 bf (p outline))
+ (outline-3 nbf (p outline))
+ (outline-4 nbf (p outline))
+ (outline-5 nbf (p outline))
+ (outline-6 nbf (p outline))
+ (outline-7 nbf (p outline))
+ (outline-8 nbf (p outline)))
+ `((query-replace bf (p hilite)))
+ `((rcirc-bright-nick (p hilite))
+ (rcirc-my-nick (p error))
+ (rcirc-nick-in-message (p error))
+ (rcirc-nick-in-message-full-line nbf)
+ (rcirc-other-nick (p keyword))
+ (rcirc-prompt bf)
+ (rcirc-server (p dimm))
+ (rcirc-timestamp (p dimm))
+ (rcirc-track-nick (~ rcirc-my-nick) niv)
+ (rcirc-url nbf link)
+ (reb-match-0 (p hilite))
+ (reb-match-1 (~ secondary-selection))
+ (reb-match-2 (~ secondary-selection) bf)
+ (reb-match-3 (~ secondary-selection) ul)
+ (region (p hilite)))
+ `((secondary-selection (p hilite))
+ (sh-quoted-exec (p f00))
+ (show-paren-match (p hilite))
+ (show-paren-mismatch (p error))
+ (slime-repl-prompt-face (p f00))
+ (slime-repl-input-face (p f00) bf)
+ (slime-repl-inputed-output-face (p f02))
+ (slime-repl-output-face (p string))
+ (speedbar-directory-face (~ diredp-dir-heading))
+ (speedbar-file-face (~ diredp-file-name))
+ (speedbar-highlight-face (p hilite))
+ (speedbar-selected-face ul)
+ (speedbar-separator-face (p f00))
+ (scroll-bar nil)
+ (shadow nil))
+ `((tool-bar nil)
+ (tooltip :family ,jao-themes--face-family (c nil "lightyellow"))
+ (trailing-whitespace (p error)))
+ `((underline nul))
+ `((variable-pitch :family ,jao-themes--face-family :height 11)
+ (vertical-border (c ,jao-themes--box nil) :inherit default))
+ `((w3m-anchor link)
+ (w3m-arrived-anchor vlink)
+ (w3m-bold bf dbg dfg)
+ (w3m-current-anchor nbf ul)
+ (w3m-form dfg dbg ul)
+ (w3m-form-button (~ button))
+ (w3m-form-button-mouse (~ custom-button-mouse))
+ (w3m-form-button-pressed (~ custom-button-pressed))
+ (w3m-header-line-location-content
+ :box (:line-width 3 :color ,jao-themes--bg) dfg dbg)
+ (w3m-header-line-location-title
+ :box (:line-width 3 :color ,jao-themes--bg) dfg dbg)
+ (w3m-history-current-url (c nil nil) ul)
+ (w3m-image (p f10))
+ (w3m-image-anchor (c nil nil))
+ (w3m-insert (p f12))
+ (w3m-italic (~ italic))
+ (w3m-linknum-match (p warning))
+ (w3m-linknum-minibuffer-prompt (~ minibuffer-prompt))
+ (w3m-session-select (p f10))
+ (w3m-session-selected bf nul (p f10))
+ (w3m-strike-through st)
+ (w3m-tab-background nul (c nil nil))
+ (w3m-tab-mouse nil)
+ (w3m-tab-selected (p tab-sel))
+ (w3m-tab-selected-background nil)
+ (w3m-tab-selected-retrieving (p tab-sel) it)
+ (w3m-tab-unselected (p tab-unsel))
+ (w3m-tab-unselected-retrieving (p tab-unsel) it)
+ (w3m-tab-unselected-unseen (p tab-unsel))
+ (w3m-underline ul)
+ (widget-button (~ button))
+ (widget-button-pressed nbf (~ custom-button-pressed))
+ (widget-button-face (~ button))
+ (widget-button-pressed-face (~ button))
+ (widget-documentation (p dimm))
+ (widget-field (p hilite) bx)
+ (widget-inactive (p dimm))
+ (Widget-single-line-field (~ widget-field))
+ (woman-bold (p f00) bf)
+ (woman-italic (p f01) nul nit)
+ (woman-italic-no-ul (p f01) nul nit)))))
+ (dolist (df dfs fs)
+ (when (not (assq (car df) fs))
+ (push df fs)))))
+
+(defsubst jao-themes--let-palette (palette xp)
+ (mapcar (lambda (f)
+ `(,(jao-themes--palette-face (car f))
+ ',(or (and xp (caddr f)) (cadr f))))
+ palette))
+
+(defun jao-themes--extract-faces (t-faces x-faces)
+ (let ((result))
+ (dolist (f t-faces (reverse result))
+ (let ((xfb (cdr (assq (car f) x-faces))))
+ (push `(,(car f) ((((type x darwin)) ,@xfb)
+ (t ,@(cdr f)))) result)))))
+
+(defun jao-themes--set-fbg (kind)
+ (let* ((kvs (cdr (assoc kind window-system-default-frame-alist)))
+ (f-alist (assq-delete-all 'background-color kvs))
+ (f-alist (assq-delete-all 'foreground-color f-alist)))
+ (when jao-themes--fg
+ (push (cons 'foreground-color jao-themes--fg) f-alist))
+ (when jao-themes--bg
+ (push (cons 'background-color jao-themes--bg) f-alist))
+ (setq window-system-default-frame-alist
+ (cons
+ (cons kind f-alist)
+ (assq-delete-all kind window-system-default-frame-alist)))))
+
+(defmacro jao-define-custom-theme (name &rest args)
+ (let ((t-faces (make-symbol "t-faces"))
+ (xfaces (make-symbol "xfaces"))
+ (tx-faces (make-symbol "tx-faces"))
+ (palette (cdr (assoc :palette args)))
+ (faces (cdr (assoc :faces args)))
+ (x-faces (cdr (assoc :x-faces args)))
+ (x-colors (cdr (assoc :x-colors args))))
+ `(let* ,(jao-themes--let-palette palette nil)
+ (jao-themes--set-fbg nil)
+ (let ((,t-faces (jao-themes--make-faces ',faces)))
+ (let* ,(jao-themes--let-palette palette t)
+ (jao-themes--set-fbg 'x)
+ (let* ((,xfaces (jao-themes--make-faces ',x-faces ',x-colors))
+ (,tx-faces (jao-themes--extract-faces ,t-faces ,xfaces)))
+ (deftheme ,name)
+ (put ',name 'theme-immediate t)
+ (apply 'custom-theme-set-faces (cons ',name ,tx-faces))
+ (provide-theme ',name)))))))
+
+(put 'jao-define-custom-theme 'lisp-indent-function 1)
+
+
+(provide 'jao-themes)
diff --git a/themes/light-ec b/themes/light-ec
new file mode 100755
index 0000000..bde38f9
--- /dev/null
+++ b/themes/light-ec
@@ -0,0 +1,40 @@
+#!/bin/bash
+
+font=${EC_TERM_FACE:-xft:Inconsolata:size=11,[codeset=iso8859-7]xft:Andale Mono:size=12,[codeset=japanese-jisx0208]xft:Andale Mono:size=12}
+ifont=${EC_TERM_FACE_ITALIC:-xft:Inconsolata-11:slant=italic}
+#font="xft:DejaVu Sans Mono-9"
+#ifont="xft:DejaVu Sans Mono-9:italic"
+
+frg="black"
+bkg="#EFEBE7"
+
+bw=${EC_TERM_BORDER:-2}
+tr=${EC_TRANS_SPEC}
+
+exec urxvtcd $tr -cr tomato +ptab -bg "$bkg" -bd "$bkg" -fg "$frg" \
+ -sl 0 +rv +ssr -b $bw +sbg -fn "${font}" -fi "${ifont}" \
+ -xrm "*colorBD: grey20" \
+ -xrm "*colorUL: grey20" \
+ -xrm "*color0: ${frg}" \
+ -xrm "*color8: grey20" \
+ -xrm "*color1: sienna3" \
+ -xrm "*color9: orangered4" \
+ -xrm "*color2: #597B59" \
+ -xrm "*color10: #254242" \
+ -xrm "*color3: #D38108" \
+ -xrm "*color11: #59513A" \
+ -xrm "*color4: #3B3152" \
+ -xrm "*color12: lemonchiffon4" \
+ -xrm "*color5: #E0DACC" \
+ -xrm "*color13: #386858" \
+ -xrm "*color6: lightyellow3" \
+ -xrm "*color14: #1F3D4F" \
+ -xrm "*color7: ${bkg}" \
+ -xrm "*color15: #EFEBE7" \
+ -name "emacsclient" \
+ -e emacsclient -t $*
+
+# fname=${EC_XTERM_FN:-Inconsolata}
+# fsize=${EC_XTERM_FS:-11}
+# exec xterm -cr tomato -sl 0 +rv -b "$bw" -bg "$bkg" -bd "$bkg" -fg "$frg" \
+# -bdc -ulc -u8 -fa "$fname" -fs $fsize \