Menu/Xyzzy/Lisp Scrap Note - 技術見聞録

そのうちこの辺から移動してくる予定。
http://blogs.yahoo.co.jp/bovecrach

目次

ファイル操作・時間更新

指定ファイルの最終更新日を現在の日時に更新する

(defun access_filedate_update( file_name )
  (interactive "fFile Name : ")
  (setf now_date (get-universal-time))
  (if (yes-no-or-cancel-p (format nil "~A の~%最終更新日を変更します。~%よろしいですか？" file_name))
      (set-file-write-time file_name now_date))
  (message "OKです"))

指定ディレクトリの最終更新日を現在の日時に更新する

(defun access_date_update( directory_name )
  (interactive "DDirectory Name : ")
  (setf now_date (get-universal-time))
  (if (yes-no-or-cancel-p (format nil "~A の~%最終更新日を変更します。~%よろしいですか？" directory_name))
      (dolist (file_name (directory directory_name :absolute t :recursive t))
        (set-file-write-time file_name now_date)))
  (message "OKです"))

バッファ操作

選択系セット

(defun return-sentence-selection-or-cursor()
  "セレクションの、ないならカーソル位置の句を返す"
  (save-excursion
    (if (pre-selection-p)
        (selection-start-end (start end)
          (buffer-substring start end))
      (progn
        (skip-syntax-spec-forward "w_")
        (setf start (point))
        (skip-syntax-spec-backward "_w")
        (buffer-substring start (point))))))

(defun narrow-to-region-or-selection()
  "セレクションの、ないならリージョンをnarrowする"
  (if (pre-selection-p)
      (selection-start-end (start end)
        (narrow-to-region start end))
    (progn
      (widen)
      (exchange-point-and-mark) (setf start (point))
      (exchange-point-and-mark) (setf end (point))
      (narrow-to-region start end))))

(defun get-range-region-or-selection()
  "セレクションの、ないならリージョンの開始位置と終了位置を多値で返却する"
  "セレクションの矩形選択は返却しない"
  ; リージョンがある場合
  (when (mark t)
    (exchange-point-and-mark) (setf start (point))
    (exchange-point-and-mark) (setf end   (point)))
  ; セレクションがある場合、値はセレクションを優先する
  (when (pre-selection-p)
    (setf start (selection-mark))
    (setf end   (selection-point)))
  ; 値は多値で返却
  (values start end))

(defun toggle-selection()
  "セレクションの選択方式を文字選択<->矩形選択の順に変更する"
  (interactive)
  (case (get-selection-type)
    (2 (start-selection 3 nil))
    (3 (start-selection 2 nil))
    (t (start-selection 3 nil)))
  (message "selection-type = ~A" (get-selection-type)))

(defun stop-selection-with-msg()
  "選択中のセレクションを解除する"
  (interactive)
  (when (get-selection-type) (progn (message "selection-type = nil") (stop-selection))))

Lispで範囲をuniq

とても簡単な方法に思い至ったので修正。

(defun uniq ( uniq-list )
  "範囲をuniq"
  (remove-duplicates uniq-list :from-end t :test #'string=))
(defun uniq-selection ()
  "範囲をuniq"
  (interactive)
  (save-excursion
    (selection-start-end (start end)
      (let ((str (buffer-substring start end)))
        (setf str (split-string str "\n"))
        (when (not (equal str (uniq str)))
          (delete-region start end)
          (insert (format nil "~{~A~%~}" (uniq str))))
        ))))

指定したバッファが表示中の窓に今のバッファを表示する

(defun buffer-change-other-buffer( buff-change )
  "指定したバッファが表示中の窓に今のバッファを表示する"
  (interactive "bbuff-name:")
  (setf buff-now (selected-buffer))
  (setf buff-win (get-buffer-window buff-change))
  ;; 入替えるバッファが表示中だったら元に戻れるように現在表示中の窓を保存して
  ;; buff-winに現在表示中のバッファを表示する
  (if buff-win
      (with-selected-window
        (set-window buff-win)
        (switch-to-buffer buff-now)))
  ;; 現在表示中の窓に所定のバッファを表示
  (switch-to-buffer buff-change))

---

---