top  Index  Search  Changes  RSS  Login

手動並べかえ

味見のためのやっつけ試作. cf. 2ch2:594

作ってから思ったけど, こういうのは outline-mode の仕事ちゃいます? ^^; (outline-mode なら, 並べかえの単位(章・節・項)も自在に変えられる). あー, でも, queue みたいな使い方もあるか?


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 手動並べかえ

;; howm-test050320 でテスト

;; * 並べかえ
;;   * 一覧で P・N → その項目を上・下へ入れかえ
;;   * M-p・M-n → 先頭・末尾へ飛ばす
;; * 順序保存
;;   * 手順
;;     * M-x howm-arrange-open hoge → hoge の検索結果を一覧
;;     * 上のコマンドで並べかえ
;;     * M-x howm-arrange-save → 順序を ~/.howm-arrange に保存
;;     * 次に M-x howm-arrange-open hoge したら, 保存した順序を復元
;;   * バグ・制限
;;     * howm-arrange-open した場合しか順序保存は効かない.
;;     * 順序の記録はファイル単位. 同じファイル内で複数ヒットしても一緒くた.
;;     * 検索がヒットしなかったら誤動作するかも.

(let ((m howm-view-summary-mode-map))
  (define-key m "P" 'howm-view-summary-arrange-up)
  (define-key m "N" 'howm-view-summary-arrange-down)
  (define-key m "\M-p" 'howm-view-summary-arrange-top)
  (define-key m "\M-n" 'howm-view-summary-arrange-bottom)
  )

(defun howm-view-summary-arrange-up ()
  (interactive)
  (howm-view-summary-arrange-swap (lambda (i) (- i 1))))
(defun howm-view-summary-arrange-down ()
  (interactive)
  (howm-view-summary-arrange-swap (lambda (i) (+ i 1))))
(defun howm-view-summary-arrange-top ()
  (interactive)
  (howm-view-summary-arrange-top/bottom))
(defun howm-view-summary-arrange-bottom ()
  (interactive)
  (howm-view-summary-arrange-top/bottom t))

(defun howm-view-summary-arrange-swap (f &optional mark)
  (let* ((i (- (howm-view-line-number) 1))
         (you (funcall f i)))
    (when (or (< you 0)
              (not (< you (length (howm-view-item-list)))))
      (error "Out of range"))
    (howm-view-summary (howm-view-name)
                       (howm-swap-in-sequence (howm-view-item-list)
                                              i you))
    (forward-line you)))

(defun howm-view-summary-arrange-top/bottom (&optional bottom)
  (let* ((item-list (howm-view-item-list))
         (i (- (howm-view-line-number) 1))
         (xi (nth i item-list))
         (rest (append (subseq item-list 0 i)
                       (subseq item-list (+ i 1)))))
    (howm-view-summary (howm-view-name)
                       (if bottom
                           (append rest (list xi))
                         (cons xi rest)))
    (forward-line i)
    (push-mark)
    (goto-char (if bottom (point-max) (point-min)))
    (beginning-of-line)))

(defun howm-swap-in-sequence (seq m n)
  (let ((ans (copy-sequence seq))
        (xm (elt seq m))
        (xn (elt seq n)))
    (setf (nth m ans) xn)
    (setf (nth n ans) xm)
    ans))

(defvar howm-arrange-file "~/.howm-arrange")
(defvar howm-arrange-key nil)
(make-variable-buffer-local #'howm-arrange-key)

(defun howm-load (file)
  (setq file (expand-file-name file))
  (and (file-exists-p file)
       (with-temp-buffer
         (insert-file-contents file)
         (read (current-buffer)))))
(defun howm-save (expr file)
  (setq file (expand-file-name file))
  (with-current-buffer (find-file-noselect file t)
    (setq buffer-read-only nil)
    (erase-buffer)
    (insert (format "%S" expr))
    (basic-save-buffer)))

(defun howm-arrange-open (keyword)
  (interactive "sKeyword: ")
  (howm-search keyword t)
  (setq howm-arrange-key keyword) ;; BUG! dangerous when no match
  (let ((order (cdr (assoc keyword (howm-load howm-arrange-file)))))
    (howm-view-sort-general (lambda (item)
                              (or (position (howm-item-name item) order
                                            :test #'equal)
                                  -1))
                            #'<)))

(defun howm-arrange-save ()
  (interactive)
  (let ((names (remove-duplicates (mapcar #'howm-item-name
                                          (howm-view-item-list))))
        (mem (howm-load howm-arrange-file)))
    (let ((pair (assoc howm-arrange-key mem)))
      (if pair
          (setcdr pair names)
        (setq mem (cons (cons howm-arrange-key names) mem))))
    (howm-save mem howm-arrange-file)))

(Please LogIn to post comments.)

Last modified:2008/03/09 14:09:00
Keyword(s):
References:[実装済]