|
| 1 | +;;; -*- Mode: Lisp -*- |
| 2 | +;;; miel9.el 往年の著名な DOS-Filer Miel.exe の clone |
| 3 | +;;; ------- |
| 4 | +;;; copyright (c)2004-06-22 by Hideo HAGA |
| 5 | +;;; revision 0.1 2004-06-27 by Hideo HAGA |
| 6 | +;;; revision 0.2 2004-06-28 by Hideo HAGA |
| 7 | +;;; revision 0.3 2004-06-30 by Hideo HAGA |
| 8 | +;;; revision 0.4 2004-07-01 by Hideo HAGA |
| 9 | +;;; revision 0.5 2004-07-07 by Hideo HAGA |
| 10 | +;;; revision 0.6 2004-11-29 by Hideo HAGA ; 構造の見直し |
| 11 | +;;; revision 0.7 2004-11-29 by Hideo HAGA ; 構造の再構築(基本機能) |
| 12 | +;;; revision 0.8 2004-12-05 by Hideo HAGA ; 追加機能検討 |
| 13 | +;;; revision 0.9 2006-10-08 by Hideo HAGA ; カーソルを移動元に戻す対応 |
| 14 | +;;; revision 1.0 2009-06-21 by Hideo HAGA ; xyzzyLispへの移植 09-06-21～ |
| 15 | + |
| 16 | +; ---------- |
| 17 | + |
| 18 | +;;; グローバル変数の初期設定 |
| 19 | + |
| 20 | +(defvar Miel-main-window nil) ; メインウィンドウ |
| 21 | +(defvar Miel-window-height 50) ; ウィンドウの高さ |
| 22 | +(defvar Miel-window-ratio 1/2) ; ウィンドウの高さ比率 |
| 23 | +(defvar Miel-previous-dir " ") ; 直前のdirectory |
| 24 | +(defvar Miel-current-line 3) ; 現在の行番号 |
| 25 | +(defvar Miel-current-directory nil) ; 現在の対象ディレクトリ |
| 26 | +(defvar Miel-edit-filename nil) ; 編集対象ファイル名 |
| 27 | +(defvar Miel-edit-buffer nil) ; 編集バッファ名一時記憶変数 |
| 28 | +;(defvar Miel-cursor-overlay nil) ; カーソルオーバーレイオブジェクト |
| 29 | +;(defvar Miel-mode-line-strings nil) ; モードライン表示文字列 |
| 30 | +(defvar Miel-mode-line-format ; モードライン定義 |
| 31 | + "--%*- %b (%M) [%k:%l] %P %f") |
| 32 | + |
| 33 | +; ---------- |
| 34 | + |
| 35 | +;;; キーマップ設定 |
| 36 | + |
| 37 | +; 新規ローカルキーマップ |
| 38 | +(defvar *miel-mode-map* nil) |
| 39 | +(unless *miel-mode-map* |
| 40 | + (setq *miel-mode-map* (make-sparse-keymap)) |
| 41 | + ;(suppress-keymap miel-mode-map) ; 一般文字キーを全て無効化 |
| 42 | + ; 移動 |
| 43 | + (define-key *miel-mode-map* '(#\t) 'miel-top-line) |
| 44 | + (define-key *miel-mode-map* '(#\b) 'miel-bottom-line) |
| 45 | + (define-key *miel-mode-map* '(#\n) 'miel-next-line) |
| 46 | + (define-key *miel-mode-map* '(#\p) 'miel-previous-line) |
| 47 | + (define-key *miel-mode-map* '(#\Down) 'miel-next-line) |
| 48 | + (define-key *miel-mode-map* '(#\Up) 'miel-previous-line) |
| 49 | + ; ファイル編集・ディレクトリ移動 |
| 50 | + (define-key *miel-mode-map* '(#\C-m) 'miel-find-file) |
| 51 | + ; マークの設定・解除 |
| 52 | + (define-key *miel-mode-map* '(#\SPC) 'miel-mark-file) |
| 53 | + ; 削除 |
| 54 | + (define-key *miel-mode-map* '(#\d) 'miel-delete-file)) |
| 55 | +; kill-buffer キーバインドの再定義(global-map でないとダメ) |
| 56 | +(define-key *global-keymap* '(#\C-x #\k) 'miel-delete-buffer) |
| 57 | + |
| 58 | +; ---------- |
| 59 | + |
| 60 | +;;; コマンド関数定義 |
| 61 | + |
| 62 | +(defun miel-delete-buffer () |
| 63 | + ; Miel 版 C-xk (kill-buffer) |
| 64 | + (interactive) |
| 65 | + (cond |
| 66 | + ((equal Miel-edit-buffer nil) ; Mielが編集を起動していなければ |
| 67 | + (delete-other-windows) |
| 68 | + (cond |
| 69 | + ((find-name-buffer "[ File Browser ]") |
| 70 | + (delete-buffer "[ File Browser ]")) |
| 71 | + (t nil)) |
| 72 | + (delete-buffer (selected-buffer))) ; カレントバッファを削除 |
| 73 | + (t |
| 74 | + (delete-buffer Miel-edit-buffer) ; 編集バッファを削除 |
| 75 | + (setq Miel-edit-buffer nil) ; リセット |
| 76 | + (miel (default-directory)) |
| 77 | + ))) ; Miel を再起動 |
| 78 | + |
| 79 | +; ---------- |
| 80 | + |
| 81 | +(defun // (x y) |
| 82 | + ; 割り算の結果余りを捨てた整数を返す |
| 83 | + ; 請負関数 |
| 84 | + (floor (/ x y))) |
| 85 | + |
| 86 | +(defun mode-attributes-string (file) |
| 87 | + ; attr ← (car (get-file-info file)) |
| 88 | + ; ファイルのモードをあらわす文字列を返す |
| 89 | + ; directory "d-----" |
| 90 | + ; readonly "-r----" |
| 91 | + ; hidden "--h---" |
| 92 | + ; system "---s--" |
| 93 | + ; archive "----a-" |
| 94 | + ; compressed "-----c" |
| 95 | + (interactive) |
| 96 | + (let ((attr nil) (x6 "-") (x5 "-") (x4 "-") (x3 "-") (x2 "-") (x1 "-")) |
| 97 | + (setq attr (car (get-file-info file))) |
| 98 | + (if (= 1 (// attr 2048)) |
| 99 | + (setq x1 "c")) |
| 100 | + (if (= 1 (// (mod attr 2048) 32)) |
| 101 | + (setq x2 "a")) |
| 102 | + (if (= 1 (// (mod attr 32) 16)) |
| 103 | + (setq x6 "d")) |
| 104 | + (if (= 1 (// (mod attr 16) 4)) |
| 105 | + (setq x3 "s")) |
| 106 | + (if (= 1 (// (mod attr 4) 2)) |
| 107 | + (setq x4 "h")) |
| 108 | + (if (= 1 (// (mod attr 2) 1)) |
| 109 | + (setq x5 "r")) |
| 110 | + (concat x6 x5 x4 x3 x2 x1))) |
| 111 | + |
| 112 | +; ---------- |
| 113 | + |
| 114 | +;(defun set-cursor-overlay () |
| 115 | +; ; カーソルオーバーレイの設定 |
| 116 | +; (save-excursion |
| 117 | +; (setq Miel-cursor-overlay |
| 118 | +; (make-overlay (point) (progn (end-of-line) (point)))) |
| 119 | +; (overlay-put |
| 120 | +; Miel-cursor-overlay |
| 121 | +; 'face |
| 122 | +; 'highlight))) |
| 123 | + |
| 124 | +; ---------- |
| 125 | + |
| 126 | +;(defun move-cursor-overlay () |
| 127 | +; ; カーソルオーバーレイを移動する |
| 128 | +; (save-excursion |
| 129 | +; (move-overlay |
| 130 | +; Miel-cursor-overlay |
| 131 | +; (point) |
| 132 | +; (progn (end-of-line) (point))))) |
| 133 | + |
| 134 | +; ---------- |
| 135 | + |
| 136 | +(defun miel-top-line () |
| 137 | + ; 先頭の行を表示する |
| 138 | + (interactive) |
| 139 | + (beginning-of-buffer) |
| 140 | +; (move-cursor-overlay) |
| 141 | + (miel-browse-file-head)) |
| 142 | + |
| 143 | +; ---------- |
| 144 | + |
| 145 | +(defun miel-bottom-line () |
| 146 | + ; 最後の行を表示する |
| 147 | + (interactive) |
| 148 | + (end-of-buffer) |
| 149 | + (forward-line -1) |
| 150 | +; (move-cursor-overlay) |
| 151 | + (miel-browse-file-head)) |
| 152 | + |
| 153 | +; ---------- |
| 154 | + |
| 155 | +(defun miel-next-line () |
| 156 | + ; 次の行を表示する |
| 157 | + (interactive) |
| 158 | + (forward-line) |
| 159 | +; (move-cursor-overlay) |
| 160 | + (miel-browse-file-head)) |
| 161 | + |
| 162 | +; ---------- |
| 163 | + |
| 164 | +(defun miel-previous-line () |
| 165 | + ; 前の行を表示する |
| 166 | + (interactive) |
| 167 | + (forward-line -1) |
| 168 | +; (move-cursor-overlay) |
| 169 | + (miel-browse-file-head)) |
| 170 | + |
| 171 | +; ---------- |
| 172 | + |
| 173 | +(defun miel-goto-line (no) |
| 174 | + ; 指定行を表示する |
| 175 | + (interactive) |
| 176 | + (goto-line no) |
| 177 | +; (move-cursor-overlay) |
| 178 | + (miel-browse-file-head)) |
| 179 | + |
| 180 | +; ---------- |
| 181 | + |
| 182 | +(defun miel-mark-file () |
| 183 | + ; 操作対象ファイル行にマークを設定・解除 |
| 184 | + (interactive) |
| 185 | + (setq buffer-read-only nil) |
| 186 | + (beginning-of-line) |
| 187 | + (let ((mark-flag |
| 188 | + (format nil "~C" |
| 189 | + (char-after (point)))) |
| 190 | + (dir-flag |
| 191 | + (progn |
| 192 | + (forward-char 1) |
| 193 | + (format nil "~C" |
| 194 | + (char-after (point)))))) |
| 195 | + (cond |
| 196 | + ((equal dir-flag "d") |
| 197 | + ; ディレクトリなら |
| 198 | + ; 今のところ何もしない |
| 199 | + ) |
| 200 | + ((equal mark-flag " ") |
| 201 | + ; 未だマークがなかったらマークを追加 |
| 202 | + (beginning-of-line) |
| 203 | + (delete-char 1) |
| 204 | + (insert "*")) |
| 205 | + (t |
| 206 | + ; 既にマークされていたらマークを削除 |
| 207 | + (beginning-of-line) |
| 208 | + (delete-char 1) |
| 209 | + (insert " "))) |
| 210 | + (setq buffer-read-only t) |
| 211 | + (miel-next-line))) |
| 212 | + |
| 213 | +; ---------- |
| 214 | + |
| 215 | +(defun miel-get-filename () |
| 216 | + ; カレント行のファイル名を取得 |
| 217 | + ; ret == list: (dir-flag filename) |
| 218 | + (let ((filename '())) |
| 219 | + (save-excursion |
| 220 | + ; 行末の非空白部分をファイル名と見なす |
| 221 | + (end-of-line) |
| 222 | + (let ((p2 (point)) |
| 223 | + (p1 (progn |
| 224 | + (skip-chars-backward "^ \t") |
| 225 | + (point)))) |
| 226 | + (setq filename (cons (buffer-substring p1 p2) filename)))) |
| 227 | + (save-excursion |
| 228 | + ; 行頭の二文字目でディレクトリかどうか判断 |
| 229 | + (beginning-of-line) |
| 230 | + (let ((dir-flag |
| 231 | + (progn |
| 232 | + (forward-char 1) |
| 233 | + (format nil "~C" |
| 234 | + (char-after (point)))))) |
| 235 | + (setq filename (cons dir-flag filename)))))) |
| 236 | + |
| 237 | +; ---------- |
| 238 | + |
| 239 | +(defun miel-find-file () |
| 240 | + ; カレント行のファイルのオープン |
| 241 | + (interactive) |
| 242 | + (set-window Miel-main-window) |
| 243 | + (let ((file (miel-get-filename))) |
| 244 | + (cond |
| 245 | + ((equal "d" (car file)) ; ディレクトリなら |
| 246 | + (setq Miel-previous-dir (default-directory)) |
| 247 | + (miel (car (cdr file)))) ; Miel を再起動 |
| 248 | + (t ; ファイルなら |
| 249 | + (setq Miel-current-line |
| 250 | + (current-line-number)) ; 現在行を記憶 |
| 251 | + (delete-other-windows) ; win2 バッファを削除して |
| 252 | + (setq Miel-edit-buffer (car (cdr file))) ; 編集バッファ名を一時記憶 |
| 253 | + (find-file Miel-edit-buffer))))) ; ファイルを開く |
| 254 | + |
| 255 | +; ---------- |
| 256 | + |
| 257 | +(defun miel-browse-file-head () |
| 258 | + ; 現在行のファイルの内容を別ウィンドウに読み込み、表示する |
| 259 | + (interactive) |
| 260 | + (let ((win (selected-window)) |
| 261 | + (buf2 (get-buffer-create "[ File Browser ]")) |
| 262 | + (file (miel-get-filename))) ; ファイル名取得 |
| 263 | + (save-excursion |
| 264 | + (set-buffer buf2) ; 編集対象バッファを切替える |
| 265 | + (erase-buffer (selected-buffer)) ; バッファをクリアする |
| 266 | + (cond |
| 267 | + ((equal "d" (car file)) ; ディレクトリなら |
| 268 | + (insert "\nこれはディレクトリです")) |
| 269 | + ((equal "-" (car file)) ; ファイルなら |
| 270 | + (insert-file-contents |
| 271 | + (concat Miel-current-directory (car (cdr file))) |
| 272 | + nil 0 (* 80 40))) ; 80桁*40行分表示 |
| 273 | + (t ; ディレクトリでもファイルでもない |
| 274 | + (insert "\nファイルが存在しません"))) |
| 275 | + (other-window) |
| 276 | + (set-buffer buf2) |
| 277 | + (other-window)))) ; 元のウィンドウに戻る |
| 278 | + |
| 279 | +; ----- |
| 280 | + |
| 281 | +; この関数に何かしらバグ？あり。⇒ ホームディレクトリの親に移動しようとすると |
| 282 | +; エラー（指定されたファイル../が見つかりません）になる⇒EmacsではOK？謎。 |
| 283 | +; 2009-06-28(Sun) by Hideo HAGA |
| 284 | + |
| 285 | +(defun miel-make-files-list () |
| 286 | + ; ファイル一覧リストを生成する |
| 287 | + (let ((files (reverse (directory Miel-current-directory :show-dots t))) |
| 288 | + (mode nil) (size nil) (date nil) (file nil) (files-list nil)) |
| 289 | + (while files |
| 290 | + (setq Miel-files2 files) |
| 291 | + (setq file (car files)) |
| 292 | + (setq mode (mode-attributes-string file)) |
| 293 | + (setq size (file-length file)) |
| 294 | + (if (> (parse-integer (format nil "~A" size)) 99999999) |
| 295 | + (setq size "99999999")) |
| 296 | + (setq date (format-date-string "%y/%m/%d %H:%M:%S" (cadr (get-file-info file)))) |
| 297 | + (setq files-list |
| 298 | + (cons (format nil " ~A ~8@A ~A ~A\n" mode size date file) files-list)) |
| 299 | + (setq files (cdr files))) |
| 300 | + files-list)) |
| 301 | + |
| 302 | +; ----- |
| 303 | + |
| 304 | +(defun miel-list-files () |
| 305 | + ; ファイル一覧リストを表示する |
| 306 | + (let ((files-list (miel-make-files-list))) |
| 307 | + (while files-list |
| 308 | + (insert (car files-list)) |
| 309 | + (setq files-list (cdr files-list))))) |
| 310 | + |
| 311 | +; ---------- |
| 312 | + |
| 313 | +(defun miel (dir) |
| 314 | + ; Miel メイン処理関数 |
| 315 | + ; ディレクトリ一覧を表示してファイルの情報を表示 |
| 316 | + (setq buffer-read-only nil) |
| 317 | + (erase-buffer (selected-buffer)) |
| 318 | + (cd dir) |
| 319 | + (setq Miel-current-directory (default-directory)) |
| 320 | + (miel-list-files) |
| 321 | +; (set-cursor-overlay) |
| 322 | + ; カーソルを対象行に移動する |
| 323 | + (cond |
| 324 | + ((string= Miel-previous-dir " ") ; ファイルを閉じた後の場合 |
| 325 | + (miel-goto-line Miel-current-line) ; ファイルを開く前の行に戻す |
| 326 | + (setq Miel-current-line 3)) ; 使用後は初期値に戻す |
| 327 | + (t ; ディレクトリ移動の場合 |
| 328 | + (miel-goto-line Miel-current-line) ; 初期値のまま「3」のはず |
| 329 | + (setq Miel-current-line 3) ; 使用後は初期値に戻す |
| 330 | + (search-forward |
| 331 | + (concat " " (file-namestring (substring Miel-previous-dir 0 -1))) |
| 332 | + t) |
| 333 | + (beginning-of-line) |
| 334 | + (setq Miel-previous-dir " "))) |
| 335 | +; (move-cursor-overlay) |
| 336 | + (delete-other-windows) |
| 337 | + (split-window (truncate (* Miel-window-height Miel-window-ratio))) |
| 338 | + (miel-browse-file-head) |
| 339 | + ; モードラインの設定 |
| 340 | + (let ((str-dir)) |
| 341 | + (setq mode-line-format (concat str-dir Miel-mode-line-format))) |
| 342 | + (update-mode-line) |
| 343 | + (setq buffer-read-only t)) |
| 344 | + |
| 345 | +; ---------- |
| 346 | + |
| 347 | +;;; Miel mode メジャーモード関数本体 |
| 348 | + |
| 349 | +(defun miel-mode () |
| 350 | + ; 往年の DOS-Filer Miel.exe モドキ |
| 351 | + (interactive) |
| 352 | + (delete-other-windows) |
| 353 | + (setq Miel-window-height (window-height)) |
| 354 | + (switch-to-buffer "[ Show Pwd ]") |
| 355 | + (setq Miel-main-window (selected-window)) |
| 356 | + ; メジャーモードの設定 |
| 357 | + (setq major-mode 'miel-mode) |
| 358 | + (setq mode-name "Miel mode") |
| 359 | + ; 専用キーマップの使用宣言 |
| 360 | + (use-keymap *miel-mode-map*) |
| 361 | + ; Miel 実行。 |
| 362 | + (miel "~/") |
| 363 | + ; メジャーモードフックを設定 |
| 364 | + (run-hooks 'miel-mode-hook)) |
0 commit comments