Emacsのヘルプ

Emacsに助けを求めるためのコマンド。

apropos,find-functionあたりはよく使ってます。

情報を表示する

describe-ほげほげコマンド。色々な情報を表示してくれます。

たくさんありそうなのでEmacsLispを書くときに使いそうなものを列挙。

- describe-bindings キーシーケンスのコマンド(Anythingが入ってると一覧表示してくれる) - describe-function 指定した関数の情報 - describe-variable 指定した変数の情報 - describe-char カーソル位置にある文字の情報(文字コードなど)

定義場所を探す

Emacs Lispの関数や変数が定義された場所を探すコマンド。

- find-function 指定した関数の定義された場所に飛ぶ - find-function-at-point カーソル位置にある関数の定義された場所に飛ぶ - find-function-other-frame find-functionの結果を別フレームに表示 - find-funciton-on-key 入力したキーシーケンスが表すコマンドの定義された場所に飛ぶ - find-variable 指定した変数の定義された場所に飛ぶ - find-variable-at-point カーソル位置にある変数の定義された場所に飛ぶ - find-variable-other-frame find-variableの結果を別フレームに表示

質問する

apropos系コマンド。

前置引数を指定すると動作を変えられるらしい。変数apropos-do-allをnil以外にセットしていると前置引数を指定したのと同じ動作になるそうです。

- apropos - apropos-command - apropos-documentation - apropos-library - apropos-variable - apropos-value

apropos-valueの検索対象は評価"後"の変数の値。

キーシーケンス

コマンドがどのキーシーケンスに割り当てられているかを探すコマンド。

- where-is

同じ単語(シンボル)をハイライト表示する(マイナーモード版)

最近LispといえばEmacsLispしか触っていません。

この間書いたカーソル位置の単語と同じ単語をハイライト表示する機能をマイナーモードにしてみました。

コードはgithubに置きました。

(require 'hl-same-symbol-mode)

;; emacs-lisp-modeで有効にしたい場合
(add-hook 'emacs-lisp-mode-hook 'hl-same-symbol-mode)

;; ハイライトするまでのアイドル時間を変更する
(setf hl-same-symbol-delay 0.10)

;; ハイライトの表示を変更する
(setf hl-same-symbol-face '何か)

同じ単語(シンボル)をハイライト表示する

EmacsのOverlayを使ってみるテスト。カーソル位置にある単語(symbol-at-pointで取得できるもの)と同じ単語をハイライト表示させます。

show-paren-modeみたいにタイマーを使ったほうが良いかも。

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

(defvar *hl-same-symbol::text* "")
(defvar *hl-same-symbol::list* nil)
(defvar hl-same-symbol-face 'highlight)

(defun hl-same-symbol::highlight (text)
  (setf *hl-same-symbol::text* text)
  ;; (highlight-regexp (regexp-quote text) hl-same-symbol-face)
  (let ((len (length text)))
    (save-excursion
      (dolist (win (window-list))
	(with-current-buffer (window-buffer win)
	  (goto-char (window-start win))
	  (while (let ((pos (search-forward text nil t)))
		   (and pos (< (- pos len) (window-end win))))
	    (hl-same-symbol::highlight-internal text len)))))))

(defun hl-same-symbol::highlight-internal (text len)
  (let ((sym (symbol-at-point)))
    (when (and sym (equal (symbol-name sym) text))
      (let ((overlay (make-overlay (- (point) len) (point))))
	(overlay-put overlay 'face hl-same-symbol-face)
	(push overlay *hl-same-symbol::list*)
	overlay))))

(defun hl-same-symbol::unhighlight ()
  ;; (unhighlight-regexp (regexp-quote *hl-same-symbol::text*))
  (mapcar 'delete-overlay *hl-same-symbol::list*)
  (setf *hl-same-symbol::list* nil))

(defun hl-same-symbol::post-command-hook ()
  (let ((sym (symbol-at-point)))
    (cond
     ((and sym (equal (symbol-name sym) *hl-same-symbol::text*))
      'nothing-to-do)
     (sym
      (hl-same-symbol::unhighlight)
      (hl-same-symbol::highlight (symbol-name sym)))
     (t
      (hl-same-symbol::unhighlight)))
    t))

(defun hl-same-symbol ()
  (interactive)
  (if (find 'hl-samey-symbol::post-command-hook post-command-hook)
      (remove-hook 'post-command-hook 'hl-same-symbol::post-command-hook)
    (add-hook 'post-command-hook 'hl-same-symbol::post-command-hook)))

popup.elで右クリックのようななにか

popup.elでコマンドメニューを表示させてみます。

(require 'popup)

(defvar *rclick-command-tree*)

(setf *rclick-command-tree*
      `(
	[org-capture "org-capture" (lambda () (featurep 'org))]
	("Erlang"
	 [:major-mode erlang-mode]
	 [run-erlang "run-erlang-shell"])
	("Org"
	 [:feature org]
	 [org-sparse-tree "org-sparse-tree"]
	 [org-schedule "org-schedule"]
	 [org-deadline "org-deadline"]
	 [org-time-stamp "org-time-stamp"])
	("VC"
	 ;; vc-annotate (C-x v g) 注釈を表示
	 [vc-annotate "vc-annotate"]
	 ;; vc-diff (C-x v =) 差分を表示
	 [vc-diff "vc-diff"]
	 ;; vc-dir (C-x v d) 状態を表示
	 [vc-dir "vc-dir"]
	 ;; vc-print-log (C-x v l) 履歴を表示
	 [vc-print-log "vc-print-log"]
	 ;; vc-register (C-x v i) ファイルを追加
	 [vc-register "vc-register"]
	 ;; vc-revert (C-x v u) 修正を破棄
	 [vc-revert "vc-revert"]
	 ;; vc-update (C-x v +) 後進
	 [vc-update "vc-update"]
	 ;; vc-next-action (C-x v v) コミット
	 [vc-next-action "vc-next-action(commit)"]
	 ;; vc-revision-other-window (C-x v ~) 過去のバージョンを表示
	 [vc-revision-other-window "vc-revision-other-window"])))

(defun rclick-tree-normalize (tree)
  (mapcar
   (lambda (s)
     (typecase s
       (cons (rclick-tree-normalize s))
       (symbol [s (format "%s" s)])
       (string s)
       (vector (if (>= (length s) 2) s
		 [(aref s 0) (format "%s" (aref s 1))]))
       (t (error "invalid tree"))))
   tree))

(defun rclick-collect-test (tree)
  (remove-if-not
   (lambda (c)
     (and (typep c 'vector)
	  (keywordp (aref c 0))))
   tree))

(defun rclick-tree-collect (tree)
  (let ((tests (rclick-collect-test tree)))
    (when (every 'rclick-test tests)
      (let ((result nil))
	(dolist (c tree)
	  (cond
	   ((and (typep c 'vector)
		 (not (keywordp (aref c 0))))
	    (when (or (<= (length c) 2)
		      (funcall (aref c 2)))
	      (push c result)))
	   ((listp c)
	    (let ((children (rclick-tree-collect c)))
	      (when children
		(push children result))))
	   ((stringp c)
	    (push c result))
	   (t 'nothing-to-do)))
	(nreverse result)))))

(defun rclick-tree->cascade-menu (tree)
  (mapcar
   (lambda (c)
     (typecase c
       (vector (format "%s" (aref c 1)))
       (cons (rclick-tree->cascade-menu c))
       (t c)))
   tree))

(defun rclick-find (desc tree)
  (dolist (c tree)
    (when (and (typep c 'vector)
	       (string-equal desc (aref c 1)))
      (return c))
    (when (listp c)
      (let ((tmp (rclick-find desc c)))
	(when tmp
	  (return tmp))))))

(defun rclick-test (vec)
  (apply (get (aref vec 0) 'rclick-test-function)
	 (cdr (coerce vec 'list))))

(defmacro define-rclick-test (key args &rest body)
  `(setf (get ',key 'rclick-test-function) (lambda ,args ,@body)))

(define-rclick-test :major-mode (mode)
  (eq mode major-mode))
(define-rclick-test :feature (feature)
  (featurep feature))

(defun rclick-menu ()
  (interactive)
  (let ((tree (rclick-tree-collect
	       (rclick-tree-normalize *rclick-command-tree*))))
    (let ((result (popup-cascade-menu (rclick-tree->cascade-menu tree))))
      (when result
	(let ((c (rclick-find result tree)))
	  (when c
	    (call-interactively (aref c 0))))))))

おまけ。コマンドのキーバインドを文字列で取得する方法。

(defun one-of-bindings (command)
  (key-description (car (where-is-internal command))))

popup.elで遊んでみる

overlayを使ってポップアップメニューを表示するpopup.elを使ってみました。
rclk:rclkコマンドを実行すると、*rckl:clauses*に設定されている条件に
したがってメニューを表示します。

右クリックをイメージしています。

;; (require 'popup)

(defvar *rclk:clauses* nil)

(defvar *rclk:format-function* nil)

(defun rclk:rclk ()
(interactive)
(rclk:popup-menu*
(rclk:select *rclk:clauses*)))

(defun rclk:clause-name (clause)
(if (<= (length clause) 2)
   (second clause)
 (third clause)))

(defun rclk:select (clauses)
(let ((result nil))
 (dolist (c clauses)
   (let ((strs (funcall (first c))))
     (unless (listp strs)
       (setf strs (list strs)))
     (dolist (s strs)
       (push (list s (second c) (third c)) result))))
 (nreverse result)))

(defun rclk:popup-menu* (clauses)
(when clauses
 (let ((popup-clauses (mapcar 'rclk:clause->popup clauses)))
   (let ((result (popup-menu* (mapcar 'first popup-clauses))))
 (when result
       (let ((selected (find result popup-clauses
                             :key 'first
    :test 'string-equal)))
         (funcall (third selected) (second selected))
         t))))))

(defun rclk:clause->popup (clause)
(let ((str (substring-no-properties
           (funcall *rclk:format-function* clause))))
 (cons str clause)))

;;; test
(defun symbol-at-point-as-str ()
(when (symbol-at-point)
 (symbol-name (symbol-at-point))))
(defun find-function-from-str (str)
(find-function (intern str)))

;; clause = (文字列のリストを返す関数 選択時に呼び出される関数 表示項目名)
(setf *rclk:clauses*
   `((word-at-point apropos "apropos")
     (symbol-at-point-as-str find-function-from-str "find-function")))

(setf *rclk:format-function*
   (lambda (clause)
     (format "<%s> %s"
             (rclk:clause-name clause)
             (first clause))))

Windows Power Shell で Word の表に書き込む

大量のWordやExcelファイルを一括で処理する方法が知りたいです。
とりあえず、Power Shell で頑張るための第一歩。

既存のファイルを開いて、Word中の表の(1,1)に文字列を挿入します。

$w = New-Object -ComObject "Word.Application"

$d = $w.Documents.open("filename")

$d.Tables.Item(1).Cell(1,1).Range.Text = "hoge"

1日の間に更新されたファイルをカレントディレクトリ以下から探します。

$d = (date).AddDays(-1)

Get-ChildItem -Recurse | Where-Object { $_.LastWriteTime -gt $d }

F#でキーボードフック

C#でできるらしいので、F#でもできるだろうということでやってみました。
.Net上の言語でキーボードフックしてるプログラムを載せてる色々なWebページを参考にしました。

F#のコンソールにコピペしてhook_start関数を実行すると,PrintScreenをフックするようになります。

open System

open System.Diagnostics

open System.Runtime.InteropServices



[<Literal>]

let WH_KEYBOARD_LL = 13



[<Literal>]

let HC_ACTION = 0



[<Literal>]

let WM_KEYDOWN = 0x0100



[<Literal>]

let WM_KEYUP = 0x0101



[<Literal>]

let WM_SYSKEYDOWN = 0x0104



[<Literal>]

let WM_SYSKEYUP = 0x0105



[<Literal>]

let VK_SNAPSHOT = 0x2Cu



[<StructLayout(LayoutKind.Sequential)>]

type KBDLLHOOKSTRUCT =

  val vkCode : uint32

  val scanCode : uint32

  val flags : uint32

  val time : uint32

  val dwExtraInfo : uint32



type LowLevelKeyboardProc = delegate of int * nativeint * KBDLLHOOKSTRUCT ->\

nativeint



[<DllImport("kernel32.dll")>]

extern uint32 GetCurrentThreadId()



[<DllImport("kernel32.dll", SetLastError = true)>]

extern nativeint GetModuleHandle(string lpModuleName)



[<DllImport("user32.dll", SetLastError = true)>]

extern bool UnhookWindowsHookEx(nativeint hhk)



[<DllImport("user32.dll", SetLastError = true)>]

extern nativeint SetWindowsHookEx(int idhook, LowLevelKeyboardProc proc, native\

int hMod, uint32 threadId)



[<DllImport("user32.dll", SetLastError = true)>]

extern nativeint CallNextHookEx(nativeint hHook, int nCode, nativeint wParam, K\

BDLLHOOKSTRUCT lParam)



let mutable s_hook = 0n



let SetHook (proc : LowLevelKeyboardProc) =

  use curProc = Process.GetCurrentProcess()

  use curMod = curProc.MainModule

  s_hook <- SetWindowsHookEx(WH_KEYBOARD_LL, proc, GetModuleHandle(curMod.\

ModuleName), 0u)

  if s_hook = 0n then false else true



let UnSetHook () =

  if s_hook <> 0n then

      if UnhookWindowsHookEx(s_hook) then

          s_hook <- 0n

          true

      else

          false

  else

      false



let MyHookProc (nCode : int) (wParam : nativeint) (lParam : KBDLLHOOKSTRUCT) =

  if nCode = HC_ACTION then

      match (int wParam, lParam.vkCode) with

      | (WM_KEYDOWN, VK_SNAPSHOT)  -> printf "Print Screen\n"; 1\

n

      | (_, _) -> CallNextHookEx(s_hook, nCode, wParam, lParam)

  else

      CallNextHookEx(s_hook, nCode, wParam, lParam)



let hook_start() = SetHook(new LowLevelKeyboardProc(MyHookProc))