gistfile1.el

;;; 同じディレクトリ内で先頭3文字が一致するファイルを友達とみなし、順番に開いたりするもの
;;;

(require 'cl)

(defun get-friend-files ()
  "ファイル名の先頭3文字が合致しているファイルは友達"
  (let ((list (file-name-all-completions (substring (buffer-name) 0 3) "./"))
        (file-name-list '()))
    ;; 自分自身は必ずみつかるので、listの内容が2つ以上なら友達をソートして返す。
    (when (cdr list)
      (while (not (endp list))
        (let ((file (car list)))
          (or (backup-file-name-p file)
              (push file file-name-list)))
        (pop list))
      (sort file-name-list #'string<))))

(defun get-previous-entry-name ()
  (let ((bn (buffer-name))
        (files (get-friend-files))
        (file-name "")) ;番兵
    (dolist (f files)
      (if (string-lessp f bn)
          (setq file-name f)))
    (if (string= "" file-name)
        nil
        file-name)))

(defun get-next-entry-name ()
  (let ((bn (buffer-name))
        (files (get-friend-files)))
    (dolist (f files)
      (if (string< bn f)
          (return f)))))

(defun cd-to-buffer-directory ()
  (interactive)
  (cd (file-name-directory (buffer-file-name))))

;; 新規ファイルのようにディレクトリが確定してないものに遭遇すると上手く動かない場合がある様子
(defun open-previous-entry ()
  (interactive)
  (cd-to-buffer-directory)
  (let ((friends (get-previous-entry-name)))
    (if friends
        (find-file (get-previous-entry-name))
        (message "No previous friends."))))

(defun open-next-entry ()
  (interactive)
  (cd-to-buffer-directory)
  (let ((friends (get-next-entry-name)))
    (if friends
        (find-file (get-next-entry-name))
        (message "No next friends."))))

(defun kill-friend-buffer ()
  (interactive)
  (let* ((bn (buffer-name))
         (ext (file-name-extension bn))
         (head (substring bn 0 4))
         (fri (format "%s.*.%s" head ext)))
    (mapc (lambda (buf)
            (let ((bname (buffer-name buf)))
              (and (not (string= (buffer-name) bname))
                   (string-match fri bname)
                   (kill-buffer buf))))
          (buffer-list)))
  (message "友達を掃除しました"))

;bindings
(define-key global-map [(super ?n)] 'open-next-entry)
(define-key global-map [(super ?p)] 'open-previous-entry)
(define-key global-map [(super ?x) ?c] 'kill-friend-buffer)