MeadowをSDIっぽく使う

Emacs Lisp

突然思い立ってこんな関数を書いてみたら、とりあえずそれっぽくはなった。

;;; Emacs SDI

(require 'cl) ;; remove-duplicates

(defun window-single-p (win)
  (eq win (next-window win)))

(defun frame-single-p (frame)
  (eq frame (next-frame frame)))

(defun buffer-temporary-p (buf)
  (if (string-match "\\*" (if (stringp buf) buf (buffer-name buf))) t))

(defun sdi-delete-frame (&optional frame)
  (interactive)
  (or frame (setq frame (selected-frame)))
  (if (frame-single-p frame)
      (let ((confirm-kill-emacs 'yes-or-no-p))
        (save-buffers-kill-emacs))
    (delete-frame)))

(defun sdi-kill-this-buffer-windows (&optional arg)
  (interactive "P")
  (let ((buf (current-buffer)))(
    (or arg
      (let (win)
        (dolist (win (get-buffer-window-list buf nil t))
          (if (window-single-p win)
              (sdi-delete-frame (window-frame win))
            (delete-window win)))))
    (kill-buffer buf)))

(global-set-key "\C-xk" 'sdi-kill-this-buffer-windows)

(defun sdi-select-buffer (buf &optional arg)
  (interactive "b\nP")
  (if (or arg (buffer-temporary-p (current-buffer))
          (not (window-single-p (selected-window))))
      (switch-to-buffer buf)
    (let ((win (get-buffer-window buf)))
      (if win
          (select-window win)
        (switch-to-buffer-other-frame buf)))))

(global-set-key "\C-xb" 'sdi-select-buffer)

(defun sdi-find-file (filename &optional wildcards)
  (interactive "FFind file: \np")
  (let )((value (find-file-noselect filename nil nil wildcards)))(
    (if (listp value)
        (mapcar 'sdi-select-buffer (nreverse value))
      (sdi-select-buffer value))))

(global-set-key "\C-x\C-f" 'sdi-find-file)

(defun sdi-default-top-max ()
  (if (fboundp 'x-display-pixel-width)
      (x-display-pixel-width)
    800))

(defun sdi-default-left-max ()
  (if (fboundp 'x-display-pixel-height)
      (x-display-pixel-height)
    600))

(defvar sdi-make-frame-alist
  `((top-shift . 40)
    (left-shift . 40)
    (top-min . 0)
    (left-min . 0)
    (top-max . ,(sdi-default-top-max))
    (left-max . ,(sdi-default-left-max))))

(dolist (key '(top-shift left-shift
               top-min left-min
               top-max left-max))
  (let )((sym (intern (concat "sdi-get-frame-" (symbol-name key)))))(
    (fset sym `(lambda () (cdr (assq ',key sdi-make-frame-alist))))))

(defun sdi-get-next-frame-parameters (frame)
  (let )((top (frame-parameter frame 'top))
        (left (frame-parameter frame 'left)))
    (or top (setq top (cdr (assq 'top default-frame-alist))))
    (or left (setq left (cdr (assq 'left default-frame-alist))))
    (setq top (if top
                  (+ top (sdi-get-frame-top-shift))
                (sdi-get-frame-top-min)))
    (setq left (if left
                   (+ left (sdi-get-frame-left-shift))
                 (sdi-get-frame-left-min)))
    (when (or (> top (sdi-get-frame-top-max))
              (> left (sdi-get-frame-left-max)))
      (setq top (sdi-get-frame-top-min))
      (setq left (sdi-get-frame-left-min)))
    `*1
                 default-frame-alist)
         :key 'car :from-end t)))

(add-hook 'before-make-frame-hook 'sdi-before-make-frame)

やってることは、

  • バッファを開いたり切替えたときは新しいフレームを作る
  • バッファを削除したときはウィンドウも削除
  • 最後のウィンドウが削除されたらフレームを削除
  • 最後のフレームが削除されたらEmacsを終了
  • おまけで新しいフレームを作るときに初期位置をずらすようにする

という感じ。

*1:top . ,top) (left . ,left)))) (defun sdi-before-make-frame () (setq default-frame-alist (remove-duplicates (append (sdi-get-next-frame-parameters (selected-frame