Top | Wiki | Blog | Github  

ユーティリティ関数群

init.el に記述していた便利関数を,utility.el として分離しています.init.el では autoload を用いて utility.el を遅延読み込みするように設定してます.このようなファイルの分離で60[ms]ほど起動を高速化できます.

注意:コピペだけでは動かない可能性があります.

orgバッファを評価

org-buffer を評価して Emacs の設定ファイルを生成/読み込みまでを自動化します.この設定では, init.orgutility.org の2つのバッファでのみ評価されるようになっています.

(defun eval-org-buffer ()
  "Load init.org/utility.org and tangle init.el/utility.el."
  (interactive)
  (when (and (eq major-mode 'org-mode)
             (or (string= (buffer-name) "init.org")
                 (string= (buffer-name) "utility.org")))
    (org-babel-tangle)
    (let ((tangled-file
           (concat (file-name-sans-extension (buffer-file-name)) ".el")))
      (when (file-exists-p tangled-file)
        (load tangled-file)
        (byte-compile-file tangled-file)))))

ユーティリティ関数

サボっていると Kyoko さんに怒られる

MacOS 用の関数です.別途,Kyoko さんの音声をインストールしておく必要があります.Mavericks だと,Otoya さんも使えます.

(defvar kyoko-mad-mode nil)
(defun kyoko-mad-mode-toggle ()
  (interactive)
  (setq kyoko-mad-mode (not kyoko-mad-mode))
  (cond (kyoko-mad-mode
         (message "Kyoko mad mode: ON"))
        (t
         (message "Kyoko mad mode: OFF"))))
;; She will be mad if you do nothing within 10 min.
(run-with-idle-timer
 600 t
 '(lambda ()
    (when kyoko-mad-mode
      (shell-command-to-string
       "say -v Kyoko おいおまえ,遊んでないで,仕事しろ"))))

org-buffer を dokuwiki 形式に変換し,kill-ring に格納

外部プログラムorg2dokuwiki.plを使います.

(defun org2dokuwiki-cp-kill-ring ()
  "Convert the current org-file to dokuwiki text, and copy it to kill-ring."
  (interactive)
  (when (eq major-mode 'org-mode)
    (cond (buffer-file-name
           (kill-new
            (shell-command-to-string
             (concat "cat " buffer-file-name "| perl "
                     (expand-file-name "~/Dropbox/scripts/org2dokuwiki.pl"))))
           (message "Copying %s ... done" buffer-file-name)
           (sit-for 1.5)
           (message ""))
          (t (message "There is NOT such a file.")))))

コンソールでカレントバッファのあるディレクトリに移動する

Finder で開きたいだけならば, M-! でミニバッファに open . と打ち込むだけです.

  (defcustom open-current-directory-console-program "iTerm2.app"
    "Specify a console program"
    :type 'string
    :group 'takaxp-mac)
 
  (defun open-current-directory ()
    " Open Current Directory for MacOSX
    0) Put this function in your .emacs
    1) M-x open-current-directory
    2) Terminal will open automatically
    3) Type M-v to paste and move to a path to the current directory in Emacs"
    (interactive)
    (let ((file-path (buffer-file-name (current-buffer))))
      (unless (string= file-path nil)
        (let ((directory
              (substring file-path 0
                         (-
                          (length file-path)
                          (length (buffer-name (current-buffer)))))))
          (message "%s" directory)
          (shell-command-to-string (concat "echo cd " directory " |pbcopy"))
          (shell-command-to-string
           (concat "open -a " open-current-directory-console-program))))))

C-x C-c で容易にEmacsを終了させないように質問する

C-x C-c をこの関数に割り当てると,任意の質問文で入力を求められる.

;;; Cite: http://flex.ee.uec.ac.jp/texi/emacs-jp/emacs-jp_12.html
;;; Cite: http://d.hatena.ne.jp/Ubuntu/20090417/1239934416
;; A simple solution is (setq confirm-kill-emacs 'y-or-n-p).
(defun confirm-save-buffers-kill-emacs (&optional arg)
  "Show yes or no when you try to kill Emacs"
  (interactive "P")
  (cond (arg (save-buffers-kill-emacs))
        (t
         (when (yes-or-no-p "Are you sure to quit Emacs now? ")
           (save-buffers-kill-emacs)))))

代替方法として,

(setq confirm-kill-emacs 'y-or-n-p)  

がある.

キーバインド

Show yes or no when you try to kill Emacs

;(global-set-key (kbd "C-x C-c") 'confirm-save-buffers-kill-emacs)

ファイルに含まれるテーブルを使って定時にgrowlのアラートを表示する

  (defun set-alarms-from-file (file)
    "Make alarms from org-mode tables. If you have an org-mode file
     with tables with the following format:
  |----+--------+----------------------------------------------------------|
  | ID |   Time | Content                                                  |
  |----+--------+----------------------------------------------------------|
  |  1 |  07:00 | Wakeup                                                   |
  |  2 |        | Read papers                                              |
  |  3 |  12:00 | Clean up your desk                                       |
  When it is 7:00 and 12:00, Growl notify with a message which is specified
  content column from the table. The line ID number is 2 will be ignored."
       (let
           ((lines (read-line file)))
         (while lines
           (set-alarm-from-line (decode-coding-string (car lines) 'utf-8))
           (setq lines (cdr lines))
           (message ""))))
 
     (defun set-alarm-from-line (line)
       "NOTE: this function need (require 'todochiku)"
       (when (require 'todochiku nil t)
         (let
             ((hour nil)
              (min nil)
              (current-hour nil)
              (current-min nil)
              (action nil))
           (when (string-match "\\([0-2]?[0-9]\\):\\([0-5][0-9]\\)" line)
             (setq hour (substring line (match-beginning 1) (match-end 1)))
             (setq min (substring line (match-beginning 2) (match-end 2)))
             (when (string-match
                    "\|\\s-*\\([^\|]+[^ ]\\)\\s-*\|$" line (match-end 2))
               (setq action
                     (substring line (match-beginning 1) (match-end 1)))))
           (when (and (and hour min) action)
             ;;       (message "[%s:%s] => %s" hour min action)
             (setq current-hour (format-time-string "%H" (current-time)))
             (setq current-min (format-time-string "%M" (current-time)))
             (when (> (+ (* (string-to-number hour) 60)
                         (string-to-number min))
                      (+ (* (string-to-number current-hour) 60)
                         (string-to-number current-min)))
               (run-at-time (format "%s:%s" hour min) nil
                            'todochiku-message
                            "== REMINDER =="
                            (format "%s:%s %s" hour min action)
                            "Emacs" 'sticky))))))
 
     (defun read-line (file)
       "Make a list from a file, which is divided by LF code"
       (with-temp-buffer
         (insert-file-contents-literally file)
         (split-string
          (buffer-string) "\n" t)))

頻繁に利用するファイルをring形式でたどる

http://d.hatena.ne.jp/rubikitch/20111120/elispbook

  (defvar my-file-ring nil)
  (defun takaxp:make-file-ring (files)
    (setq my-file-ring (copy-sequence files))
    (setf (cdr (last my-file-ring)) my-file-ring))
  (takaxp:make-file-ring
   '("~/Dropbox/org/next.org" "~/Dropbox/org/work.org"
     "~/Dropbox/emacs.d/config/init.org" "~/Dropbox/org/buffer.org"
     "~/Dropbox/emacs.d/config/utility.org" "~/Dropbox/org/research.org"))
 
  (defun takaxp:open-file-ring ()
    (interactive)
    (find-file (car my-file-ring))
    (setq my-file-ring (cdr my-file-ring)))

引数のorgバッファを開く

(defun show-org-buffer (file)
  "Show an org-file on the current buffer"
  (interactive)
  (if (get-buffer file)
      (let ((buffer (get-buffer file)))
        (switch-to-buffer buffer)
        (message "%s" file))
    (find-file (concat "~/Dropbox/org/" file))))

orgバッファにいつものヘッダを追加する

(defun insert-org-file-header-template ()
  (interactive)
  (when (string= major-mode 'org-mode)
    (let ((title "#+TITLE:\t\n")
          (date "#+DATE:\t\tLast Update: \n")
          (author "#+AUTHOR:\tTakaaki ISHIKAWA <takaxp@ieee.org>\n")
          (other "\n"))
      (save-excursion
        (goto-char 0)
        (insert title date author other)))))

議事録ひな形を書き入れる

(defun insert-minutes-template ()
  (interactive)
  (when (string= major-mode 'org-mode)
    (let ((date "日時:\n")
          (place "場所:\n")
          (attendance "出席者:\n")
          (documents "資料:\n\n"))
      (save-excursion
        (insert date place attendance documents)))))

ランダムの文字列を取得する

引数で桁数を渡すと,ランダムな数値の文字列を取得できます.org-mode で適当なタイトルのツリーを生成したい時に使っています.

(defun get-random-string (length)
  "Get a string contain the length digit number with random selection"
  (interactive)
  (random t)
  (cond ((> length 0)
         (let
             ((count length)
              (string nil)
              (tmp nil))
           (while (< 0 count)
             (setq count (1- count))
             (setq tmp string)
             (setq string
                   (concat tmp (number-to-string (random 10)))))
           (message "%s" string)))
        (t "0")))

Auto-install をセットアップする

いつも auto-install を使うわけではないので,必要時に init-auto-install を実行してパラメータを設定してから auto-install でパッケージを取得するようにしています.

(defun init-auto-install ()
  "Setup auto-install.el.
1. Set my-auto-install-batch-list-el-url
2. M-x init-auto-install
3. M-x auto-install-batch hoge"
  (interactive)
  (when (and (require 'auto-install nil t)
             my-auto-install-batch-list-el-url)
    (setq auto-install-batch-list-el-url my-auto-install-batch-list-el-url)
    (setq auto-install-directory default-path)
    (setq auto-install-wget-command "/opt/local/bin/wget")
    (auto-install-update-emacswiki-package-name t)
    ;; compatibility
    (auto-install-compatibility-setup))) ; for install-elisp users

行頭に" - "を挿入する

(defun add-itemize-head (arg)
  "Insert \"  - \" at the head of line.
  If the cursor is already at the head of line, it is NOT returned back to the
  original position again. Otherwise, the cursor is moved to the right of the
  inserted string. \"  - [ ] \" will be inserted using C-u prefix."
  (interactive "P")
  (let ((item-string "  - "))
    (when arg
      (setq item-string "  - [ ] "))
    (cond ((= (point) (line-beginning-position))
           (insert item-string))
          (t (save-excursion
               (move-beginning-of-line 1)
               (insert item-string))))))

キーバインド

C-u C-M-- とすれば,[ ] を付加できます.

(global-set-key (kbd "C-M--") 'add-itemize-head)

日付などを簡単に挿入する

http://www.fan.gr.jp/~ring/doc/elisp_20/elisp_38.html#SEC608

(defun insert-formatted-current-date (arg)
  "Insert a timestamp at the cursor position. C-u will add [] brackets."
  (interactive "p")
  (case arg
    (4 (if (equal major-mode 'org-mode)
           (org-time-stamp-inactive)
         (insert (format-time-string "[%Y-%m-%d]"))))
    (t (insert (format-time-string "%Y-%m-%d")))))
(defun insert-formatted-current-time ()
  (interactive)
  (insert (format-time-string "%H:%M")))
(defun insert-formatted-signature ()
  (interactive)
  (insert (concat (format-time-string "%Y-%m-%d") "  " user-full-name
                  "  <" user-mail-address ">")))

キーバインド

(global-set-key (kbd "C-0") 'insert-formatted-current-date)
(global-set-key (kbd "C--") 'insert-formatted-current-time)
(global-set-key (kbd "C-=") 'insert-formatted-signature)

XHTMLを利用したガントチャート生成

最近使っていません.

  (defcustom my-auto-install-batch-list-el-url nil
    "URL of a auto-install-batch-list.el"
    :type 'string
    :group 'takaxp-utility)
 
  ;; Publish an xml file to show a Gantt Chart
  (defcustom default-timeline-csv-file nil
    "source.csv"
    :type 'string
    :group 'takaxp-utility)
 
  (defcustom default-timeline-xml-business-file nil
    "XML file for business schedule"
    :type 'string
    :group 'takaxp-utility)
 
  (defcustom default-timeline-xml-private-file nil
    "XML file for private schedule"
    :type 'string
    :group 'takaxp-utility)
 
  (defcustom default-timeline nil
    "a template index.html"
    :type 'string
    :group 'takaxp-utility)
 
  (defun export-timeline-business ()
    "Export schedule table as an XML source to create an web page"
    (interactive)
    (when (and default-timeline
               (and default-timeline-csv-file
                    default-timeline-xml-business-file))
      (shell-command-to-string (concat "rm -f " default-timeline-csv-file))
      (org-table-export default-timeline-csv-file "orgtbl-to-csv")
      (shell-command-to-string (concat "org2gantt.pl > "
                                       default-timeline-xml-business-file))
      (shell-command-to-string (concat "open " default-timeline))))
 
  (defun export-timeline-private ()
    "Export schedule table as an XML source to create an web page"
    (interactive)
    (when (and default-timeline
               (and default-timeline-csv-file
                    default-timeline-xml-private-file))
      (shell-command-to-string (concat "rm -f " default-timeline-csv-file))
      (org-table-export default-timeline-csv-file "orgtbl-to-csv")
      (shell-command-to-string (concat "org2gantt.pl > "
                                       default-timeline-xml-private-file))
      (shell-command-to-string (concat "open " default-timeline))))

定期実行関数

orgバッファからカレンダーを生成し,外部サーバに投げます.また,MobileOrgに最新情報を流しています.

  (run-with-idle-timer 600 t 'reload-ical-export)
  (run-with-idle-timer 1000 t 'org-mobile-push)
 
  (defun reload-ical-export ()
    "Export org files as an iCal format file"
    (interactive)
    (when (string= major-mode 'org-mode)
      (my-ox-icalendar)))

ブラウザの設定

;; http://stackoverflow.com/questions/4506249/how-to-make-emacs-org-mode-open-links-to-sites-in-google-chrome
;; http://www.koders.com/lisp/fidD53E4053393F9CD578FA7D2AA58BD12FDDD8EB89.aspx?s="skim
(defun browse-url-chrome (url &optional new-window)
  "Set default browser to open a URL"
  (interactive (browse-url-interactive-arg "URL: "))
  (start-process "google-chrome" nil "google-chrome" url))
;; Open a link with google-chrome for Linux
(when (not (eq window-system 'ns))
  (setq browse-url-browser-function 'browse-url-generic
        browse-url-generic-program "google-chrome")
)
;(setq browse-url-browser-function 'browse-url-default-macosx-browser)
;(setq browse-url-browser-function 'browse-url-default-windows-browser)
;(setq browse-url-browser-function 'browse-url-chrome)

その他

  ;;; Test function from GNU Emacs (O'REILLY, P.328)
  (defun count-words-buffer ()
    "Count the number of words in the current buffer"
    (interactive)
    (save-excursion
      (let ((count 0))
        (goto-char (point-min))
        (while (< (point) (point-max))
          (forward-word 1)
          (setq count (1+ count)))
        (message "buffer contains %d words." count))))
 
  ;;; Test function for AppleScript
  ;;; Cite: http://sakito.jp/emacs/emacsobjectivec.html
  (defun do-test-applescript ()
    (interactive)
    (do-applescript
     (format
      (concat
       "display dialog \"Hello world!\" \r"))))

未設定/テスト中

byte-compile の警告を抑制する

;; Avoid warning (for sense-region)
;; Warning: 'mapcar' called for effect; use 'mapc' or 'dolist' insted
(setq byte-compile-warnings
      '(free-vars unresolved callargs redefine obsolete noruntime
		  cl-functions interactive-only make-local))

[window-resizer.el] 分割したウィンドウサイズを変更する

http://d.hatena.ne.jp/khiker/20100119/window_resize

以下の警告を参考に書き換えた.

In my-window-resizer:
utility.el:333:23:Warning: `last-command-char' is an obsolete variable (as of
    Emacs at least 19.34); use `last-command-event' instead.
(defun my-window-resizer ()
  "Control window size and position."
  (interactive)
  (let ((window-obj (selected-window))
        (current-width (window-width))
        (current-height (window-height))
        (dx (if (= (nth 0 (window-edges)) 0) 1
              -1))
        (dy (if (= (nth 1 (window-edges)) 0) 1
              -1))
        action c)
    (catch 'end-flag
      (while t
        (setq action
              (read-key-sequence-vector (format "size[%dx%d]"
                                                (window-width)
                                                (window-height))))
        (setq c (aref action 0))
        (cond ((= c ?l)
               (enlarge-window-horizontally dx))
              ((= c ?h)
               (shrink-window-horizontally dx))
              ((= c ?j)
               (enlarge-window dy))
              ((= c ?k)
               (shrink-window dy))
              ;; otherwise
              (t
               (let ((last-command-event (aref action 0))
                     (command (key-binding action)))
                 (when command
                   (call-interactively command)))
               (message "Quit")
               (throw 'end-flag t)))))))

[idle-requie]

(require 'idle-require)
(idle-require-mode 1)

[pdf-preview]

(require 'pdf-preview)

[EasyPG]

(when (require 'epa-setup nil t)
  (epa-file-enable))

[eblook]

;; eblook
(when (require 'eblook nil t)
  (autoload 'edict-search-english "edic"
    "Search for a translation of an English word" t)
  (autoload 'edict-search-kanji "edict"
    "Search for a translation of a Kanji sequence" t)
  (setq *edict-files* '("/Users/taka/Dropbox/Dic/LDOCE4"))
  (setq *edict-files* '("/Users/taka/Downloads/edict/edict")))

[iBuffer]

iBuffer で list-buffers をオーバーライド(C-x C-b で表示)

(defalias 'list-buffers 'ibuffer)

キーバインド

;; Multiple combination
; Editing with a rectangle region
(global-set-key (kbd "C-x r C-SPC") 'rm-set-mark)
(global-set-key (kbd "C-x r C-x") 'rm-exchange-point-and-mark)
(global-set-key (kbd "C-x r C-w") 'rm-kill-region)
(global-set-key (kbd "C-x r M-w") 'rm-kill-ring-save)

provide

(provide 'utility)

Comments