Ok, so let’s start.  My custom data structures are TGraphs that we develop here at our institute.  You don’t need to know more than that a graph consists of vertices, and vertices can be connected by edges.  Furthermore, both vertices and edges may have attributes.  When you use such a graph, the graph itself, every vertex, and every edge is one Java object in your memory that implements the interface Graph, Vertex, and Edge, respectively.

I wrote a nice functional Clojure API for working with TGraphs (funtg on clojars; don’t use it for serious purposes, I’m constantly changing things without thinking about compatibility at all).  So probably, if you are reading this, you are in the same situation that I was in: You have a cool data structure, you have a cool API for it, and you are totally curious what you could do with core.logic on your data structure.  So how do I get core.logic to work with my stuff???

The answer is: you have to write relations that use your existing API to access your data structure.  The topic of this posting is mainly how to doing that in a way that core.logic wants.  So let’s start with the namespace declaration for the code:

(ns extend.example
  (:refer-clojure :exclude [==])
  (:use [clojure.core.logic])
  ;; The following two are my functional API
  (:require [de.uni-koblenz.ist.funtg.core :as core])
  (:require [de.uni-koblenz.ist.funtg.funql :as funql]))

Nothing special here, except that you can see that I require my functional TGraph API using prefixes.  So when you see core/foo or funql/bar in the following, you know that I’m calling my functional API there.  As next, I added some helper functions for testing if a logic variable is fresh or ground.  Ignore the comment about being walk-ed for now.

(defn fresh?
  "Returns true, if `x' is fresh.
  `x' must have been `walk'ed before!"
  [x]
  (lvar? x))

(defn ground?
  "Returns true, if `x' is ground.
  `x' must have been `walk'ed before!"
  [x]
  (not (lvar? x)))

Then, I’ll defined a constant +graph+ that holds some example TGraph (some route map like graph).  I decided to keep the graph as a var of the namespace instead of making it a parameter of relations, because my API has no way to enumerate all graphs that happen to be in memory.  If the graph was a parameter of relations, I couldn’t be fully relational, e.g., giving only fresh logic variables to my relations would have to error.

(def +graph+ (core/load-graph "/home/horn/Repos/uni/funtg/test/greqltestgraph.tg"))

Now we’ll come to the actual first relation.  vertexo is a relation where v is a vertex in the graph +graph+.

(defn vertexo
  "A relation where `v' is a vertex."
  [v]
  (fn [a]                                 ;; (1)
    (let [gv (walk a v)]
      (if (fresh? gv)
        (to-stream                        ;; (2)
         (->> (map #(unify a v %)
                   (funql/vseq +graph+))
              (remove not)))
         (if (.containsVertex +graph+ gv)
           a
          (fail a))))))

Basically, the stuff marked with (*) is what’s important. (1) A relation must return a function which gets a so-called substitution a. You can think of it as something like an environment map which knows what logical variables are ground, and if so, what value they have. (walk a v) gets you the value of the variable (or value) v. If v is ground, then you get a value back. If v is fresh, you get a logical variable back. So now the functions fresh? and ground? above make sense, right?

The other important part (2) is that the function returned by a relation has to return a substitution again: A relation returns a function that gets a substitution and returns a substitution. to-stream turns a seq into a choice, which essentially say which possible values are allowed for the relation’s parameters. We declare such a possible binding using unify. funql/vseq returns the lazy seq of the graph’s vertices, each of which may be unified with the parameter v in the substitution a. If v was ground, then it could only be unified with the vertex it is already bound to. Because of that, it’s a good idea to filter out false values in the sequence before giving it to to-stream.

If I had put (2) directly into (1), it would work exactly the same. The additional code is for performance purposes. If v is already ground, there’s no reason to try to unify it with every vertex in the graph just to check if it is contained. Instead, a simple check (via the Java API) to see if that vertex is in the graph is enough. If it’s contained, then the substitution a is correct, so I return it “unchanged” (quotes, because of course we don’t mutate in Clojure). Else, the vertex is not in +graph+, so the binding is invalid and we fail.

That’s it. Now let’s turn to edges which are accessed with a relation of 3 parameters denoting the edge itself, its start vertex, and its end vertex.

(defn edgeo
  "A relation where `e' is an edge from `alpha' to `omega'."
  [e alpha omega]
  (fn [a]
    (let [ge     (walk a e)
          galpha (walk a alpha)
          gomega (walk a omega)]
      (cond
        (ground? ge) (unify a [alpha omega]
                            [(core/alpha ge) (core/omega ge)])
        (ground? galpha) (to-stream
                           (->> (map #(unify a [e omega] [% (core/omega %)])
                                     (funql/iseq galpha nil :out))
                                (remove not)))
        (ground? gomega) (to-stream
                           (->> (map #(unify a [e alpha] [% (core/alpha %)])
                                    (funql/iseq gomega nil :in))
                                (remove not)))
        :else (to-stream
                (->> (for [edge (funql/eseq +graph+)]
                       (unify a [e alpha omega]
                              [edge (core/alpha edge) (core/omega edge)]))
                     (remove not)))))))

Again, basically the relation would work fine if we delete everything except the expression of the :else clause.  That unifies all edges in the graph including their start and end vertices with the parameters of the relation.  The three first clauses of the cond are for performance only.  The first says, if an edge is already given, then we only check the start and end vertex, which is a constant time operation.  The second and third clause say, if either the start or end vertex are already given, then we don’t need to unify all edges in the graph with the parameters but only the edges incident to the given vertex (eseq vs. iseq), which is again much faster.

The last relation I’ll show is concerned with attributes.

(defn valueo
  "A relation where `ae' has value `val' for its `at' attribute."
  [ae at val]
  (fn [a]
    (let [gae (walk a ae)
          gat (walk a at)
          gval (walk a val)]
      (cond
        (and (ground? gae)
             (ground? gat)) (or (unify a [ae at val]
                                       [gae gat (core/value gae gat)]))
        (ground? gae) (to-stream
                        (->> (for [attr (seq (.getAttributeList
                                               (core/attributed-element-class gae)))
                                   :let [an (keyword (.getName attr))]]
                                (unify a [ae at val]
                                      [gae an (core/value gae an)]))
                             (remove not)))
        :else (to-stream
                (->> (for [elem (concat (funql/vseq +graph+)
                                        (funql/eseq +graph+))
                           attr (seq (.getAttributeList
                                       (core/attributed-element-class elem)))
                           :let [an (keyword (.getName attr))]]
                        (unify a [ae at val]
                               [elem an (core/value elem an)]))
                     (remove not)))))))

Again, only the :else part is neccessary.  I unify every vertex and every edge together with every attribute that is defined for them with the given parameters.  Clearly, that’s quite some effort.  The first clause of the cond simply looks up the attribute value if the element and the attribute name are already given.  The second clause deals with the case when at least the graph element is given, in which case only all its attribute/value pairs have to be unified.

So here are some example applications.

What are the 3 first vertices in the graph?

(run 3 [q]
  (vertexo q))
;=> (#<v1: localities.Village>
     #<v2: localities.Village>
     #<v3: localities.Town>)

Is this a vertex of the graph?

(let [v1 (core/vertex +graph+ 1)]
  (run* [q]
    (vertexo v1)))
;=> (_.0)     ; succeeded, so yes, it's a vertex of +graph+

What are the first 3 edges of the graph?

(run 3 [q]
  (fresh [a o]
    (edgeo q a o)))
;=> (#<e1: connections.Footpath>
     #<e2: connections.Footpath>
     #<e3: connections.Footpath>)

What edges end at the vertex v1?

(let [v1 (core/vertex +graph+ 1)]
  (run* [q]
    (fresh [o]
      (edgeo q o v1))))
;=> (#<e-22: localities.ContainsLocality>)

Which attribute of what element has the value 251?

(run* [q]
  (fresh [e a]
    (valueo e a 251)
    (== q [e a])))
;=> ([#<v1: localities.Village> :inhabitants])

So that village has 251 inhabitants.  Pretty small.  What’s the name of that village?

(run* [q]
  (fresh [e a]
    (valueo e a 251)
    (valueo e :name q)))
;=> ("Kammerforst")

Ah, it’s Kammerforst.  Oh, wikipedia says its population has increased to 253. ;-)

Ok, that’s it.  I hope this helps you to make your custom data structures work with core.logic. Have fun!

Seems like I am an old fart, totally Web 0.1… ;-)

For example, you edit some file, and then you want to quickly commit it. Using the code below, you can do that like this:

Here’s the code:

(defvar th-shell-popup-buffer nil)

(defun th-shell-popup ()
  "Toggle a shell popup buffer with the current file's directory as cwd."
  (interactive)
  (unless (buffer-live-p th-shell-popup-buffer)
    (save-window-excursion (shell "*Popup Shell*"))
    (setq th-shell-popup-buffer (get-buffer "*Popup Shell*")))
  (let ((win (get-buffer-window th-shell-popup-buffer))
	(dir (file-name-directory (or (buffer-file-name)
				      ;; dired
				      dired-directory
				      ;; use HOME
				      "~/"))))
    (if win
	(delete-window win)
      (pop-to-buffer th-shell-popup-buffer nil t)
      (comint-send-string nil (concat "cd " dir "\n")))))

(global-set-key (kbd "<f12>") 'th-shell-popup)

Using that, hitting F12 will popup a *Popup Shell* buffer, initialized in the directory containing the file your are currently editing. If the current buffer is not associated with a file, then the shell’s cwd is your HOME directory.

Hitting F12 while the popup shell buffer is visible will hide it again. So you can use it as a simple toggle.

The code ensures that the same shell buffer is reused over and over again (unless you kill it), so that you don’t end up with hundredth of them.

And here’s a screenshot:

UPDATES:

However, in contrast to Doug Hoyte’s defmacro! he introduced in Let over Lambda, my macro expanded into a normal defmacro form that expanded into a form where all args were evaluated exactly once.

Clearly, this was totally flawed, because in, say, new control structures, you may want to have some argument evaluated never.

So here’s a better version which allows for better control about evaluation. All args with trailing ! (BANG, in Clojure speak) will be evaluated exactly once, and the rest of the args stays under the programmer’s control (note that this version also takes a mandatory docstring):

(defn bang-symbol?
  "Returns true, if sym is a symbol with name ending in a exclamation
  mark (bang)."
  [sym]
  (and (symbol? sym)
       (= (last (name sym)) \!)))

(defmacro defmacro!
  "Defines a macro name with the given docstring, args, and body.
  All args ending in an exclamation mark (!, bang) will be evaluated only once
  in the expansion, even if they are unquoted at several places in body.  This
  is especially important for args whose evaluation has side-effecs or who are
  expensive to evaluate."
  [name docstring args & body]
  (let [bang-syms (filter bang-symbol? args)
        rep-map (apply hash-map
                       (mapcat (fn [s] [s `(quote ~(gensym))])
                               bang-syms))]
    `(defmacro ~name
       ~docstring
       ~args
       `(let ~~(vec (mapcat (fn [[s t]] [t s]) rep-map))
          ~(clojure.walk/postwalk-replace ~rep-map ~@body)))))

Using that, we can now easily implement the numeric if, nif, you can find in On Lisp and Let over Lambda:

(defmacro! nif
  "Numeric if: evals test! (only once) and executes either pos, zero, or neg
  depending on the result."
  [test! pos zero neg]
  `(cond
    (pos? ~test!)  ~pos
    (zero? ~test!) ~zero
    :else          ~neg))

When evaluating (nif 1 (println "pos") (println "zero") (println "neg")), now there’s only “pos” printed. With the previous defmacro! version, “pos”, “zero”, and “neg” were printed.

UPDATE: Stefan Kamphausen noticed that defmacro! doesn’t work as intended if destructuring is done in the argument list. So here’s yet another version that flattens the argument list when collecting the bang-symbols.

(defmacro defmacro!
  "Defines a macro name with the given docstring, args, and body.
  All args ending in an exclamation mark (!, bang) will be evaluated only once
  in the expansion, even if they are unquoted at several places in body.  This
  is especially important for args whose evaluation has side-effecs or who are
  expensive to evaluate."
  [name docstring args & body]
  (let [bang-syms (filter bang-symbol? (flatten args)) ;; <==
        rep-map (apply hash-map
                       (mapcat (fn [s] [s `(quote ~(gensym))])
                               bang-syms))]
    `(defmacro ~name
       ~docstring
       ~args
       `(let ~~(vec (mapcat (fn [[s t]] [t s]) rep-map))
          ~(clojure.walk/postwalk-replace ~rep-map ~@body)))))

Using that, you can define a strange nif variant that wants a vector, where the first entry is a vector containing the test, and the second entry is a vector of the pos, zero, neg entries.

(defmacro! strange-nif
  "Like nif, but with strange destructuring"
  [[[test!] [pos zero neg]]]
  `(cond
    (pos? ~test!)  ~pos
    (zero? ~test!) ~zero
    :else          ~neg))

;; Trying it...
user> (strange-nif [[1] [:pos :zero :neg]])
:pos
user> (macroexpand '(strange-nif [[1] [:pos :zero :neg]]))
(let [G__1974 1]
     (cond (pos? G__1974) :pos (zero? G__1974) :zero :else :neg))

user> (defmacro square [x] `(* ~x ~x))
#'user/square
user> (square 5)
25

At a first glance, it seems to work. But see what happens here:

user> (def c (let [a (atom 4)] #(swap! a inc)))
#'user/c

This defines a counter function, which will increase it’s count on every call. Now let’s feed that to our macro:

user> (square (c))
30

Oh, shouldn’t that be 25, because we’re increasing our counter to 5? No, because the macroexpansion is

user> (macroexpand-1 '(square (c)))
(clojure.core/* (c) (c))

So our counter is increased twice resulting in (* 5 6). The lesson to be learned is that when writing a macro, one should take care that every argument is evaluated once, i.e., if you feel the need to unquote an argument more than once, you have to let-bind its value to some gensym and use that later on. This is a fixed version of the square macro.

user> (defmacro square [x] `(let [x# ~x] (* x# x#)))
#'user/square
user> (macroexpand-1 '(square (c)))
(clojure.core/let [x__5139__auto__ (c)]
  (clojure.core/* x__5139__auto__ x__5139__auto__))

As you can see, now our counter is incremented only once, and its new value is bound to a generated variable which is used in the body.

But why not do exactly that by default? Here’s a macro that does that:

(defmacro defmacro!
  "Defines a macro in which all args are evaled only once."
  [name args & body]
  (let [rep-map (apply hash-map
                       (mapcat (fn [s] [s `(quote ~(gensym))])
                               args))]
    `(defmacro ~name ~args
       `(let ~~(vec (mapcat (fn [[s t]] [t s]) rep-map))
          ~(clojure.walk/postwalk-replace ~rep-map ~@body)))))

Using this macrowriting macro, we can now safely use our first implementation of square:

user> (defmacro! square [x]
  `(* ~x ~x))
#'user/square
user> (macroexpand-1 '(square (c)))
(clojure.core/let [G__5491 (c)] (clojure.core/* G__5491 G__5491))
user> (square (c))
49

Great, seems to work.

UPDATE: This version of defmacro! has one serious design flaw. The completely expanded form will evaluate all arguments exactly once, but often you want to be able to have some argument evaluated never. See this sequel post for an enhanced version.

Awesome has a lua library called naughty for displaying notifications. Now my idea was that whenever my mouse pointer enters the region of the textbox widget that shows the current date and time in a wibox, a popup should show the agenda for this week and dispose automatically when I move the mouse away.

Ok, so here’s the code on the emacs side. It assures that the file /tmp/org-agenda.txt always contains a plain-text export of the current org agenda. It’s created once on emacs startup and after each change to any org agenda file it’ll be updated.

;; update agenda file after changes to org files
(defun th-org-mode-init ()
  (add-hook 'after-save-hook 'th-org-update-agenda-file t t))

(add-hook 'org-mode-hook 'th-org-mode-init)

;; that's the export function
(defun th-org-update-agenda-file (&optional force)
  (interactive)
  (save-excursion
    (save-window-excursion
      (let ((file "/tmp/org-agenda.txt"))
        (org-agenda-list)
        (org-write-agenda file)))))

;; do it once at startup
(th-org-update-agenda-file t)

And here’s the lua code on the awesome side:

-- the current agenda popup
org_agenda_pupup = nil

-- do some highlighting and show the popup
function show_org_agenda ()
   local fd = io.open("/tmp/org-agenda.txt", "r")
   if not fd then
      return
   end
   local text = fd:read("*a")
   fd:close()
   -- highlight week agenda line
   text = text:gsub("(Week%-agenda[ ]+%(W%d%d?%):)", "<span style="text-decoration: underline;">%1</span>")
   -- highlight dates
   text = text:gsub("(%w+[ ]+%d%d? %w+ %d%d%d%d[^n]*)", "%1")
   -- highlight times
   text = text:gsub("(%d%d?:%d%d)", "%1")
   -- highlight tags
   text = text:gsub("(:[^ ]+:)([ ]*n)", "%1%2")
   -- highlight TODOs
   text = text:gsub("(TODO) ", "<strong>%1</strong> ")
   -- highlight categories
   text = text:gsub("([ ]+%w+:) ", "%1 ")
   org_agenda_pupup = naughty.notify(
      { text     = text,
        timeout  = 999999999,
        width    = 600,
        position = "bottom_right",
        screen   = mouse.screen })
end

-- dispose the popup
function dispose_org_agenda ()
   if org_agenda_pupup ~= nil then
      naughty.destroy(org_agenda_pupup)
      org_agenda_pupup = nil
   end
end

mydatebox = widget({ type = "textbox", align = "right" }) -- shows the date
mydatebox.mouse_enter = show_org_agenda
mydatebox.mouse_leave = dispose_org_agenda

-- after that the mydatebox is added to some wibox, of course...

And that’s how it looks like.

The Org Agenda in an Awesome/Naughty popup

One cool thing is that org-remember automatically inserts a link to the “thing” you had open when adding the note. This “thing” could be a info buffer, a mail, a usenet article, an image,…

I thought it would be nice to use that facility to make TODO-bookmarks like “TODO read that great blog entry!” from inside my browser conkeror. And so I did.

Here’s the emacs side of the code (put it in your ~/.emacs):

(setq org-remember-templates
      '(
        ;; lot of other templates...
        ("TODO"    ?t "* TODO %?
  :PROPERTIES:
  :created: %U
  :link: %a
  :END:
  %i")))

(defun th-org-remember-conkeror (url)
  (interactive "s")
  (org-remember nil ?t)
  (save-excursion
    (insert "\n\n  [[" url "]]"))
  (local-set-key (kbd "C-c C-c")
         (lambda ()
           (interactive)
           (org-ctrl-c-ctrl-c)
           (delete-frame nil t))))

And that’s the conkeror side (put it in your ~/.conkerorrc):

function org_remember(url, window) {
    var cmd_str = 'emacsclient -c --eval \'(th-org-remember-conkeror "' + url + '")\'';
    if (window != null) {
    window.minibuffer.message('Issuing ' + cmd_str);
    }
    shell_command_blind(cmd_str);
}

interactive("org-remember", "Remember the current url with org-remember",
        function (I) {
        org_remember(I.buffer.display_URI_string, I.window);
        });

This code may require emacs 23, I’m not too sure. What you need in every case is a running emacs server, so that you can connect to it with emacsclient.

UPDATE: Now I use org-protocol instead of something home-brewn.

Here’s the updated code for your ~/.conkerorrc. On the emacs side nothing is needed anymore.

function org_remember(url, title, text, window) {
    var eurl = encodeURIComponent(url);
    var etitle = encodeURIComponent(title);
    var etext = encodeURIComponent(text);
    var cmd_str = "emacsclient -c org-protocol://remember://" + eurl + "/" + etitle + "/" + etext;
    window.minibuffer.message("Issuing " + cmd_str);
    shell_command_blind(cmd_str);
}

interactive("org-remember", "Remember the current url with org-remember",
        function (I) {
          org_remember(I.buffer.display_uri_string,
                       I.buffer.document.title,
                       I.buffer.top_frame.getSelection(),
                       I.window);
        });

Because I want to do all my system administration (editing files in /etc/) with emacs and don’t want to start another emacs instance as root, I use TRAMP to switch to superuser mode automagically if the opened file is read-only.

Here’s the code (UPDATED: Uses defadvice instead of hooking into find-file-hook, which had the bad effect of find-file-hook running twice.):

(defun th-rename-tramp-buffer ()
  (when (file-remote-p (buffer-file-name))
    (rename-buffer
     (format "%s:%s"
             (file-remote-p (buffer-file-name) 'method)
             (buffer-name)))))

(add-hook 'find-file-hook
          'th-rename-tramp-buffer)

(defadvice find-file (around th-find-file activate)
  "Open FILENAME using tramp's sudo method if it's read-only."
  (if (and (not (file-writable-p (ad-get-arg 0)))
           (y-or-n-p (concat "File "
                             (ad-get-arg 0)
                             " is read-only.  Open it as root? ")))
      (th-find-file-sudo (ad-get-arg 0))
    ad-do-it))

(defun th-find-file-sudo (file)
  "Opens FILE with root privileges."
  (interactive "F")
  (set-buffer (find-file (concat "/sudo::" file))))

Now whenever I type ec /some/file/i/have/no/permissions/to/write (or emacsclient [-c|-t] /some/root/file, emacs asks me to re-open it using TRAMP’s sudo method.

(defun th-calendar-open-agenda ()
  (interactive)
  (let* ((calendar-date (or
                         ;; the date at point in the calendar buffer
                         (calendar-cursor-to-date)
                         ;; if there's none, use the curren date
                         (calendar-current-date)))
         (day (time-to-days (encode-time 1 1 1
                                         (second calendar-date)
                                         (first calendar-date)
                                         (third calendar-date))))
         (calendar-buffer (current-buffer)))
    (org-agenda-list nil day)
    (select-window (get-buffer-window calendar-buffer))))

(define-key calendar-mode-map (kbd "RET") 'th-calendar-open-agenda)

And here’s a small minor mode which uses the function above to refresh the agenda buffer when you move point in the calendar buffer, so calendar and agenda stay in sync.

(define-minor-mode th-org-agenda-follow-calendar-mode
  "If enabled, each calendar movement will refresh the org agenda
buffer."
  :lighter " OrgAgendaFollow"
  (if (not (eq major-mode 'calendar-mode))
      (message "Cannot activate th-org-agenda-follow-calendar-mode in %s." major-mode)
    (if th-org-agenda-follow-calendar-mode
        (add-hook 'calendar-move-hook 'th-calendar-open-agenda)
      (remove-hook 'calendar-move-hook 'th-calendar-open-agenda))))

(add-hook 'calendar-mode-hook 'th-org-agenda-follow-calendar-mode)

Another thing I added to calendar is the display of the week-of-year in the mode-line.

(add-to-list 'calendar-mode-line-format
             '(let ((day (nth 1 date))
                    (month (nth 0 date))
                    (year (nth 2 date)))
                (format-time-string "Week of year: %V"
                                    (encode-time 1 1 1 day month year))))

It looks like this.

It has two lines. The first displays the path of the current working directory, then the user and hostname, then the return value of the last executed command, and the last item is the command’s number in the history.

The second line displays a green smiley, if the last command worked well, or a red smiley, if it failed.

I took some inspirations from the prompt of strcat, see http://www.echox.de/blog/archives/74-ZSH-Prompt.html.