ctableを使って, hotentry viewerの表示部分を書きなおしてみた

Emacs simple hotentry viewer - Life is very short


以前に書いた hotentry viewerを @さんの
ctableを使って表示部分を書きなおしてみました。

コード

;;; hotentry.el --- Simple hotentry viewer

;; Copyright (C) 2012 by Syohei YOSHIDA

;; Author: Syohei YOSHIDA <syohex@gmail.com>
;; URL:

;; 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:

;;; Code:

(eval-when-compile
  (require 'cl))

(require 'xml)
(require 'button)
(require 'ctable)

(defgroup hotentry nil
  "hotentry viewer"
  :group 'url
  :prefix 'hotentry:)

(defface hotentry:entry-face
  '((t (:inherit button)))
  "Face entry"
  :group 'hotentry)

(defvar hotentry:favorites '()
  "Your favorite keys. These can be completioned at inputing key")
(defvar hotentry:default-threshold 3
  "Default threshold.")
(defvar hotentry:buffer "*hotentry*")

(defun hotentry:rss-url (key threshold)
  (format "http://b.hatena.ne.jp/search/tag?q=%s&users=%d&mode=rss" key threshold))

(defun hotentry:get-command (url)
  (cond ((executable-find "curl") (format "curl -s '%s'" url))
        ((executable-find "wget") (format "wget -O - '%s'" url))
        (t (error "Please install curl or wget"))))

(defun hotentry:parse-rss (url)
  (with-temp-buffer
    (let* ((cmd (hotentry:get-command url))
           (ret (call-process-shell-command cmd nil '(t nil) nil)))
      (unless (zerop ret)
        (error (format "Download failed: %s" url)))
      (hotentry:collect-items (libxml-parse-xml-region (point-min) (point-max))))))

(defun hotentry:collect-items (xml-tree)
  (loop for elm in (cdr xml-tree)
        when (eq (car elm) 'item)
        collect
        (let ((item-value (cdr elm)))
          (loop for tag in '(title link description bookmarkcount)
                append (list tag (cadr (assoc-default tag item-value)))))))

(defun hotentry:short-description (desc limit)
  (cond ((<= (length desc) limit) desc)
        (t (concat (substring desc 0 (1- limit)) "..."))))

(defun hotentry:items-to-ctbldata (items)
  (lexical-let ((i 0))
      (mapcar (lambda (item)
                `(,(incf i)
                  ,(plist-get item 'bookmarkcount)
                  ,(plist-get item 'title)
                  ,(plist-get item 'link))) items)))

(defun hotentry:ctbl-view-items (items)
  (let ((param (copy-ctbl:param ctbl:default-rendering-param))
        (data (hotentry:items-to-ctbldata items)))
    ;; rendering parameters
    (setf (ctbl:param-fixed-header param) t)
    (let ((cp
           (ctbl:create-table-component-buffer
            :width nil :height nil
            :model
            (make-ctbl:model
             :column-model
             (list (make-ctbl:cmodel
                    :title "Index"
                    :min-width 3 :align 'right)
                   (make-ctbl:cmodel
                    :title "Bookmarks"
                    :min-width 5 :align 'right)
                   (make-ctbl:cmodel
                    :title "Title" :align 'left))
             :data data)
            :param param)))
      (ctbl:cp-add-click-hook
       cp (lambda ()
            (browse-url (car (last (ctbl:cp-get-selected-data-row cp))))))
      (pop-to-buffer (ctbl:cp-get-buffer cp)))))

(defun hotentry (key threshold)
  (interactive
   (list
    (completing-read "Key: " hotentry:favorites)
    (or (and current-prefix-arg
             (read-number "Bookmarks: " hotentry:default-threshold))
        hotentry:default-threshold)))
  (let* ((url (hotentry:rss-url key threshold))
         (items (hotentry:parse-rss url)))
    (hotentry:ctbl-view-items items)))

(provide 'hotentry)

;;; hotentry.el ends here

イメージ

Vimバインドで表を移動できたり、勝手にカーソル位置がハイライトされたり、
オシャレ度以外にも多くの部分が使いやすくなってます。


使い慣れるのは少し大変そうですが、テーブルに求める多くの機能が
提供されているので、テーブルを書く場合はぜひとも活用したい拡張です。