しょぼしょぼすくりぷと xyzzy > lisp サンプルLibrary集 > テキスト系lisp

テキスト系lisp

テキストを操作する削除系はこっち

目次

リージョン(region)を反転表示

こちらで、リージョンハイライト を ファイルに纏めました。

keymapの情報を表示する

特定のkeymapの キーバインディング情報を表示します。
(provide "help")

(in-package "lisp")

(defun describe-keymap (keymap)
 (interactive)
 (switch-to-buffer "*Help*")
 (dolist (item keymap)
  (if (consp item)
   (format t "~A:~A\n" (key-to-string (car item))(cdr item))
    ;(format t "~A\n" item)
   )))
        
lispパッケージなのでちょっと違います。
describe-bindings
describe-function
describe-key
describe-key-briefly
describe-variable

URI 分解

プロトコルとか、サーバーを抽出します。多分大丈夫だと思う。
(defun get-protocol-string (URI)
  (let (from end protocol server port)
    (setq from (string-match "^[^:/]+" URI))
    (setq end (match-end 0) )
    (when (and from end)
      (setq protocol (substring URI from end ))
      (setq URI (substring URI (1+ end)))
    )

    (setq from (string-match "[^:/]+" URI))
    (setq end (match-end 0))
    (when (and from end)
      (setq server (substring URI from end ))
      (if (string-match "\\." server)
          (setq URI (substring URI end))
        (setq server nil))
    )

    (setq from (string-match "[0-9]+/" URI))
    (setq end (match-end 0))
    (when (and from end)
      (setq port (substring URI 1 (1- end)))
      (setq URI (substring URI (1- end)))
    )

    ;(insert "protocol :[" protocol "]\n")
    ;(insert "server :[" server "]\n")
    ;(insert "port :[" port "]\n")
    ;(insert "target :[" URI "]\n")
    (values protocol server port URI)
  )
)

;for test
(get-protocol-string "http://www2.ocn.ne.jp/~cheerful/script/index.html")
(get-protocol-string "//http://www2.ocn.ne.jp/~cheerful/script/")

(get-protocol-string "/~start/index.html")
(get-protocol-string "/start/jkdjkaj/jkjdfjindex.html")

(get-protocol-string "http://www2.ocn.ne.jp/~cheerful:80/~start/index.html")
(get-protocol-string "//http://www2.ocn.ne.jp/~cheerful:80/~start/index.html")
;usage
(multiple-value-setq (protocol server port file) (get-protocol-string "http://www2.ocn.ne.jp/~cheerful/~start"))



ファイル名入力

ファイル名を 書くのがおっくうなので ミニバッファでファイル名を聞いて(補完などが効く)その文字列を入れます。

javaの場合 拡張子いらないのでそれようも作成。
(defun read-file-full-name (prompt &optional (default-path (get-buffer-file-name)))
  (read-file-name prompt :default default-path)
  )
(defun insert-file-names (func prompt &optional (default-path (get-buffer-file-name)))
  (let (str)
	(if (setq str (read-file-full-name prompt default-path))
		(if func
			(insert (funcall func str)))
	  (insert  str))
	)
  )

(defun insert-class-name()
  (interactive)
  (insert-file-names  'pathname-name "insert class name: "))
(defun insert-file-name()
  (interactive)
  (insert-file-names  'file-namestring "insert file name; "))
(defun insert-file-name-fullpath()
  (interactive)
  (insert-file-names  nil "insert full file name: "))


一致行 抽出

ある範囲(リージョン)内で 各行に対して 入力文字を含んでいたら リージョンの前の方に行をそのまま移動する。そんだけ。(抽出するのに便利)
(defun search-word-carry-to-top (from to)
  (interactive "*r")
  "入力された文字列を元に ファイルの前に運ぶ"
  (if (> from to)
      (rotatef from to))
  (setq st (read-string "search included word to carry top:" :default " " ))
  (save-excursion
    (save-restriction
      (narrow-to-region from to)
      (goto-char from)
      (goto-bol)
;一番最初の行保留
     ;(setq firstPoint (point))
     (setq insrtS "")
      (loop
      (goto-bol)
      (setq fp (point))
      (goto-eol)
      (setq ep (point))
      (setq line (buffer-substring fp ep))
      ;(refresh-screen)
      ;(msgbox "~S" line)
      (if (string-matchp st line)
         (progn
           (setq insrtS (concatenate 'string insrtS line "\n"))
           (goto-char fp)
           (delete-char (length line))
           (delete-char)
           ;(refresh-screen)
           ;(msgbox "~S" line)
           (previous-line)
         )
      )
      (if (forward-line)
         nil (return nil))
     )
     (goto-char from)
     (insert insrtS)
   )))

正方形に文字を埋めるだけ

(defun make-char-rectangle ()
  "insert char in rectangle area"
  (interactive)
  (setq text-width (read-integer "width(x):"))
  (setq text-height (read-integer "height(y):"))
  (setq text-char (read-string "fill char:"))

  (dotimes (i text-height)
   (progn
     (insert text-char text-width)
     (insert "\n")
   )))

範囲内のものを すぐ下にコピー

( '(#\C-x #\y) とかで)
(defun copy-region-to-back (from to)
  (interactive "*r")
  "copy region at back of region"
  (if (> from to)
      (rotatef from to))
  (let ((cp-str))
     (setq co-str (buffer-substring from to))
     (goto-char to)
     (insert co-str)
   ))



カウント 文字と行

いろいろやり方があるらしい(05/04/2002) ポイントが文字数を表すのでそのまま引く、また改行にも考慮すればいい。 検索(S) から一致する文字を数える で "."(ピリオド)を入れて正規表現のみで行頭で検索する方法もある。
(defun count-char-num-region (from to)
  (interactive "*r")
  (save-excursion
	 (if (> from to)
		  (rotatef from to))
	(let ((cn)(ln))
	 (setq cn (- to from))
	 (setq ln
	 (- (progn
         (goto-char to)
         (current-line-number))
       (progn
         (goto-char from)
			(current-line-number))))
	 (incf ln)

;	 (msgbox "文字数: ~D\n行数: ~D" cn ln)
	 (message "文字数: ~D | 行数: ~D" cn ln)
	  )))
(defun get-line-length ()
  (goto-eol)
  (current-column))


カウント用の文字列を挿入

こんなのとか
0123456789012345678901234567890123456789
こんなの
0123456789ABCDEF0123456789ABCDEF01234567
(defun insert-number-chars (num &optional radix)
  (unless radix (setq radix 10))
  (dotimes (i num)
   (insert (digit-char (mod i radix) radix))))

(defun insert-number-charcters-interactive (&optional r)
  (interactive "*p")
  (insert-number-chars (read-integer "insert column:") r))
(基数を変えるときは 、変速の使い方で C-u 16 M-x insert-number-charcters-interactive と入力してください。)

クリップボードをメモ帳として使う


;この変数に設定しておくと、このファイルの --MEMO--の次の行から メモっていく
;(defvar memo-file-name "C:\\WINDOWS\\Profiles\\TKI\\デスクトップ\\memo.txt")

(defun memo-in-clipboard()
  "クリップボードを定期的にチェックしてメモする"
  ;cancel は C-gで
  (interactive)
  (let ((memos "")(wait-time 3)(last-memo) (memo-buffer-name) (memo-buffer))
	 (setq last-memo (get-clipboard-data))
	 (if
		  (and memo-file-name
				 (valid-path-p memo-file-name)
				 (find-file memo-file-name))
		  (progn
			(setq memo-buffer
			 (switch-to-buffer
			  (get-file-buffer memo-file-name)))
			 (setq memo-buffer-name (buffer-name memo-buffer))
			 (goto-char (point-min))
			(when (scan-buffer "--MEMO--" :case-fold t :tail t)
			  (forward-line)
			  (goto-bol)
			  ))
	  (progn
		 (setq memo-buffer-name "*memos*")
		 (setq memo-buffer (get-buffer-create memo-buffer-name))
		 (switch-to-buffer memo-buffer)
		 ))
	 (sit-for .1)
	 (while t
		(sit-for wait-time)
		(message "now memo mode..")
		(unless (string= last-memo (get-clipboard-data))
		  (setq last-memo (get-clipboard-data))
		  (setq memos (concat memos last-memo))
		  (switch-to-buffer memo-buffer)
		  (insert last-memo "\n"))
		(message "now memo mode..")
		)
	 ))

特定の日付文字を入れる

カーソルの位置に特定の日付を入れます。

(defun insert-date-string-my-type ()
  (interactive)
  (if (scan-buffer "\([0-9]+/[0-9]+/[0-9][0-9]+)" :regexp t :limit (+ 40 (point)))
		(delete-char (- (match-end 0) (match-beginning 0)))
	 (if (scan-buffer "\([0-9]+/[0-9]+/[0-9][0-9]+)" :regexp t :limit (- 40 (point)) :reverse t)
		  (delete-char (- (match-end 0) (match-beginning 0)))
		)
	 )
  (insert
	(format-date-string "(%m/%d/%Y)" (get-universal-time)))
  )
こんなの (01/10/2002) 前後にカーソルがあると 消して置き換えてくれます。
40という数字でかいっぽいので、10ぐらいに抑えた方が良いかも

ref. *date-formats*

括弧らを自動的に閉じる

"("という文字を入力すると、右側に")"と入れてくれるただそんだけ。
{}だけちょっと動作が違う。 (cや javaに主に対応)

対応括弧を自動挿入一つのファイルに分離


しょぼしょぼすくりぷと xyzzy | lisp サンプルLibrary集