Select sjis if the characters are not shown properly. Internet Expolorer is the targetted browser.

kh-base.l


(File "sitelisp.lnk" "kh-base.l")

[TopHdngList] [BodyStart] [Top] [End]

CONTENTS     CONTENTS が閉じられているときでも [Contents] ボタンは有効です。
CONTENTS が閉じられているときに、アウトライン見出しのところに表示 されている [Contents] ボタンをクリックすると、 CONTENTS を表示して、 そのアウトライン見出しに対応している CONTENTS の中の見出しにジャンプします。
この後、CONTENTS は表示されたままになります。
CONTENTS 内の各行の最後に示されている数字は、 そのアウトライン見出し行が文書ファイルの何行目にあるかを表しています。

[ContentsTop]
TOP HDNG LIST    ALL HEADING LIST    NOTE LIST 

[Close TOP HEADING LIST]

ALL HEADING LIST　■はアウトライン見出しのタイトル □はそれ以外
14 ＊1 ■概要
95 ＊2 ■require 文
110 ＊3 ■provide 文
125 ＊4 ■defalias -- このファイルの中でも使うので前の方に置く
162 ＊5 ■activate-powershell, powershell-activate
207 ＊6 ■add-prefix
279 ＊7 ■adjust-line -- 行末に、指定した文字を繰り返し埋める
313 ＊8 ■cat -- 引数で指定するファイルを stream に書き出す
338 ＊9 ■cfill -- 前置文字列の中の文章を fill する
441 ＊10 ■cfill-region -- fill する範囲を指定して、cfill
484 ＊11 ■change-split-direction -- 窓の分割方向を変える
541 ＊12 ■char-line -- 横線を引きます。
570 ＊13 ■check-selected-region -- 指定した範囲を印刷準備する
586 ＊14 ■checkdq -- カーソル位置以降で、二重引用符号の対応を検査
613 ＊15 ■chfill -- 段落を整形。ぶら下げインデントにも対応。
619 ● □関数 hfill は、こんな風に、段落の最初にだけ段落の開始を
707 ＊16 ■chfill-line -- 行末までの一行を fill します
729 ＊17 ■chfill-region -- 指定した範囲を chfill する
809 ＊18 ■chindent-rigidly -- コメント文の中の段落を字下げ
860 ＊19 ■clear-kill-ring -- kill-ring を clear します
886 ＊20 ■cline -- 行末まで , (カンマ)を埋めます。
898 ＊21 ■clipboardtorun
918 ＊22 ■close-window -- 窓の高さを半分にして窓を削除します
939 ＊23 ■command-substitution -- コマンドを実行結果の文字列を返す
993 ＊24 ■concatlines -- 文字列のリストlinesを改行文字で連結して返す
1015 ＊25 ■connect-lines -- 行末に _ がある行をつぎの行に継続する
1046 ＊26 ■count-buffer-char -- バッファ内の文字数をカウント
1081 ＊27 ■cram -- カーソルがある行以降を一行に詰め込み
1233 ＊28 ■create-shortcut-to-filelink -- ファイルへのショートカット
1295 ＊29 ■decrement-number -- カーソル位置の数字を1減らします
1335 ＊30 ■define-barfunc -- lisp 式を呼び出す関数 barfunc を定義する
1452 ＊31 ■define-barfunc-from-clipboardstring -- クリップボードのlispコードを実行する関数を作る
1493 ＊32 ■defun-in-editor-package -- editor パッケージの関数として定義
1532 ＊33 ■defun-in-user-package -- user パッケージの関数として定義
1576 ＊34 ■delete-line -- カーソル位置の一行を削除
1599 ＊35 ■delete-newline -- 行末の newline 文字を削除
1626 ＊36 ■delete-newline-and-trailing-spaces -- 改行と次行の行頭空白を削除
1656 ＊37 ■delete-prefix, remove-prefix -- 指定した範囲の前置文字列を削除
1732 ＊38 ■delete-preseding-spaces -- カーソル位置の前の空白文字列を削除
1750 ＊39 ■delete-trailing-spaces -- カーソル位置から後の空白文字を削除
1771 ＊40 ■display-after
1809 ＊41 ■display-before
1850 ＊42 ■display-oneline -- 行頭空白文字列を削除し行頭に ",,, " を挿入
1869 ＊43 ■dline -- 行末まで = を埋めます。
1881 ＊44 ■edit-in-other-window -- eo.bat と連携する関数
1913 ＊45 ■eval-in-other-window -- 反対側の窓で関数を呼び出す
2173 ＊46 ■exec-open-filer -- xyzzyの外部からファイラーを開く
2206 ＊47 ■exist-in-path-p -- path 環境変数に登録されているか検査
2235 ＊48 ■explorer -- 編集中のファイルがあるディレクトリをexplorerで開く
2258 ＊49 ■exec-clpstring -- クリップボードのリスプコードを実行する
2293 ＊50 ■enlarge-half-width -- 窓の幅を 82 桁に拡張します。
2308 ＊51 ■eval-to-clipboard -- コードを実行した結果をクリップボードに格納
2354 ＊52 ■folder -- カーソル位置に書いてあるフォルダーをファイラーで開く
2400 ＊53 ■fdefun -- 指定した名前の関数の定義場所を探す
2504 ＊54 ■file-in-other-window
2532 ＊55 ■flushright -- 文字列を右詰めする
2557 ＊56 ■file-to-clipboard -- 引数のファイルの内容をクリップボードに記憶
2592 ＊57 ■fdq -- 二重引用符号を探す
2633 ＊58 ■finddq -- 二重引用符号を検索
2673 ＊59 ■file -- バッファに書いてあるファイル名のファイルを開く
2722 ＊60 ■firstline
2737 ＊61 ■Fref -- 他のファイルの特定の場所にjump
2829 ＊62 ■fref -- 他のファイルの特定の箇所に jump する
2932 ＊63 ■get-quoted-string -- fdefun の補助の関数
2989 ＊64 ■gline -- 行末まで ━ を埋めます。
3001 ＊65 ■goto-first-window -- 先頭の窓に移動
3015 ＊66 ■goto-last-window -- 最後の窓に移動
3030 ＊67 ■get-window-buffer -- 現在の窓のバッファを取得
3046 ＊68 ■get-long-path-name
3071 ＊69 ■goto-window-top -- カーソルを窓の先頭に移動する
3087 ＊70 ■goto-window-center -- カーソルを窓の中央に移動する
3106 ＊71 ■goto-window-bottom -- カーソルを窓の最下行に移動する
3126 ＊72 ■goto-window-last5 -- 画面の下から5行目にカーソルを移動
3147 ＊73 ■hsplitted-p -- 上下にに分割されているか
3175 ＊74 ■hfill-continue-region-p
3227 ＊75 ■hfill-nextline -- 前置文字列を考慮して次の行まで連結
3293 ＊76 ■hfill -- ぶら下げインデントの段落を整形
3484 ＊77 ■insert-date -- 現在の年月日を 2010-05-01 のような形式で挿入する
3521 ＊78 ■insert-bdate -- 今日の日付文字列をカギ括弧付きで挿入します。
3542 ＊79 ■insert-date-and-time, insert-time
3562 ＊80 ■item
3618 ＊81 ■itemend -- ファイルの最後に項目を追加
3639 ＊82 ■in-left-window-p -- カーソルが左の窓に居るか
3658 ＊83 ■in-upper-window-p -- カーソルが上の窓に居るか
3676 ＊84 ■insert-random8 -- カーソル位置に8桁のランダム数値を挿入
3699 ＊85 ■insert-random8d -- カーソル位置に8桁のランダム数値を挿入
3723 ＊86 ■insert-random6 -- カーソル位置に6桁のランダム数値を挿入
3739 ＊87 ■increment-number -- カーソル位置の数字を1増やす
3787 ＊88 ■jump-to-the-line -- カーソル行と同じ行を他バッファから探す
3820 ＊89 ■kh-excr -- コメント領域に記載されている lisp 式を実行する
3912 ＊90 ■kh-excr-in-other-window -- kh-excr を他窓で実行
4003 ＊91 ■kh-move-to-next-same-length-line
4067 ＊92 ■kh-move-to-next-same-length-line-and-cut
4087 ＊93 ■kh-move-to-next-line
4129 ＊94 ■kh-line-adjust
4161 ＊95 ■kh-quiet-match-paren
4192 ＊96 ■kill-ring-yank-pointer-reset
4212 ＊97 ■kill-shell-buffer
4243 ＊98 ■kill-shell-window
4274 ＊99 ■kill-window -- 選択されている窓と窓に対応しているバッファを削除
4322 ＊100 ■line
4356 ＊101 ■list-buffer-window
4386 ＊102 ■list-windows
4409 ＊103 ■lookfor-headline
4467 ＊104 ■linkpath -- リンクファイルの指す先を返す
4485 ＊105 ■looking-at-backward -- looking-at 後方版 (正規表現で後方マッチ)
4510 ＊106 ■make-window-half -- 画面を上下二つに分けて、二つのバッファの内容を表示
4546 ＊107 ■make-window-half-next-buffer -- 画面を上下二つに分けて、二つのバッファの内容を表示
4582 ＊108 ■make-window-half-vertically
4613 ＊109 ■mark-first-half
4626 ＊110 ■mark-latter-half
4639 ＊111 ■move-to-sixth-line
4663 ＊112 ■move-to-fifth-line
4687 ＊113 ■my-adjust-mini-buffer-height
4703 ＊114 ■my-buffer-exist-p -- 指定するファイルのバッファがあるか
4742 ＊115 ■my-clear-rectangle
4762 ＊116 ■my-close-all-buffers-except-this
4786 ＊117 ■my-copy-rectangle
4806 ＊118 ■my-delete-rectangle
4822 ＊119 ■my-delete-window
4878 ＊120 ■my-delete-other-window
4930 ＊121 ■my-delete-other-window-vertically
4973 ＊122 ■my-delete-previous-window
4986 ＊123 ■my-delete-next-window
4999 ＊124 ■my-eval-last-sexp -- 現在の窓で、カーソル位置のlisp式を実行
5150 ＊125 ■my-eval-last-sexp-in-other-horizontal-window -- 別の窓で実行
5171 ＊126 ■my-exchange-window
5196 ＊127 ■my-filer-cleandir
5219 ＊128 ■my-filer-everything
5240 ＊129 ■my-filer-filesdir
5260 ＊130 ■my-filer-filesdirectory
5301 ＊131 ■my-filer-msd
5367 ＊132 ■my-filer-001file
5395 ＊133 ■my-filer-mksamedir
5427 ＊134 ■my-filer-mk-shortcut
5450 ＊135 ■my-goto-leftwindow
5471 ＊136 ■my-goto-line-end
5502 ＊137 ■my-insert-file
5524 ＊138 ■my-kill-buffer
5562 ＊139 ■my-kill-rectangle
5582 ＊140 ■my-kill-word
5606 ＊141 ■my-match-paren -- 対応する括弧にジャンプ
5626 ＊142 ■my-message-box
5656 ＊143 ■my-open-directory-where-buffer-file-be
5683 ＊144 ■my-open-directory-where-current-buffer-file-be
5703 ＊145 ■my-open-rectangle
5719 ＊146 ■my-set-height
5746 ＊147 ■my-split-window
5767 ＊148 ■my-switch-window-horizontally
5805 ＊149 ■my-switch-window-vertically
5838 ＊150 ■my-split-window-vertically
5877 ＊151 ■my-same-buffer-in-other-window -- 同じバッファを反対の窓で表示
5903 ＊152 ■mysearch-forward-in-line
5940 ＊153 ■myre-search-forward-in-line
5980 ＊154 ■myre-search-backward-in-line -- カーソル位置より前で行内検索
6027 ＊155 ■mycombine-lines
6056 ＊156 ■mycombine
6088 ＊157 ■moveto-nextline
6117 ＊158 ■my-get-file-buffer
6154 ＊159 ■newlineafterkuten
6185 ＊160 ■open-folder
6204 ＊161 ■open-this-folder
6235 ＊162 ■polite
6258 ＊163 ■powershell-in-other-window
6302 ＊164 ■prepare-other-window
6341 ＊165 ■print-selected-region-dialog
6364 ＊166 ■restore-mode -- mode を *temp-mode* に戻す
6379 ＊167 ■rd4
6398 ＊168 ■run-explorer
6463 ＊169 ■right-justify
6484 ＊170 ■recordXyzzyRunDate
6514 ＊171 ■repthisfile
6557 ＊172 ■readin-file
6581 ＊173 ■remaining-charlength-to-line-end
6608 ＊174 ■reset-half-width -- 窓の幅を半幅に戻す。
6625 ＊175 ■set-timer -- 分指定のタイマー
6657 ＊176 ■set-half-height
6680 ＊177 ■set-third-height
6700 ＊178 ■set-twothird-height
6720 ＊179 ■set-quarter-height
6740 ＊180 ■sitelisp -- site-lisp の下のファイルを編集
6760 ＊181 ■sline, sfill -- 行末まで半角空白を埋める
6782 ＊182 ■start -- ファイル名文字列の先頭にカーソルを置いて start
6809 ＊183 ■save-mode -- 現在編集中の mode を*temp-mode*に記憶
6831 ＊184 ■scratch-in-other-window -- 下の窓に*scratch*を表示
6905 ＊185 ■shell-in-other-window
6994 ＊186 ■sfind
7114 ＊187 ■shell-command-to-string -- 外部コマンドの標準出力への文字
7140 ＊188 ■standard-filename-expression
7170 ＊189 ■show-other-buffer
7217 ＊190 ■show-kill-ring
7232 ＊191 ■scroll-to-window-top
7249 ＊192 ■scroll-to-window-bottom
7268 ＊193 ■show-in-other-window -- 現在の半窓のバッファを反対側の窓で表示
7323 ＊194 ■show-in-two-windows
7339 ＊195 ■scroll-toline5
7360 ＊196 ■scroll-page
7388 ＊197 ■search-clipboard-string
7405 ＊198 ■strrun
7424 ＊199 ■todayFirstRunP
7468 ＊200 ■url
7494 ＊201 ■view-register-list-key
7535 ＊202 ■vsplitted-p -- 左右に分割されているか
7563 ＊203 ■writeto-file
7586 ＊204 ■xactivate
7601 ＊205 ■yank
7629 ＊206 ■zline
7644 ＊207 ■mytagjump
7683 ＊208 ■show-current-line
7704 ＊209 ■save-winconf
7720 ＊210 ■revert-winconf

[Close ALL HEADING LIST]

NOTE LIST
Note の一覧: Note はありません。

[Close NOTE LIST]
[Top] [End] [ContentsTop]

[CTop] [Contents][TopHdngList][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

1 概要

このファイルにはいつも使うものを収録します。

◆ 依存関係について、重要な注意

kh-base.l は、ベーシックなものを収録することにします。他のリスプファイルで定義されている関数を使わないように注意します。
.xyzzy の途中で、kh-base.l を読み込んでいます。それにも注意。

kh-base.l は、.xyzzy の中で、すなわち、

  (fref "10118750" "commondotfiles.lnk" ".xyzzy ")

で、

  (recompile-if-updated "kh-base")
  (load-library "kh-base")

のように書いて、読み込んでいます。

使うときに読み込むものは、kh-foo.l, kh-bar.l, ... のように、kh- で始まる lisp ファイルにします。

基礎的なものは kh-base.l に書いていつも読み込むことにし、必要に応じて読み込むものは、kh-foo.l, kh-bar.l, ... という名前のファイルに書いて読み込むということです。

◆ あたらしい lisp関数の定義を書くときは、ファイルの最後に追加するのを基本方針とします。

◆ このファイルを編集するときの注意

このファイル kh-base.l は、o2h.rb を使用して、html ファイルに変換できます。

新しい関数の定義を挿入するときは、プログラムコードの途中で、コメント文の途中ではなく、コードの塊の最後で、コメントブロックが始まる前の箇所にカーソルを置いて

M-x insert-odrsection

としてください。sectionname: を入力するように要求されたら、

これから作成しようとしている関数の名前

を入力してください。

ODR 文書として見たら、code 環境を終えて、ODR 文書ブロックを挿入し、また、新たな code 環境を開始したように見えます。

[2017-12-30]
cbar が作成した、拡張子 .exe を持つアプリを呼び出す関数を含むものは、この kh-base.l から別の lisp ファイルに移動する作業が必要です。

このファイルの中で コードを定義するときに、File 関数が使用されているとき は、書き換えてください。

  (File "...")

の形のコードは、

  (call-process
   (concat (si:system-root) "xyzzycli.exe " "..."))

に書き換えてください。File 関数は、kh-xyzzyfunc.l の中で定義されていて、kh-base.l を呼び出すときは、未だ kh-xyzzyfunc.l を読み込んでいないので、File 関数が定義されていない状態と考えるからです。

コードの説明部分に書かれている File 関数はそのままにしておいて、大丈夫です。

lisp プログラムの中で定義されている *my-home* のようなスペシャル変数は、C:/tools/xyzzy の下 (直下とは限らない) の starvariable.l の中や .xyzzy の中で、例えば

  (setq *my-home* "C:/home/me/")

のように定義するものとします。

この lisp プログラムの中では、つぎのスペシャル変数が参照されています。

スペシャル変数名 内容
*my-sitelisp* site-lisp ディレクトリ
*my-default-fill-column* fill-column のデフォールト値
*my-userdir* ユーザディレクトリ C:/User/me など

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

2 require 文

このプログラムには require 文はありません。

下の proglist を有効にするときは、♯を半角の # にしてください。

| @begin{code}{proglist} -------------------------------------
| |♯
| ; (require "kh-fileinfo")
| ♯|
| @end{code} -------------------------------------------------

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

3 provide 文

kh-base.l で定義された Lisp 関数を使用することを前提とした lisp ファイルには、

(require "kh-base")

のような require 文を書き込みます。次のコードは、kh-base.l を読み込むと、この require 文の要求を満たしていることが確認されます。(require "kh-base") 文を読み込んだときに、未だ (provide "kh-base") に遭遇していなかったら、そこで、kh-base.l を読み込むという動作をします。

001: (provide "kh-base")

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

4 defalias -- このファイルの中でも使うので前の方に置く

[2016-04-13]
.xyzzy の中にも defalias の定義があります。ダブっているようにも思いますが、.xyzzy の中の defalias の定義は、editor パッケージの中で定義されています。なので、user パッケージで定義されているここの定義とは二重になるということはありません。

Lisp 関数の定義箇所にジャンプするのに使う M-x my-tagjump はdefalias で定義した名前には対応できないので、あまり defalias を使わない方がいい。

使用例

  (defalias 'kw 'kill-window)
  ; M-x kw で、M-x kill-window としたことになります。

この関数の定義位置を変えないように。最初の関数定義より、前に置いてください。

理由
このファイルの中の地のコードで、defalias を使用しているので、そこを評価する時点で、defalias が定義されている必要があります。

defalias の欠点
defalias で定義した名前は、mytagjump などで検索できません。

  (defalias 'kw 'kill-window)

と定義している場合、(mytagjump "kill-window") はできるのに、(mytagjump "kw") で検索に成功しません。

002: (defun defalias (symbol definition &optional docstring)
003:   (if (symbolp definition)
004:       (si:*fset symbol (symbol-function definition))
005:     (si:*fset symbol definition)))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

5 activate-powershell, powershell-activate

AutoHotkey.exe を使用して、powershell の窓をアクティブにします。

AutoHotkey.exe は、キーカスタマイズもできる強力なアプリケーションです。環境変数 AutoHotkey に、AutoHotkey.exe をインストールしているディレクトリを記憶しているものとします。

C:/scriptfile に、AutoHotkey.exe から呼び出すスクリプトを置くものとします。C:/scriptfile に、つぎのような内容のファイル activate-powershell.ahk を置いてください。

※ c:/scriptfile には、AutoHotkey.exe のスクリプトや uwsc, Ruby のスクリプトを置くことにします。

activate-powershell.ahk
WinActivate, ahk_exe powershell.exe

つぎの行の行末で、M-x eval-last-sexp としてみてください。

  (activate-powershell)

006: (defun activate-powershell ()
007:   (interactive)
008:   (if (not (si::getenv "AutoHotkey"))
009:     (progn
010:       (message-box 
011:        (concat "環境変数 AutoHotkey が定義されていません。")
012:        "activate-powershell"
013:        '(:information))
014:       (call-process (concat (si:system-root) "xyzzycli.exe"))
015:       (return-from activate-powershell)))
016:   (call-process 
017:    (concat 
018:     (map-backslash-to-slash (si::getenv "AutoHotkey"))
019:     "/Autohotkey.exe "
020:     "C:/scriptfile/activate-powershell.ahk")
021:    ); end of call-process
022:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

6 add-prefix

(fdefun "comment-out-code" "sitelisp.lnk" "kh-myregion.l")も参照してください。

一連のコードの先頭に文字列を追加します。

   @begin{foo} -------------------------------------------
   aaaa
   bb
   cc
   @end{foo} ---------------------------------------------

のコードに "| " を追加して、

   @begin{foo} -------------------------------------------
   | aaaa
   | bb
   | cc
   @end{foo} ---------------------------------------------

のようにしたいとします。

aaaa の行から、cc の行までを範囲指定して、M-x add-prefix します。この例では、The column postion of the beginning of line:に対して、5 と応えて、prefix-string には、"| " (引用符号は入力しません。) と応えます。

各行に前置されている文字列を削除するには、delete-prefix を使用してください。

023: (defun add-prefix (column)
024:   (interactive
025:       "nprefix の挿入位置(行頭は1、0なら前置文字列末尾) : ")
026:   (let (prefix startposition endposition startline 
027:                lastline cline)
028:     (setq prefix (read-string "prefix-string: "))
029:     (setq startposition (region-beginning))
030:     (setq endposition (region-end))
031:     (setq startline (count-lines 1 startposition))
032:     (setq lastline (count-lines 1 endposition))
033:     (goto-char startposition)
034:     (if (= column 0)
035:         (progn
036:           (back-to-indentation)
037:           (setq column (+ (current-column) 1)
038:                 )))
039:     (beginning-of-line)
040:     (setq cline startline)
041:     (while (< cline lastline)
042:       (beginning-of-line)
043:       (if (> column 0)
044:            (forward-char (- column 1)))
045:       (insert prefix)
046:       (beginning-of-line)
047:       (setq cline (+ cline 1))
048:       (forward-line 1))
049:     )
050:   )
051: 
052: ; insert-prefix だったかなと思うこともあるので、alias を定義
053: ; しました。
054: ; 
055: ; add-prefix が既に定義されている関数の名前。
056: (defalias 'insert-prefix 'add-prefix)

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

7 adjust-line -- 行末に、指定した文字を繰り返し埋める

引数 arg に格納されている文字列 (実際は1文字しか格納していないものとする) を行末に充填もしくは削除して、長さをfill-column にする。

実行例
ここの行の行末に、カンマを繰り返し挿入。,,,,,,,,,,,,,,,,,,

057: (defun adjust-line (arg)
058:   (interactive "sEnter a character ")
059:   (let (lenline cnum cpos)
060:     (setq lenline fill-column)
061:     (setq cpos (point))
062:     (end-of-line)
063:     (setq cnum (current-column))
064:     (if (<= cnum lenline)
065:         (while (< cnum lenline)
066:           (insert arg)
067:           (end-of-line)
068:           (setq cnum (current-column)))
069:       (progn
070:         (while (> cnum lenline)
071:           (forward-char -1)
072:           (setq cnum (current-column)))
073:         (if (looking-at (concat arg "+$"))
074:             (kill-line)))
075:       )
076:     ); end of let
077:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

8 cat -- 引数で指定するファイルを stream に書き出す

http://lisperblog.blogspot.com/2008/10/xyzzy.html

で紹介された cat 関数です。

cat は、引数で指定するファイルを stream に書き出します。

cat は、例えば、shell-command-to-string の中で使用されています。

078: (defun cat (file &optional stream)
079:   "print file contents."
080:   (with-open-file (fp file)
081:     (do ((ch (read-char fp nil nil)
082:              (read-char fp nil nil)))
083:         ((null ch))
084:       (princ ch stream))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

9 cfill -- 前置文字列の中の文章を fill する 

; カーソルがある行の行頭から " #%;/>:" に合致する
; 文字からな
; る文字列を fill-prefix として、詰め込みます。カーソルがあ
; る行から収集した fill-prefix に合致する詰め込み
; 接頭辞が先
; 頭にある行だけをfill します。要するにここのように行頭に注
; 釈行であることを示すような記号が書いてあって、
; その後に文字
; を詰め込み処理するようなときにこの整形コマンド cfill を使
; って下さい。

最初の行にカーソルを置いて、M-x cfill とすると、つぎのように整形されます。前置文字列が書いていないか、前置文字列があっても、段落の区切りと思われる文字列があれば、そこが整形する範囲の最後と判定されます。

; カーソルがある行の行頭から " #%;/>:" に合致する文字からな
; る文字列を fill-prefix として、詰め込みます。カーソルがあ
; る行から収集した fill-prefix に合致する詰め込み接頭辞が先
; 頭にある行だけをfill します。要するにここのように行頭に注
; 釈行であることを示すような記号が書いてあって、その後に文字
; を詰め込み処理するようなときにこの整形コマンド cfill を使
; って下さい。

2011-09-17
詰め込み接頭辞がヌルになるケースでも動作するように修正しました。

[2017-07-23]
行頭にピリオドがあるとその行から後は詰め込まれないようにしました。

カーソルのある行が fill の開始行になり、その前の行に詰め込まれることはありません。

085: (defvar myskipchars " '#%;/>:_|!")
086: ;(defvar myskipchars " #%;/")
087: 
088: (defun cfill ()
089:   (interactive)
090:   (let (begp endp fprefix)
091:     (beginning-of-line)
092:     (skip-chars-forward myskipchars)
093:     (set-fill-prefix)
094:     (setq fprefix nil)
095:     (if fill-prefix
096:         (setq fprefix (regexp-quote fill-prefix)))
097:     (beginning-of-line)
098:     (setq begp (point))
099:     ; [2017-07-23] 行頭にピリオドがあるとその行から後は詰め
100:     ; 込まれないように変更したのに伴って、つぎの一行を入れま
101:     ; した。
102:     (next-line)
103:     ; この後、fill する範囲の終端を決めています。
104:     (if fprefix
105:         (while 
106:             (and (looking-at fprefix)
107:                  (not (looking-at (concat fprefix "[ ].*$")))
108:                  (not (looking-at (concat fprefix "[ ]*$")))
109:                  (not (looking-at (concat fprefix "^[ ]*@end")))
110:                  (not (looking-at (concat fprefix "^[ ]*¥¥¥¥end")))
111:                  (not (looking-at 
112:                        (concat fprefix "^[ ]*¥¥¥¥item")))
113:                  (not (looking-at (concat fprefix "^[ ]*---")))
114:                  (not (looking-at (concat fprefix "[ ]*¥¥.")))
115:                  )
116:           (next-line)
117:           )
118:       (while (not (or (looking-at "^[ ].*$")
119:                       (looking-at "^[ ]*$")
120:                       (looking-at "^[#%;*/:']")
121:                       (looking-at "^[ ]*@end")
122:                       (looking-at "^[ ]*¥¥¥¥end")
123:                       (looking-at "^[ ]*¥¥¥¥item")
124:                       (looking-at "^[ ]*---")
125:                       (looking-at "^[ ]*¥¥.")
126:                       ; (looking-at "^[ ]*[.]")
127:                       ))
128:         (next-line)))
129:     (beginning-of-line)
130:     (setq endp (point))
131:     ; 
132:     (goto-char begp)
133:     (fill-region-as-paragraph begp endp)
134:     (setq fill-prefix nil)
135:     ; つぎの2行があった方がいいかよく分かりません。前の行の
136:     ; 行末に移動するようにしています。
137:     (next-line -1)
138:     (end-of-line)
139:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

10 cfill-region -- fill する範囲を指定して、cfill

cfill は、詰め込み接頭辞にマッチする間は fill するようにしていますが、cfill-region では、fill する region を指定することにしました。

fill する行の最初の行のどこかのカラムと fill する行の次の行のどこかのカラムを範囲してします。どちらかで、C-SPACE を押し、他方にカーソルを移動して、この関数を実行してください。

140: (defun cfill-region (beg end)
141:   (interactive "r")
142:   (let (begp endp fprefix)
143:     ; (goto-char (region-beginning))
144:     (goto-char (min beg end))
145:     (beginning-of-line)
146:     (skip-chars-forward myskipchars)
147:     (set-fill-prefix)
148:     (setq fprefix nil)
149:     (if fill-prefix
150:         (setq fprefix (regexp-quote fill-prefix)))
151:     (beginning-of-line)
152:     (setq begp (point))
153:     ; (setq endp (region-end))
154:     (goto-char (max beg end))
155:     (beginning-of-line)
156:     (setq endp (point))
157:     ; 
158:     (goto-char begp)
159:     (fill-region-as-paragraph begp endp)
160:     (setq fill-prefix nil)
161:     ; つぎの2行があった方がいいかよく分かりません。前の行の
162:     ; 行末に移動するようにしています。
163:     (next-line -1)
164:     (end-of-line)
165:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

11 change-split-direction -- 窓の分割方向を変える

窓の分割方向を変えます。上下方向に分割されていれば、左右に分割されるようにし、左右に分割されていれば、上下に分割されるようにします。

  +-----------+-----------+         +-----------------------+
  |           |           |         |                       |
  |           |           |         |                       |
  |           |           |         +-----------------------+
  |           |           |         |                       |
  |           |           |         |                       |
  +-----------+-----------+         +-----------------------+

のような窓の分割方向を切り替えます。

166: (defun change-split-direction ()
167:   (interactive)
168:   (let (bufa bufb u (wp nil))
169:     (if (hsplitted-p)
170:         ; 上下方向に分割されていた。
171:         (progn
172:           (setq u (nth 1 (window-coordinate)))
173:           (if (eq u 0)
174:               ; 下の窓に移動する
175:               (progn
176:                 (other-window) (setq wp t)))
177:           ; (message-box "下の窓")
178:           (setq bufb (selected-buffer))
179:           (delete-window)
180:           (split-window (* -1 (floor (/ (window-width) 2))) t)
181:           (switch-to-buffer bufb)
182:           (if wp (other-window -1)))
183:       (progn
184:         (if (vsplitted-p)
185:             ; 左右方向に分割されていた。
186:             (progn
187:               (setq u (nth 0 (window-coordinate)))
188:               (if (eq u 0)
189:                   ; 右の窓に移動する
190:                   (progn
191:                     (other-window) (setq wp t)))
192:               (setq bufb (selected-buffer))
193:               (delete-window)
194:               (split-window (* -1 (floor (/ (window-height) 2))) nil)
195:               (switch-to-buffer bufb)
196:               (if wp (other-window -1)))
197:           ;(message-box "not splitted.")
198:           )
199:         ))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

12 char-line -- 横線を引きます。

横線を引きます。

; ======================================================
; ━━━━━━━━━━━━━━━━━━━━━━━━━━━


200: (defun char-line (arg)
201:   (interactive "sEnter a character ")
202:   (let (lenline cnum)
203:     (setq lenline fill-column)
204:     (if (> fill-column 60)
205:         (setq lenline 60))
206:     (end-of-line)
207:     (setq cnum (current-column))
208:     (while (< cnum lenline)
209:        (insert arg)
210:        (end-of-line)
211:        (setq cnum (current-column))
212:       )))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

13 check-selected-region -- 指定した範囲を印刷準備する

範囲指定したリージョンを *print-region* バッファにコピーして、印刷の準備をします。

213: (defun check-selected-region (from to)
214:   (interactive "r")
215:   (copy-region-as-kill from to)
216:   (switch-to-buffer "*print-region*")
217:   (yank))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

14 checkdq -- カーソル位置以降で、二重引用符号の対応を検査

カーソル位置以降で、二重引用符号の対応が取れていない行がないか検査します。

二重引用符号の対応が取れていないと考えられる行がない場合は、

  "これ以降、二重引用符号がありません。"

という表示が出ます。

218: (defun checkdq ()
219:   (interactive)
220:   (setq *lastpos* (point))
221:   (loop
222:     (if (not (finddq))
223:         (return-from checkdq)
224:       )
225:     )
226:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

15 chfill -- 段落を整形。ぶら下げインデントにも対応。

カーソル位置が見出し行なら hfill を、そうでなければcfill を呼び出します。

● 関数 hfill は、こんな風に、段落の最初にだけ段落の開始を
   表す文字列があってその後に、行頭に空白文字列が続く形に
   成形します。

cfill は、カーソルがある行の行頭から " #%;/>:" に合致する文字からなる文字列を fill-prefix として、詰め込みます。カーソルがある行から収集した fill-prefix に合致する詰め込み接頭辞が先頭にある行だけをfill します。要するにここのように行頭に注釈行であることを示すような記号が書いてあって、その後に文字を詰め込み処理するようなときにこの整形コマンド cfill を使って下さい。

; ● 関数 hfill は、こんな風に、段落の最初にだけ段落の開始を ; 表す文字列があってその後に、 ; 行頭に空白文字列が続く形に ; 成形します。

hfill は、cfill の機能も持っています。hfill は、見出し行を整形する機能を付加した cfill です。

[2016-04-18] 拡張子が .bat や .rb の時に、fill-column を小さくして fill するように変更しました。

227: (defun chfill ()
228:   ; カーソル位置が見出し行なら hfill を、そうでなければcfill 
229:   ; を呼び出します。
230:   (interactive "*")
231:   (let ((headlinep nil) extension fc)
232:     ; @begin{Inserted on 2016-04-18} -----------------------
233:     (setq fc fill-column)
234:     (if (get-buffer-file-name)
235:         (progn
236:           (setq extension (pathname-type (get-buffer-file-name)))
237:           (if (or (string= extension "bat")
238:                   (string= extension "rb"))
239:               (set-fill-column (- *my-default-fill-column* 4)))
240:           )
241:       )
242:     ; @end{Inserted on 2016-04-18} -------------------------
243:     (beginning-of-line)
244:     (skip-chars-forward myskipchars)
245:     (setq headlinep nil)
246:     (cond 
247:      (;   1a. ああああ
248:       (looking-at "¥¥([0-9][0-9]*¥¥|[a-zA-Z][a-zA-Z]*¥¥)[¥.)] ")
249:       (setq headlinep t)
250:       )
251:      (;   (1) ああああ
252:       (looking-at "¥¥(([0-9][0-9]*¥¥|[a-zA-Z][a-zA-Z]*¥¥)) ")
253:       (setq headlinep t)
254:       )
255:      (;   1.2 ああああ
256:       (and (looking-at "[0-9a-zA-Z][¥.0-9a-zA-Z]*[0-9a-zA-Z])? ")
257:          (not (looking-at "[0-9a-zA-Z][0-9a-zA-Z]* "))
258:          (not (looking-at "[a-zA-Z][0-9a-zA-Z]*¥.[a-zA-Z][a-zA-Z]*"))
259:            )
260:       (setq headlinep t)
261:       )
262:      (;   word : ああああ
263:       (looking-at "[^:¥n][^:¥n]* : ")
264:       (setq headlinep t)
265:       )
266:      (;   word : ああああ
267:       (looking-at "[^:¥n][^:¥n]* :: ")
268:       (setq headlinep t)
269:       )
270:      (;   ● ああああ
271:       (looking-at "¥¥(●¥¥|■¥¥|○¥¥|□¥¥|・¥¥|※¥¥|[-*+][-*+]*¥¥) ?")
272:       (setq headlinep t)
273:       )
274:      (t
275:       (setq headlinep nil))
276:      )
277:     (if headlinep
278:         (hfill)
279:       (cfill))
280:     (set-fill-column fc)
281:     )
282:   )
283: 
284: ;(message-box "2033")

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

16 chfill-line -- 行末までの一行を fill します

行末までの一行を fill します。

285: (defun chfill-line ()
286:   (interactive)
287:   (let (begp endp)
288:     (setq begp (point))
289:     (end-of-line)
290:     (forward-char 1)
291:     (setq endp (point))
292:     (chfill-region begp endp)
293:     ;(forward-char 1)
294:     )
295:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

17 chfill-region -- 指定した範囲を chfill する

chfill-region は、整形の範囲を指定して実行します。特に、普通に chfill を実行すると、詰め込み処理されてしまう行がある場合、整形の終端を指定するために使用します。

chfill-region を実行する前に、整形を開始する行と整形を終了する行のいずれかにマークを設定し、他方にカーソルを置いてから、chfill-region を呼び出してください。

296: (defun chfill-region (beg end)
297:   (interactive "*r")
298:   (let (begp endp endmarker (headlinep nil) extension fc)
299:     (setq begp (min beg end)) (setq endp (max beg end))
300:     ; @begin{Inserted on 2016-04-18} -----------------------
301:     (setq fc fill-column)
302:     (if (get-buffer-file-name)
303:         (progn
304:           (setq extension (pathname-type (get-buffer-file-name)))
305:           (if (or (string= extension "bat")
306:                   (string= extension "rb"))
307:               (set-fill-column (- *my-default-fill-column* 4)))
308:           )
309:       )
310:     ; @end{Inserted on 2016-04-18} -------------------------
311:     ; 整形の終端を確実にするために、終端に改行を入れて、終端
312:     ; の定義を変更します。
313:     (goto-char endp) (beginning-of-line)
314:     (insert "¥n")
315:     (setq endmarker (point-marker))
316:     (forward-line -1)
317:     (beginning-of-line)
318:     (setq endp (point))
319:     ; headline を検査して、hfill を使うか cfill を使うかを決
320:     ; めます。
321:     (goto-char begp)
322:     (beginning-of-line)
323:     (skip-chars-forward myskipchars)
324:     (setq headlinep nil)
325:     (cond 
326:      (;   1. ああああ
327:       (looking-at "¥¥([0-9][0-9]*¥¥|[a-zA-Z][a-zA-Z]*¥¥)[¥.)] ")
328:       (setq headlinep t)
329:       )
330:      (;  (1) ああああ
331:       (looking-at "¥¥(([0-9][0-9]*¥¥|[a-zA-Z][a-zA-Z]*¥¥)) ")
332:       (setq headlinep t)
333:       )
334:      (;   1.2 ああああ
335:       (and (looking-at "[0-9a-zA-Z][¥.0-9a-zA-Z]*[0-9a-zA-Z])? ")
336:          (not (looking-at "[0-9a-zA-Z][0-9a-zA-Z]* ")))
337:       (looking-at "[0-9a-zA-Z][¥.0-9a-zA-Z]*[0-9a-zA-Z])? ")
338:       (setq headlinep t)
339:       )
340:      (;   headline words : ああああ
341:       (looking-at "[^:¥n][^:¥n]* : ")
342:       (setq headlinep t)
343:       )
344:      (;   ● ああああ
345:       (looking-at "¥¥(●¥¥|■¥¥|○¥¥|□¥¥|・¥¥|[-*+][-*+]*¥¥) ")
346:       (setq headlinep t)
347:       )
348:      (t
349:       (setq headlinep nil))
350:      )
351:     (if headlinep
352:         (hfill)
353:       (cfill))
354:     (goto-char (marker-point endmarker))
355:     (delete-backward-char 1)
356:     (set-fill-column fc)
357:   ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

18 chindent-rigidly -- コメント文の中の段落を字下げ

コメント文の中の段落を字下げします。指定した範囲にわたって、行頭詰め込み文字列の後に、指定個数の空白を挿入します。

  ; a
  ; b
  ; c

上の3行を範囲指定して、C-u 2 M-x chindent-rigidly とすると、

  ;   a
  ;   b
  ;   c

のようになります。

myskipchars は、関数 cfill を定義するところの前で定義しています。

358: (defun chindent-rigidly (from to &optional (arg 1))
359:   (interactive "*r¥np")
360:   ; interactive の引数に * を指定しています。この * は、書き
361:   ; 込み禁止バッファでは使えないという指定です。p は数引数を
362:   ; 読み取るという指定です。
363:   (let (fprefix i)
364:     (or (< from to) (rotatef from to))
365:     (save-excursion
366:       (goto-char to)
367:       (setq to (point-marker))
368:       (goto-char from)
369:       (or (bolp) (forward-line 1))
370:       (while (< (point) (marker-point to))
371:         (skip-chars-forward myskipchars)
372:         (setq i arg)
373:         (while (> i 0)
374:           (insert " ")
375:           (setq i (- i 1)))
376:         (forward-line 1)))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

19 clear-kill-ring -- kill-ring を clear します

kill-ring を clear します。

cbar が書きました。region.l を参照してください。どこか変。最後のひとつが残っていることがあります。

377: (defun clear-kill-ring ()
378:   (interactive)
379:   (while ed::*kill-ring*
380:     (multiple-value-setq 
381:       (ed::*kill-ring* ed::*kill-ring-yank-pointer*)
382:       (ed::pop-kill-ring ed::*kill-ring* ed::*kill-ring-yank-pointer*))
383:     )
384:   ; (setq ed::*kill-ring* nil)
385:   ; (setq ed::*kill-ring-yank-pointer* nil)
386:   (setq ed::*last-yank-point* nil)
387:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

20 cline -- 行末まで , (カンマ)を埋めます。 

388: (defun cline ()
389:   (interactive)
390:   (char-line ","))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

21 clipboardtorun

xyzzy でリージョンを指定して、M-x clipboardtorun とすると、リージョンに指定された範囲の文字列を実行する窓をポップアップします。

391: (defun clipboardtorun ()
392:   (interactive)
393:   (copy-region-or-selection-to-clipboard)
394:   ; (copy-region-to-clipboard (region-beginning) (region-end))
395:   (call-process "clipboardtorun.exe")
396:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

22 close-window -- 窓の高さを半分にして窓を削除します

窓の高さを半分にしてから、窓を削除します。

397: (defun close-window ()
398:   (interactive)
399:   (let (h)
400:     (if (hsplitted-p)
401:         (progn
402:           (setq h (floor (/ (window-height) 2)))
403:           (enlarge-window (- h (window-height)))))
404:     (delete-window)
405:     )
406:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

23 command-substitution -- コマンドを実行結果の文字列を返す

command-substitution は
http://lisperblog.blogspot.com/2008/10/xyzzy.html
で紹介された関数です。

コマンドとして実行して得られた結果の文字列を返します。コマンドを呼び出して、その結果を利用するときに使用します。

(setq foo (command-substitution (format nil "ls -1 ~A" (merge-pathnames "*.txt" (user-homedir-pathname)))))
=>
c:/home/me/000readme.txt
c:/home/me/bookmarklist.txt
c:/home/me/keywords.txt
c:/home/me/scratch.txt
c:/home/me/signature.english.txt
c:/home/me/update.txt
c:/home/me/wd.lnk.txt"

解説 
(command-substitution (format nil "ls -1 ~A" (merge-pathnames 
"*.txt" (user-homedir-pathname))))

の (format nil "ls -1 ~A" (merge-pathnames "*.txt" (user-homedir-pathname))の部分は、"C:/home/me/*.txt" を返します。したがって、

  (user::command-substitution "ls -l C:/home/me/*.txt")

を実行しています。c:/home/me に、拡張子が .txt のファイルが複数あれば、

  "c:/home/me/000readme.txt
  c:/home/me/bookmarklist.txt
  c:/home/me/keywords.txt
  c:/home/me/scratch.txt
  c:/home/me/signature.english.txt
  c:/home/me/update.txt
  c:/home/me/wd.lnk.txt"

 のように返されます。

 exist-in-path-p の中で使用されています。

407: (defun command-substitution (command)
408:   (string-right-trim '(#¥SPC #¥TAB #¥LFD)
409:     (shell-command-to-string command)))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

24 concatlines -- 文字列のリストlinesを改行文字で連結して返す

文字列のリスト lines を改行文字で連結して、一つの文字列として返します。

410: (defun concatlines (lines)
411:   (let (alllines)
412:     (setq wlist lines)
413:     (while wlist
414:       (setq alllines (concat alllines (car wlist) "¥n"))
415:       (setq wlist (cdr wlist))
416:       )
417:     (if (not alllines)
418:         (setq alllines ""))
419:     alllines))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

25 connect-lines -- 行末に _ がある行をつぎの行に継続する

現在のカーソル位置からバッファの最後まで、行末に _ がある行をつぎの行に継続する処理をします。行頭から [ ] にマッチする文字は削除して継続します。

420: (defun connect-lines ()
421:   (interactive)
422:   (while (< (point) (point-max))
423:       (progn
424:         (goto-eol)
425:         (while (looking-at-backward "_$")
426:           (progn
427:             (backward-char)
428:             (delete-char 1)
429:             (delete-char 1)
430:             (while (looking-at "[ ;%#]")
431:               (delete-char 1))
432:             (goto-eol)
433:             ))
434:         (forward-line 1)
435:         )
436:     )
437:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

26 count-buffer-char -- バッファ内の文字数をカウント

http://hie.s64.xrea.com/xyzzy/note/misc.html#count-char-from-point

セレクションはリージョンとは違うので指定の仕方に注意してください。セレクションに指定したい文字列の先頭にカーソルを移動して、shift キーを押しながら、文字列の最後にカーソルを移動します。マウスでドラッグして指定することもできます。

セレクションがあればセレクション内の、なければバッファ全体の改行以外の文字数をカウントする。セレクションとリージョンは違います。

438: (defun count-buffer-char ()
439: (interactive)
440: (if (get-selection-type)
441:     ;selection があれば narrowing して実行
442:   (selection-start-end (start end)
443:     (narrow-to-region start end)
444:     (goto-char (point-min))
445:     (count-matches ".")
446:     (selection-end-of-buffer)
447:     (widen))
448:   ;selection がなければそのまま実行
449:   (save-excursion
450:          (goto-char (point-min))
451:          (count-matches "."))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

27 cram -- カーソルがある行以降を一行に詰め込み

[2016-08-06] 作成。

カーソルがある行以降を一行に詰め込みます。

 1. ここから
    後を
    詰め込みます。

このように書いてあって、最初の行にカーソルがあるときに、 M-x cram とすると、一連の行の行末の改行コードを取り除いて、つぎの行の行頭の空白文字列も削除して

 1. ここから後を詰め込みます。

のように一行に詰め込まれます。

cram 〔狭い所に〕〈ものを〉(無理に)詰め込む 〔in，into〕.

452: (defun cram ()
453:   (interactive "*")
454:   (let (begp endp num fprefix prefix numprefix 
455:              i loopflag lflag flen endmarker)
456:     (beginning-of-line)
457:     ;
458:     (skip-chars-forward myskipchars)
459:     ;
460:     ;
461:     (set-fill-prefix)
462:     (setq fprefix nil)
463:     (if fill-prefix
464:         (setq fprefix (regexp-quote fill-prefix)))
465:     (setq numprefix (current-column))
466:     ;
467:     ; ● このように見出し行があって、見出し行の字下げ量と同
468:     ; じだけ字下げされた行が続いている場合に、それらの行をす
469:     ; べて、前の行に詰め込みます。
470:     (end-of-line)
471:     (setq loopflag t)
472:     (while loopflag
473:       (forward-char 1)
474:       (if (hfill-continue-region-p fprefix)
475:           (progn
476:             (forward-char -1)
477:             (delete-char 1)
478:             (if (> numprefix 0)
479:                 (progn
480:                   (setq i numprefix)
481:                   (while (> i 0)
482:                     (delete-char 1)
483:                     (setq i (- i 1)))))
484:             (delete-horizontal-spaces)
485:             (end-of-line)
486:             )
487:         (progn (forward-char -1) (setq loopflag nil))
488:         )
489:       )
490:     (beginning-of-line)
491:     (skip-chars-forward myskipchars)
492:     (cond 
493:           ; 1. 1) a. a) のような見出し行
494:           ((looking-at "¥¥([0-9][0-9]*¥¥|[a-zA-Z][a-zA-Z]*¥¥)[¥.)] ")
495:            (goto-char (match-end 0))
496:            )
497:           ; (1) (a) のような見出し行
498:           ((looking-at "¥¥(([0-9][0-9]*¥¥|[a-zA-Z][a-zA-Z]*¥¥)) ")
499:            (goto-char (match-end 0))
500:            )
501:           ; 1.1 や ab.1 や a.1) のような見出し行
502:           ; foo.bat のように . の後が英字だけのものは見出し
503:           ; 行とはみなしません。
504:           ((and (looking-at "[0-9a-zA-Z][¥.0-9a-zA-Z]*[0-9a-zA-Z])? ")
505:                 (not (looking-at "[0-9a-zA-Z][0-9a-zA-Z]* "))
506:                 (not (looking-at
507:                       "[a-zA-Z][0-9a-zA-Z]*¥.[a-zA-Z][a-zA-Z]*"))
508:                 )
509:            (looking-at "[0-9a-zA-Z][¥.0-9a-zA-Z]*[0-9a-zA-Z])? ")
510:            (goto-char (match-end 0))
511:            )
512:           ;; つぎの２行は何のためにあるのか。
513:           ;; これは表の中の : に対応しています。
514:           ;; コロンの前後に一個以上の空白を置いていることに
515:           ;; 注意して下さい。
516:           ((looking-at "[^:¥n][^:¥n]* : ")
517:            (goto-char (match-end 0))
518:            )
519: ;
520:           ((looking-at "[^:¥n][^:¥n]* :: ")
521:            (goto-char (match-end 0))
522:            )
523: ;
524:           ((looking-at "¥¥(●¥¥|■¥¥|○¥¥|□¥¥|・¥¥|※¥¥|[-*+][-*+]*¥¥) ?")
525:            (goto-char (match-end 0))
526:            ))
527:     (setq num (current-column))
528:     ;
529:     ; flen (最初の行の長さ) を求めています。
530:     (end-of-line)
531:     (setq flen (current-column))
532:     ;
533:     (beginning-of-line)
534:     (setq begp (point))
535:     (next-line 1)
536:     ;
537:     ; fprefix を修正して、見出し部分を空白文字に置き換えて、
538:     ; 見出し行のつぎの行以降の行頭詰め込み文字列の正規表現に
539:     ; なるようにします。
540:     (setq i numprefix)
541:     (while (< i num)
542:       (setq fprefix (concat fprefix " "))
543:       (setq i (+ i 1)))
544:     ;
545:     ; 見出し行が fill-column より短くて、つぎの行が継続行な
546:     ; ら、つぎつぎと見出し行に詰め込み、見出し行が 
547:     ; fill-column より長くなるようにします。
548:     ; @begin{Cmnted out at 20160807 00:29}------------------
549:     ; (while (and (< flen (- fill-column 2))
550:     ;             (hfill-continue-region-p fprefix))
551:     ; @end{Cmnted out at 20160807 00:29}--------------------
552:     ; 
553:     ; @begin{Inserted at 20160807 00:29}--------------------
554:     (while (hfill-continue-region-p fprefix)
555:     ; @end{Inserted at 20160807 00:29}----------------------
556:         (progn
557:           (forward-char -1)
558:           (delete-char 1)
559:           (if (> numprefix 0)
560:               (progn
561:                 (setq i numprefix)
562:                 (while (> i 0)
563:                   (delete-char 1)
564:                   (setq i (- i 1)))))
565:           (delete-horizontal-spaces)
566:           (end-of-line)
567:           (setq flen (current-column))
568:           (beginning-of-line)
569:           (next-line 1)))
570:     ; 
571:     (setq endp (point))
572:     )
573:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

28 create-shortcut-to-filelink -- ファイルへのショートカット

を登録

現在編集中のファイルへのショートカットを環境変数 FILELINK で指定されているディレクトリに置きます。

現在編集中のファイルへのショートカットが既に環境変数 FILELINK で指定されているディレクトリに置かれていたら、その旨を表示する窓を表示します。

574: (defun create-shortcut-to-filelink ()
575:   (interactive)
576:   (let (filepath filename 
577:         filelinkdir lnkfilename lnkfilepath filelinkdir)
578:     (setq filepath (get-buffer-file-name))
579:     (if (not filepath)
580:         (progn
581:           (message-box 
582:            (concat "このバッファはファイルに対応していない¥n"
583:                  "ので何もしません。")
584:            "create-shortcut-to-filelink"
585:            '(:information))
586:           (call-process (concat (si:system-root) "xyzzycli.exe"))
587:           (return-from create-shortcut-to-filelink)))
588:     (setq filename (file-namestring filepath))
589:     ; (message-box filename)
590:     (if (not (si::getenv "FILELINK"))
591:         (progn
592:           (message-box 
593:            (concat "環境変数 FILELINK が定義されていません。")
594:            "create-shortcut-to-filelink"
595:            '(:information))
596:           (call-process (concat (si:system-root) "xyzzycli.exe"))
597:           (return-from create-shortcut-to-filelink)))
598:     (setq filelinkdir 
599:           (map-backslash-to-slash (si::getenv "FILELINK")))
600:     ; (message-box filelinkdir)
601:     (setq lnkfilepath
602:           (merge-pathnames
603:            (concat filename ".lnk")
604:            filelinkdir))
605:     (if (file-exist-p lnkfilepath)
606:         (progn
607:           (message-box 
608:            (concat "ショートカットファイル ¥n¥n"
609:                    lnkfilepath 
610:                    "¥n¥nが既に存在しています。")
611:            "create-shortcut-to-filelink"
612:            '(:information))
613:           (call-process (concat (si:system-root) "xyzzycli.exe"))
614:           (return-from create-shortcut-to-filelink)))
615:     (create-shortcut filepath filelinkdir)
616:     (my-message-box 
617:      (concat 
618:       (map-backslash-to-slash (si::getenv "FILELINK"))
619:       "¥n¥nに¥n¥n" filename ".lnk" " を作成しました。"))
620:     )
621:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

29 decrement-number -- カーソル位置の数字を1減らします

カーソル位置の数字を1減らします。カーソル位置に数字がなければ何もしません。

C-u M-x decrement-number とすると、最初数字が始まっていた位置に移動します。

 (fdefun "decrement-number" "sitelisp.lnk" "kh-base.l")

622: (defun decrement-number (&optional narg)
623:   (interactive "P")
624:   (let ((current (point))
625:         (start 0)
626:         (end 0)
627:         num)
628:     (skip-chars-backward "0-9") ;; 数字の先頭へ
629:     (setq start (point))
630:     (skip-chars-forward "0-9")  ;; 単語の最後尾へ
631:     (setq end (point))
632:     (if (= start end)
633:         nil
634:       (progn
635:         (setq num (parse-integer (buffer-substring start end)))
636:         (delete-region start end)
637:         (setq num (- num 1))
638:         (insert (format nil "~D" num))
639:         (if narg
640:             (goto-char start))
641:         )
642:       )
643:     )
644:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

30 define-barfunc -- lisp 式を呼び出す関数 barfunc を定義する

lisp 式の最後の括弧の後ろ(※)か、最初の式の上にカーソルを置いて、この関数を実行するものとします。

※ [2017-08-06] 必ずしも、lisp 式の最後の括弧の直後にカーソルを置かなくても動作するように改良しました。

例。つぎの行の行末にカーソルがあっても、つまり右括弧の直後にカーソルが置かれていなくても、eval-in-other-window や my-eval-last-sexp が動作します (eval-in-other-window や my-eval-last-sexp で、defin-barfunc が呼ばれています)。

  (File "dropbox.lnk" "mysymlink.bat") に書いてあります。

その場合、その lisp 式を呼び出す関数 barfunc を定義します。

関数定義の中で、継続行を置くことができます。特に、

  (Foo "aaaaaaaaaaaaaaa_ 
       bbb")

のように書かれていたときは、

  (Foo "aaaaaaaaaaaaaaabbb")

のように書かれていたかのように動作するようにしています。 connect-lines 関数を定義して、

  (switch-to-buffer *barfunc-buffer*)

した後に、connect-lines 関数を呼んでいます。

645: (defun define-barfunc ()
646:   (interactive)
647:   (let (begp endp string curbuf (onlp nil))
648:     ; カーソルが、評価したい lisp 式 (...) の最初の左括弧の
649:     ; 上にあるか、あるいは、右括弧の直後にあれば、onlp を t 
650:     ; に設定し、ます。begp は、左括弧の上、endp は、右括弧の
651:     ; 直後に設定します。
652:     ; 最初は、onlp は nil に設定されています。
653:     (save-excursion
654:       (setq curbuf (selected-buffer))
655:       ;
656:       ;@begin{Cmnted out at 20170806 09:11}-----------------
657:       ;(if (not (looking-at "¥("))
658:       ;    (while (looking-at-backward "[ ]$")
659:       ;      (forward-char -1)))
660:       ;@end{Cmnted out at 20170806 09:11}-------------------
661:       ;
662:       ;@begin{Inserted at 20170806 09:11}-------------------
663:       (if (not (looking-at "¥("))
664:           (while (not (looking-at-backward "¥)$"))
665:             (forward-char -1)))
666:       ;@end{Inserted at 20170806 09:11}---------------------
667:       ;
668:       (if (looking-at-backward "¥)$")
669:         (progn
670:           (setq onlp t)
671:           (setq endp (point))
672:           (backward-char)
673:           ; lisp-mode でなくても動作するようにした 
674:           ; match-paren の改良版
675:           ; (sfind "my-patch-paren" "sitelisp.lnk" "kh-base.l")
676:           (my-match-paren)
677:           (setq begp (point)))
678:         (if (looking-at "¥(")
679:             (progn
680:               (setq onlp t)
681:               (setq begp (point))
682:               (my-match-paren)
683:               (forward-char 1)
684:               (setq endp (point))))
685:         )
686:       ; onlp が t なら
687:       ; lisp 式を kill-ring に記憶します。
688:       (if onlp 
689:           (copy-region-as-kill begp endp)
690:         (progn
691:           (my-message-box 
692:            (concat "the cursor should be on the left paren "
693:                    "or just after the right paren."))
694:           (return-from define-barfunc nil)
695:         )
696:         )
697:       )
698:     (setq *barfunc-buffer* (get-buffer-create "*barfunc*"))
699:     (switch-to-buffer *barfunc-buffer*)
700:     ;
701:     ; [2014-03-21] 継続処理をするために変更しました。
702:     (delete-region (point-min) (point-max))
703:     (yank)
704:     (goto-char (point-min))
705:     (connect-lines)
706:     (copy-region-as-kill (point-min) (point-max))
707:     ;
708:     (delete-region (point-min) (point-max))
709:     (goto-char (point-min))
710:     (insert "(defun barfunc () (interactive) ")
711:     (insert "(setq *sameside* t) ")
712:     (yank)
713:     (insert ")")
714:     (eval-region (point-min) (point-max))
715:     (delete-buffer *barfunc-buffer*)
716:     (switch-to-buffer curbuf)
717:     t)
718:     )
719: 
720: ;(message-box "2300")

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

31 define-barfunc-from-clipboardstring -- クリップボードのlispコードを実行する関数を作る

クリップボードに格納されている lisp コードを実行する関数を barfunc という名前で作ります。

721: (defun define-barfunc-from-clipboardstring ()
722:   (interactive)
723:   (let (begp endp string curbuf (onlp nil))
724:     ; カーソルが、評価したい lisp 式 (...) の最初の左括弧の
725:     ; 上にあるか、あるいは、右括弧の直後にあれば、onlp を t 
726:     ; に設定し、ます。begp は、左括弧の上、endp は、右括弧の
727:     ; 直後に設定します。最初は、onlp は nil に設定されていま
728:     ; す。
729:     (setq *barfunc-buffer* (get-buffer-create "*barfunc*"))
730:     (switch-to-buffer *barfunc-buffer*)
731:     (insert (get-clipboard-data))
732:     ;
733:     ; [2014-03-21] 継続処理をするために変更しました。
734:     (delete-region (point-min) (point-max))
735:     (yank)
736:     (goto-char (point-min))
737:     (connect-lines)
738:     (copy-region-as-kill (point-min) (point-max))
739:     ;
740:     (delete-region (point-min) (point-max))
741:     (goto-char (point-min))
742:     (insert "(defun barfunc () (interactive) ")
743:     (insert "(setq *sameside* t) ")
744:     (yank)
745:     (insert ")")
746:     (eval-region (point-min) (point-max))
747:     (delete-buffer *barfunc-buffer*)
748:     t)
749:     )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

32 defun-in-editor-package -- editor パッケージの関数として定義

(defun ...) の最後の右括弧の後ろにカーソルを置いて、この関数を実行すると、確実に editor パッケージの関数として定義されます。

バッファに書いてあるコードを変更するのではなく、別のバッファに複写して、editor パッケージ内での評価を確実にして、インタラクティブに評価するだけです。

この関数の中で作成するバッファの中で、in-package 関数を呼んでいますが、元に戻してはいません。副作用があるかも知れません。

750: (defun defun-in-editor-package ()
751:   (interactive)
752:   (let (curbuf buf bpos epos)
753:     (setq epos (point))
754:     (re-search-backward "^[ ]*(defun ..* ()")
755:     (setq bpos (point))
756:     (copy-region-as-kill bpos epos)
757:     (setq curbuf (selected-buffer))
758:     (setq buf (get-buffer-create "*temp*"))
759:     (switch-to-buffer buf)
760:     (insert "(in-package ¥"editor¥")¥n¥n")
761:     (yank)
762:     (eval-region (point-min) (point-max))
763:     (delete-buffer buf)
764:     (switch-to-buffer curbuf)
765:     (goto-char epos)
766:     )
767:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

33 defun-in-user-package -- user パッケージの関数として定義

(defun ...) の最後の右括弧の後ろにカーソルを置いて、この関数を実行すると、確実に user パッケージの関数として定義(評価)されます。

バッファに書いてあるコードを変更するのではなく、別のバッファに複写して、user パッケージ内での評価を確実にして、インタラクティブに評価するだけです。

この関数の中で作成するバッファの中で、in-package 関数を呼んでいますが、元に戻してはいません。副作用があるかも知れません。

  (use-package "user")
  (use-package "editor")

も入れたらいいのかも知れません。

768: (defun defun-in-user-package ()
769:   (interactive)
770:   (let (curbuf buf bpos epos)
771:     (setq epos (point))
772:     (re-search-backward "^[ ]*(defun ..* ()")
773:     (setq bpos (point))
774:     (copy-region-as-kill bpos epos)
775:     (setq curbuf (selected-buffer))
776:     (setq buf (get-buffer-create "*temp*"))
777:     (switch-to-buffer buf)
778:     (insert "(in-package ¥"user¥")¥n¥n")
779:     (yank)
780:     (eval-region (point-min) (point-max))
781:     (delete-buffer buf)
782:     (switch-to-buffer curbuf)
783:     (goto-char epos)
784:     )
785:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

34 delete-line -- カーソル位置の一行を削除

cbar が書きました。カーソル位置の一行を削除します。 delete-line で消した行は戻って来ないので慎重さが必要です。

786: (defun delete-line ()
787:   (interactive)
788:   (let (start end)
789:     (beginning-of-line)
790:     (setq start (point))
791:     (end-of-line)
792:     (forward-char 1)
793:     (setq end (point))
794:     (delete-region start end)
795:     )
796:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

35 delete-newline -- 行末の newline 文字を削除

行末の newline 文字を削除して、現在の行の後につぎの行を続けます。つぎの行の行頭にある空白はそのままです。 ;
 あああああああああああああああああ
     いいいいいい

のようになっているとき、ああああ... の行で delete-newline を実行すると

 あああああああああああああああああ   いいいいいい

のようになります。

797: (defun delete-newline ()
798:   (interactive)
799:   (end-of-line)
800:   (delete-char 1)
801:   (end-of-line))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

36 delete-newline-and-trailing-spaces -- 改行と次行の行頭空白を削除

行末の newline 文字を削除して、現在の行の後につぎの行を続けます。つぎの行の行頭にある空白も削除します。

 あああああああああああああああああ
     いいいいいい

のようになっているとき、ああああ... の行で delete-newline-and-trailing-spaces を実行すると

 あああああああああああああああああいいいいいい

のようになります。

802: (defun delete-newline-and-trailing-spaces ()
803:   (interactive)
804:   (end-of-line)
805:   (delete-char 1)
806:   (delete-trailing-spaces)
807:   (end-of-line))
808: 
809: (defalias 'connect-nexline 'delete-newline-and-trailing-spaces)

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

37 delete-prefix, remove-prefix -- 指定した範囲の前置文字列を削除

一連のコードの先頭の文字列を削除します。

   @beign{foo} -------------------------------------------
   | aaaa
   | bb
   | cc
   @end{foo} ---------------------------------------------

のコードの "| " を削除して、

   @beign{foo} -------------------------------------------
   aaaa
   bb
   cc
   @end{foo} ---------------------------------------------

のようにしたい。

範囲指定して、M-x delete-prefix します。この例では、 The column postion of the beginning of line: に対して、5 と応えて、prefix-string には、"| " (引用符号は入力しません。) と応えます。

このコードはちょっと手抜き。prefix-string の中味は見ず、その文字数だけを見て、その文字数だけ削除しています。

810: (defun delete-prefix (column)
811:   (interactive
812:       "n削除したい prefix の先頭位置(行頭は1、0なら前置文字列末尾) : ")
813:   (let (prefix startposition endposition startline 
814:                lastline cline num)
815:     (setq prefix (read-string "prefix-string: "))
816:     (setq num (length prefix))
817:     (setq startposition (region-beginning))
818:     (setq endposition (region-end))
819:     (setq startline (count-lines 1 startposition))
820:     (setq lastline (count-lines 1 endposition))
821:     (goto-char startposition)
822:     (if (= column 0)
823:         (progn
824:           ; 文頭の桁位置に移動
825:           (back-to-indentation)
826:           ; current-column は桁位置を返します。行頭では0 を返し
827:           ; ます。
828:           (setq column (+ (current-column) 1)
829:                 )))
830:     (beginning-of-line)
831:     (setq cline startline)
832:     (while (< cline lastline)
833:       (beginning-of-line)
834:       (if (> column 0)
835:            (forward-char (- column 1)))
836:       
837:       (delete-char (min (remaining-charlength-to-line-end) num))
838:       ; prefix として、"; " を指定したときに、";" だけ書いてすぐ
839:       ; 改行されているときには、その ";" を削除します。
840:       
841:       (beginning-of-line)
842:       (setq cline (+ cline 1))
843:       (forward-line 1))
844:     )
845:   )
846: 
847: ; remove-prefix だったかなと思うこともあるので、alias を定義
848: ; しました。
849: ; 
850: (defalias 'remove-prefix 'delete-prefix)

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

38 delete-preseding-spaces -- カーソル位置の前の空白文字列を削除

カーソル位置から行頭までの空白文字を削除します。 C-c p に割り当てるには、

  (global-set-key '(#¥C-c #¥p) 'delete-preceding-spaces)

851: (defun delete-preceding-spaces ()
852:   (interactive)
853:   (while (looking-back " ")
854:    (delete-backward-char 1)))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

39 delete-trailing-spaces -- カーソル位置から後の空白文字を削除

カーソル位置から後の空白文字を削除します。 C-c d に割り当てるには、

 (global-set-key '(#¥C-c #¥d) 'delete-trailing-spaces)

を .xyzzy に入れます。

855: (defun delete-trailing-spaces ()
856:   (interactive)
857:   (if (looking-at "[ ¥t　]*")
858:       (delete-region (match-beginning 0) (match-end 0))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

40 display-after 

次の行の同じカーソル位置に ",,,." を挿入します。

  fooo
  bar

の bar の b の位置にカーソルを置いて、M-x display-after とすると、

  fooo
  bar
  ,,,.

になります。


859: (defun display-after ()
860:   (interactive)
861:   (let (ncol)
862:     (setq ncol (current-column))
863:     (end-of-line)
864:     (insert "¥n")
865:     (insert 
866:      (make-sequence 'string ncol :initial-element 
867:                     (code-char 32)))
868:     (insert ",,,.")
869:     (beginning-of-line)
870:     (forward-line 2)
871:     )
872:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

41 display-before 

カーソル位置に ",,,~" を挿入して改行します。

  fooo
  bar

の fooo の f の位置にカーソルを置いて、M-x display-before 
とすると、

  ,,,~
  fooo
  bar

になります。


873: (defun display-before ()
874:   (interactive)
875:   (let (ncol)
876:     (setq ncol (current-column))
877:     (insert ",,,~¥n")
878:     (insert 
879:      (make-sequence 'string ncol :initial-element 
880:                     (code-char 32)))
881:     (re-search-forward "^[ ]*$")
882:     (forward-line -1)
883:     (beginning-of-line)
884:     (while (< (current-column) ncol)
885:       (forward-char 1))
886:     )
887:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

42 display-oneline -- 行頭空白文字列を削除し行頭に ",,, " を挿入

行頭の空白文字列を一旦削除して、行頭に ",,, " (カンマを3回繰り返し、その後に、半角空白を3回繰り返し) を挿入します。

888: (defun display-oneline ()
889:   (interactive)
890:   (beginning-of-line)
891:   (delete-trailing-spaces)
892:   (insert ",,,   ")
893:   (beginning-of-line)
894:   (forward-line 2)
895:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

43 dline -- 行末まで = を埋めます。 

896: (defun dline ()
897:   (interactive)
898:   (char-line "="))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

44 edit-in-other-window -- eo.bat と連携する関数 

(File "bat.lnk" "eo.bat")

と連携します。

eo.bat
@echo off
setclipboard.exe "%~f1"
sleep 1
c:¥tools¥xyzzy¥xyzzycli.exe -f edit-in-other-window

現在アクティブな窓のつぎの窓に移動してから、クリップボードで指定されたファイルを開きます。

899: (defun edit-in-other-window ()
900:   (interactive)
901:   (other-window)
902:   ; (File (get-clipboard-data))
903:   (call-process
904:    (concat (si:system-root) "xyzzycli.exe " 
905:            (get-clipboard-data)))
906:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

45 eval-in-other-window -- 反対側の窓で関数を呼び出す

lisp コードの先頭の ( か、最後の ) の直後にカーソルを置いて、この関数を呼び出します。

窓が左右に分かれていれば、まず、反対側の窓に移動します。

その後、窓が上下方向に分かれていれば、最初に窓を一つにします。その後、窓を上下二つに分けて、下側の窓に *evalwork* バッファを開いて、バッファの内容をすべて削除して、範囲指定した文字列を実行する関数を作成するコードを *evalwork* バッファに挿入して評価します。

.xyzzy につぎのように書いているので、C-c C-s で eval-in-other-window を実行できます。

(global-set-key '(#¥C-c #¥C-s) 'eval-in-other-window)
(global-set-key '(#¥C-c #¥C-e) 'my-eval-last-sexp)
(global-set-key '(#¥C-c #¥C-u) 
   'my-eval-last-sexp-in-other-horizontal-window)

コメントの中でも、つぎのように、評価する範囲を知らせてくれる/* ... */ を置いておいて、カーソルを /* の / の上か、*/ の /の後において、eval-in-other-window を実行すると、コメント文字を削除して評価するように機能を追加しました。

/* ... */ で囲むのが都合が悪い場合は、/# ... #/ で囲みます。

/*
(File "sitelisp.lnk" "kh-xyzzyfunc.l")
 */

/*
(File "sitelisp.lnk" "kh-xyzzyfunc.l")
 */

(fdefun "kh-excr-in-other-window")
(fdefun "kh-excr-in-other-window" "sitelisp.lnk" "kh-base.l")

kh-excr-in-other-window を使うことによって、

(goto-char (point-min))
(perform-replace "^[ ]*[/:;%'#]+[ ]+" "" nil t t t)
(goto-char (point-min))
(perform-replace "^[ ]*[/:;%'#]+$" "" nil t t t)

で行頭のコメント文字列を削除します。

*sameside* を定義することにしました。

eval-in-other-window では、(setq *sameside* nil) としています。

my-eval-last-sexp では、(setq *samesid* t) です。実際には、define-barfunc の中で、(setq *sameside* t) としています。

(fdefun "define-barfunc")
(fdefun "my-eval-last-sexp")

my-eval-last-sexp もこのファイルで定義されています。

(fdefun "my-eval-last-sexp")
(fdefun "my-eval-last-sexp" "sitelisp.lnk" "kh-base.l")

[2017-08-06] 右括弧 ) の直後にカーソルを置かなくてもいいようにしました。

907: (defun eval-in-other-window ()
908:   (interactive)
909:   ;
910:   (if (not (looking-at "[(/]"))
911:     (while (looking-at-backward "[ ]$")
912:       (forward-char -1)))
913:   ;
914:   (if (looking-at-backward "¥¥*/$")
915:       (progn
916:         (let (begp endp)
917:           (goto-bol) (setq endp (point))
918:           ; (message-box "here3")
919:           (search-backward "/*")
920:           (forward-line 1)
921:           (goto-bol) (setq begp (point))
922:           (goto-char endp)
923:           (kh-excr-in-other-window begp endp))
924:         (return-from eval-in-other-window)))
925:   ;
926:   (if (looking-at-backward "#/$")
927:       (progn
928:         (let (begp endp)
929:           (goto-bol) (setq endp (point))
930:           ; (message-box "here3")
931:           (search-backward "/#")
932:           (forward-line 1)
933:           (goto-bol) (setq begp (point))
934:           (goto-char endp)
935:           (kh-excr-in-other-window begp endp))
936:         (return-from eval-in-other-window)))
937:   ;
938:   (if (looking-at "/¥¥*")
939:       (progn
940:         (let (begp endp)
941:           (search-forward "¥*/") (goto-bol) (setq endp (point))
942:           (search-backward "/*")
943:           (forward-line 1)
944:           (goto-bol) (setq begp (point))
945:           (goto-char endp)
946:           (kh-excr-in-other-window begp endp))
947:         (return-from eval-in-other-window)))
948:   ;
949:   (if (looking-at "/#")
950:       (progn
951:         (let (begp endp)
952:           (search-forward "#/") (goto-bol) (setq endp (point))
953:           (search-backward "/#")
954:           (forward-line 1)
955:           (goto-bol) (setq begp (point))
956:           (goto-char endp)
957:           (kh-excr-in-other-window begp endp))
958:         (return-from eval-in-other-window)))
959:   ;
960:   (let (begp endp onpur upw (wh 10) buffer)
961:     ; buffer は現在のバッファ
962:     (setq buffer (selected-buffer))
963:     ; onpr は左括弧の上か、右括弧の後ろなら t。それ以外は nil
964:     (setq onpr nil)
965:     ; @begin{Cmnted out at 20170806 08:58}------------------
966:     ; (save-excursion
967:     ;   (if (looking-at-backward "¥)$")
968:     ;       (progn
969:     ;         (setq onpr t)
970:     ;         (setq endp (point))
971:     ;         (backward-char)
972:     ;         ; lisp-mode でなくても動作するようにした 
973:     ;         ; match-paren の改良版
974:     ;         ; (sfind "my-patch-paren" "sitelisp.lnk" "kh-base.l")
975:     ;         (my-match-paren)
976:     ;         (setq begp (point)))
977:     ;     (if (looking-at "¥(")
978:     ;         (progn
979:     ;           (setq onpr t)
980:     ;           (setq begp (point))
981:     ;           (my-match-paren)
982:     ;           (forward-char 1)
983:     ;           (setq endp (point)))))
984:     ;   ; lisp 式を kill-ring に記憶します。
985:     ;   (if onpr 
986:     ;       (copy-region-as-kill begp endp)))
987:     ; @end{Cmnted out at 20170806 08:58}--------------------
988:     ; 
989:     ; @begin{Inserted at 20170806 08:58}--------------------
990:     (save-excursion
991:       (if (looking-at "¥(")
992:             (progn
993:               (setq onpr t)
994:               (setq begp (point))
995:               (my-match-paren)
996:               (forward-char 1)
997:               (setq endp (point)))
998:         (if (myre-search-backward-in-line "¥)")
999:             (progn
1000:               (forward-char 1)
1001:               (setq onpr t)
1002:               (setq endp (point))
1003:               (backward-char)
1004:               ; lisp-mode でなくても動作するようにした 
1005:               ; match-paren の改良版
1006:               ; (sfind "my-patch-paren" "sitelisp.lnk" "kh-base.l")
1007:               (my-match-paren)
1008:               (setq begp (point)))))
1009:       (if onpr 
1010:           (copy-region-as-kill begp endp)))
1011:     ; @end{Inserted at 20170806 08:58}----------------------
1012:     
1013:     (if (not onpr)
1014:         (progn
1015:           (my-message-box 
1016:            (concat "The cursor should be on the left paren "
1017:                    "or just after the right paren."))
1018:           (return-from eval-in-other-window)))
1019:     ; lisp 式がちゃんとあったときの処理
1020:     ;
1021:     ; lisp 式がちゃんとあったときは、数行前に実行された
1022:     ; (copy-region-as-kill begp endp)
1023:     ; によって、lisp 式は、kill-ring に記憶されています。
1024:     ;
1025:     ; 窓が一つなら水平方向に分割して、窓を上下二つにする
1026:     ; 窓を一つにします。
1027:     ; (refresh-screen)
1028:     ; (my-delete-other-window)
1029:     ; (refresh-screen)
1030:     ; 窓を分割して、下の窓にカーソルを移動します。
1031:     ; (my-split-window -5)
1032:     ; (refresh-screen)
1033:     ;
1034:     ; 窓が左右に分割されていれば、反対側の窓に表示したい
1035:     (refresh-screen)
1036:     (if (vsplitted-p)
1037:         (progn
1038:           (if (= (nth 0 (window-coordinate)) 0)
1039:             ; 左側の窓に居たので、右の窓に移動したい
1040:             (while (= (nth 0 (window-coordinate)) 0)
1041:               (other-window))
1042:           ; 右側の窓にいたので左の窓に移動したい
1043:             (while (> (nth 0 (window-coordinate)) 0)
1044:               (move-previous-window))
1045:             )
1046:           (switch-to-buffer buffer)
1047:           )
1048:       (progn
1049:         (my-delete-other-window)
1050:         (refresh-screen)
1051:         (my-split-window -5)
1052:         (refresh-screen)))
1053:     ;
1054:     ; 下の窓で、*evalwork* バッファを作成し、そこに記憶して
1055:     ; いたlisp 式を挿入して評価します。その後、*evalwork* バ
1056:     ; ッファを削除します。
1057:     (switch-to-buffer (get-buffer-create "*evalwork*"))
1058:     (delete-region (point-min) (point-max))
1059:     (goto-char (point-min))
1060:     (yank)
1061:     (insert "¥n")
1062:     ;
1063:     (goto-char (point-min))
1064:     ; (fdefun "connect-lines" "sitelisp.lnk" "kh-base.l")
1065:     (connect-lines)
1066:     ;
1067:     (copy-region-as-kill (point-min) (point-max))
1068:     (delete-region (point-min) (point-max))
1069:     (goto-char (point-min))
1070:     (insert "(defun barfunc () (interactive) ")
1071:     (insert "(setq *sameside* nil) ")
1072:     (yank)
1073:     (insert ")")
1074:     (eval-region (point-min) (point-max))
1075:     (delete-buffer "*evalwork*")
1076:     (switch-to-buffer buffer)
1077:     (call-process "xyzzycli.exe -f barfunc")
1078:     (refresh-screen)
1079:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

46 exec-open-filer -- xyzzyの外部からファイラーを開く

[2015-03-24]
外部から、xyzzy のファイラーをアクティブにするために定義しました。

コンソールなどで、

  > c:¥tools¥xyzzy¥xyzzycli.exe -f exec-open-filer

とすると、xyzzy のファイラーがアクティブになります。

open-filer は xyzzy で元々定義されています。

コンソールで、

  > c:¥tools¥xyzzy¥xyzzycli.exe -f open-filer

とした場合は、xyzzy のファイラーは開きますが、ファイラーがアクティブになりません。

1080: (defun exec-open-filer ()
1081:   (interactive)
1082:   (call-process 
1083:    (concat (si:system-root) "xyzzycli.exe -f open-filer"))
1084:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

47 exist-in-path-p -- path 環境変数に登録されているか検査

引数で指定されたコマンドが path 環境変数に登録されたディレクトリの中にあるかどうかを調べます。あれば t をなければ nil を返します。

使用例

  (if (exist-in-path-p "touch.exe")
      (message-box "touch.exe はバス内にありました。")
    (message-box "touch.exe はバス内にありません。"))

1085: (defun exist-in-path-p (arg)
1086:   "check whether arg cab be found in %path%"
1087:   (interactive)
1088:   (let (result)
1089:     (setq result 
1090:           (command-substitution
1091:            (concat "where.exe " 
1092:                    arg)))
1093:     (not (string-match "見つかりませんでした" result))
1094:     )
1095:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

48 explorer -- 編集中のファイルがあるディレクトリをexplorerで開く

現在、編集中のファイルがあるディレクトリを explorer で開きます。

(Start ".")

の方が便利かも。

1096: (defun explorer ()
1097:   (interactive)
1098:   (let (wdir)
1099:     (setq wdir (map-slash-to-backslash
1100:                 (default-directory (selected-buffer))))
1101:     (call-process
1102:      (concat "c:¥¥windows¥¥explorer.exe " wdir))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

49 exec-clpstring -- クリップボードのリスプコードを実行する

クリップボードに格納されているリスプコードを実行する関数 barfunc を定義し、実行します。

外部で、クリップボードにリスプコードを格納して、 define-barfunc-from-clipboardstringを実行することによって、関数 barfunc が定義されます。

クリップボードにリスプコードを格納して、外部から

 C:¥¥tools¥¥xyzzy¥¥xyzzycli.exe -f exec-clpstring

のようなコマンドを実行すると、起動されている xyzzy.exe でこの関数 exec-clpstring を実行します。

  (File "C:/Program Files (x86)/AutoHotkey/AutoHotkey.ini")

の中の run07BLButtonMenu 関数の中で使用されています。

1103: (defun exec-clpstring()
1104:   (interactive)
1105:   ;; クリップボードに格納されているリスプコードを実行する関
1106:   ;; 数barfunc を定義します。
1107:   (define-barfunc-from-clipboardstring)
1108:   ;; barfunc を実行します。
1109:   (barfunc)
1110:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

50 enlarge-half-width -- 窓の幅を 82 桁に拡張します。

窓の幅を 82 桁に拡張します。元に戻すには、reset-hafl-width とします。

1111: (defun enlarge-half-width ()
1112:   (interactive)
1113:   (enlarge-window (- 82 (/ (- (screen-width) 10) 2)) t))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

51 eval-to-clipboard -- コードを実行した結果をクリップボードに格納

  (File (lf "dropboxdata.lnk" "images/nengaSample.png"))

のようなコードがバッファに書いてあったときに、コード

  (lf "dropboxdata.lnk" "images/nengaSample.png")

を評価した結果をクリップボードに格納して、別の箇所に書き込みたいときに利用するために定義しました。

コードの右括弧のつぎのカラムにカーソルを置いて、この関数を実行します。

1114: (defun eval-to-clipboard ()
1115:   (interactive)
1116:   (let (begp endp)
1117:     (setq endp (point))
1118:     (backward-char 1)
1119:     (kh-quiet-match-paren)
1120:     (setq begp (point))
1121:     (copy-region-as-kill begp endp)
1122:     (switch-to-buffer (get-buffer-create "*ecrfunc*"))
1123:     ; 念のためバッファ *ecrfunc* の内容を削除します。
1124:     (delete-region (point-min) (point-max))
1125:     ; kill バッファの内容を *ecrfunc* に書き出します。
1126:     (yank)
1127:     (goto-char (point-min))
1128:     (insert "(copy-to-clipboard ")
1129:     ; copy-to-clipboard は xyzzy の組み込みの関数です。
1130:     (goto-char (point-max))
1131:     (insert ")")
1132:     (goto-char (point-max))
1133:     (call-interactively 'eval-last-sexp)
1134:     ; バッファ *ecrfunc* を削除します。
1135:     (delete-buffer "*ecrfunc*")
1136:     (goto-char endp)
1137:     (message "クリップボードに評価結果を記憶しました。")
1138:     )
1139:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

52 folder -- カーソル位置に書いてあるフォルダーをファイラーで開く

これから移動しようとするフォルダーへのパスがバッファに書いてあるとして、そのパスの先頭にカーソルを置いて、この関数 folder を呼ぶと、そのフォルダをファイラーで開きます。パスに空白が含まれている場合は、"c:/Proram Files/" のようにダブルクォートで囲み、カーソルを初めのダブルクォートの上に置いて、この関数 folder を呼ぶようにします。

folder というのもあっていいような気がします。

  "c:/home/me"
  "C:/Program Files/"

  "C:/Program Files/"

start の方が便利かも知れません。start の方だと、explorer で開くかxyzzy のファイラーで開くか選択できます。

  (sfind "folder" "sitelisp.lnk" "kh-base.l")


1140: (defun folder ()
1141:   (interactive)
1142:   (let (beg end dirname)
1143:     (save-excursion
1144:       (if (looking-at "¥"")
1145:           (setq dirname (get-quoted-string))
1146:         (progn
1147:           (setq beg (point))
1148:           (re-search-forward "[ ¥t¥n¥"]" nil)
1149:           (setq end (point))
1150:           (setq dirname (buffer-substring beg end))))
1151:       )
1152:     (open-filer)
1153:     (filer-activate-toplevel)
1154:     (filer-chdir dirname)
1155:     (open-filer)
1156:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

53 fdefun -- 指定した名前の関数の定義場所を探す

指定した名前の関数の定義場所を探す

  (fdefun "fdefun")
  (fdefun "fdefun" "sitelisp.lnk" "kh-base.l")

  1. 窓を２分割します。
  2. 下の窓に、指定されたファイルを開いて、指定された語を含む行にカーソルを移動します。
  3. defun があり、その後に任意の文字列があって、半角空白が1個あって、指定された語がある行を探します。

[2014-07-23]
第2引数を省略したら現在のファイルから探すように拡張しました。
ただし、第2引数を省略した lisp 式を評価するときは、 M-x eval-in-other-window (C-c C-s) は使用できません。 M-x my-eval-lase-sexp (C-c C-e) を使用してください。

1157: (defun fdefun (word &rest arg)
1158:   "第一引数で指定する語句を第二引き数以下で指定するファイルから探す"
1159:   (interactive)
1160:   ;
1161:   (let (fname buffer win)
1162:     (if arg
1163:         (progn
1164:           (setq fname (car arg))
1165:           (setq arg (cdr arg))
1166:           (if (not
1167:                (string= 
1168:                 (concat (directory-namestring fname)
1169:                         (file-namestring fname))
1170:                 fname))
1171:               (setq fname 
1172:                     (concat "C:/dirlink/" fname))
1173:             )
1174:           (if (string= (pathname-type fname) "lnk")
1175:               (setq fname (resolve-shortcut fname))
1176:             )
1177:           
1178:           (if arg
1179:               (setq fname
1180:                     (merge-pathnames 
1181:                      (apply #'concat arg) fname)))
1182:                                      
1183:           ; (message-box fname)
1184:           )
1185:       (setq fname (get-buffer-file-name (selected-buffer)))
1186:       )
1187:     ;
1188:     ; 窓が上下に分かれているときに他方の窓を削除します。
1189:     ; 窓が左右に分かれていて、その片方が上下に分かれている場
1190:     ; 合にも対応しています。
1191:     ; (my-delete-other-window)
1192:     ; (refresh-screen)
1193:     ; my-split-windowは現在の窓を上下二つに分割します。
1194:     ; 引数に -4 を指定しているので、下の窓の高さを元の高さの 
1195:     ; 4/10 にし、カーソルを下の窓に置きます。
1196:     ; (my-split-window -4)
1197:     ; (refresh-screen)
1198:     ;
1199:     ; [2014-07-21]
1200:     ; 窓が左右に分かれているときにはなにもしないことにしまし
1201:     ; た。
1202:     (refresh-screen)
1203:     (if *sameside*
1204:         (progn
1205:           (my-delete-other-window)
1206:           (refresh-screen)
1207:           (my-split-window -5)
1208:           (refresh-screen))
1209:       )
1210:     ; @begin{Cmnted out at 20160820 09:55}------------------
1211:     ; (find-file fname)
1212:     ; @end{Cmnted out at 20160820 09:55}--------------------
1213:     ; 
1214:     ; @begin{Inserted at 20160820 09:55}--------------------
1215:     (setq buffer (my-get-file-buffer fname))
1216:     (if buffer
1217:         (progn
1218:           (my-message-box 
1219:            (concat fname " has benn already opened."))
1220:           (set-buffer buffer)
1221:           (refresh-screen)
1222:           )
1223:      (find-file fname))
1224:     ; @end{Inserted at 20160820 09:55}----------------------
1225:     ;
1226:     (goto-char (point-min))
1227:     (re-search-forward 
1228:      (concat "(defun " (regexp-quote word) "[ ]"))
1229:     (setf *kill-ring* (cons (list (concat word)) *kill-ring*))
1230:     (setf ed::*kill-ring-yank-pointer* *kill-ring*)
1231:     (message "type ctrl + s and ctrl + y, if you want to search the word.")
1232:     )
1233:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

54 file-in-other-window 

1234: (defun file-in-other-window (fname &rest z)
1235:   (interactive "ffile: ")
1236:   (if z
1237:         (setq fname (concat fname (apply #'concat z))))
1238:   ;
1239:   ; 窓が上下に分かれているときに他方の窓を削除します。
1240:   ; 窓が左右に分かれていて、その片方が上下に分かれている場合
1241:   ; にも対応しています。
1242:   (my-delete-other-window)
1243:   (refresh-screen)
1244:   ; my-split-windowは現在の窓を上下二つに分割します。
1245:   ; 引数に -4 を指定しているので、下の窓の高さを元の高さの 
1246:   ; 4/10 にし、カーソルを下の窓に置きます。
1247:   (my-split-window -4)
1248:   (refresh-screen)
1249:   (file fname)
1250:   (goto-char (point-min))
1251:   (refresh-screen)
1252:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

55 flushright -- 文字列を右詰めする

aaaaaaaaa

上の行の行頭にカーソルを置いて、M-x flushright としてみてください。文字列が右端に詰められます。

1253: (defun flushright ()
1254:   (interactive)
1255:   (let (cpos n)
1256:     (setq cpos (point))
1257:     (end-of-line)
1258:     (setq n (- fill-column (current-column)))
1259:     (goto-char cpos)
1260:     (while (> n 0)
1261:       (insert " ")
1262:       (setq n (- n 1)))
1263:              ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

56 file-to-clipboard -- 引数のファイルの内容をクリップボードに記憶

引数のファイルの内容をクリップボードに記憶します。例えば、

 (file-to-clipboard "c:/home/me/foo.txt")

のようにすると、c:/home/me/foo.txt の内容をクリップボードに記憶します。

m-x file-to-clipboard とすると、ミニバッファからファイル名を入力するよう促されるので、ファイル名を入力すると、入力したファイル名のファイルの内容をクリップボードに収録することができます。

1264: (defun file-to-clipboard (fname)
1265:   (interactive "ffile: ")
1266:   (let (buf)
1267:     (setq buf (get-buffer-create "*temp-buffer*"))
1268:     (switch-to-buffer buf)
1269:     (erase-buffer (selected-buffer))
1270:     (insert-file fname)
1271:     (copy-to-clipboard (buffer-substring (point-min) (point-max)))
1272:     ; copy-to-clipboard は xyzzy の組み込みの関数です。
1273:     (set-buffer-modified-p nil)
1274:     (kill-buffer buf)
1275:     (message (concat "the contents of " fname " were copied onto the clipboard.")))
1276:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

57 fdq -- 二重引用符号を探す

二重引用符号を探します。(fdq t) のように引数を指定するとカーソルがある行内で、行末までに二重引用符号があるか探します。

"abc¥"def" のように、二重引用符号の中にある二重引用符号の中に ¥ 記号があるときは読み飛ばします。 "abc¥¥" は

1277: (defun fdq (&rest findinline)
1278:   (interactive)
1279:   (block lookfordq
1280:     (loop
1281:       (if findinline
1282:           (if (not (myre-search-forward-in-line "¥""))
1283:               (return-from fdq nil))
1284:         (if (not (re-search-forward "¥"" t))
1285:             (return-from fdq nil)
1286:           ))
1287:         ; re-search-forward の第２引数に t を指定すると、発
1288:         ; 見できなかったときにエラーにならずに、nil を返しま
1289:         ; す。カーソル位置は、元の位置です。
1290:       ; (if (looking-at-backward "¥¥([^¥¥]¥¥¥¥¥¥|a¥¥)$")
1291:       (if (looking-at-backward "[^¥¥]¥¥¥¥$")
1292:           (progn
1293:             (forward-char 1)
1294:             )
1295:         (return-from lookfordq)
1296:         )
1297:       ); end of loop
1298:     ); end of lookfordq
1299:   (forward-char 1)
1300:   (return-from fdq t)
1301:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

58 finddq -- 二重引用符号を検索

二重引用符号は、一つ一つの行内で対応がとれているように書いてあるという前提で、検査する関数です。

今のカーソル位置以降に始めて現れる引用符号を発見し、

(1) その引用符号と対になる引用符号を、その行の行末までに、発見できなかったら、そこで停止し、その旨をメッセージボックで表示します。

(2) その引用符号と対になる引用符号を発見できたら、その引用符号の直後にカーソルを移動し、そこで制御を戻します。まだ、別の二重引用符号が同じ行内にあるかもしれません。そこをチェックするには、もう一度、M-x finddq してください。

引用符号の対応をひとつひとつ確認しながらカーソルを先に進めて行くことができます。

1302: (defun finddq ()
1303:   (interactive)
1304:   (if (not (fdq))
1305:       (progn
1306:         (message "これ以降、二重引用符号がありません。")
1307:         (return-from finddq nil)))
1308:   (if (not (fdq t))
1309:       (progn
1310:         (message "2個目の二重引用符号が行内にありません。")
1311:         (message-box "2個目の二重引用符号が行内にありません。"
1312:                      "finddq")
1313:         (call-process (concat (si:system-root) "xyzzycli.exe"))
1314:         (return-from finddq nil)))
1315:   t)

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

59 file -- バッファに書いてあるファイル名のファイルを開く

これから編集しようとするパスがバッファに書いてあるとして、そのパスの先頭にカーソルを置いて、この関数 file を呼ぶと、そのファイルを開きます。パスに空白が含まれている場合は、 "c:/Proram Files/000readme.txt" のようにダブルクォートで囲み、カーソルを初めのダブルクォートの上に置いて、この関数 file を呼ぶようにします。

  c:/home/me/000readme.txt
  "c:/Program Files/000readme.txt"
  "C:/tools/xyzzy/cbarlocal/progform.sample/000readme.txt"
  C:/tools/xyzzy/cbarlocal/progform.sample/000readme.txt
  "C:/tools/xyzzy/cbarlocal/progform.sample/000readme.txt"
 
  /*
   (File "C:/tools/xyzzy/cbarlocal/progform.sample/"
        "000readme.txt")
  */

ここで File が使われているのは問題ではないか。File は、 kh-xyzzyfunc.l で定義されています。

1316: (defun file ()
1317:   (interactive)
1318:   (let (fname beg end)
1319:     (save-excursion
1320:       (if (looking-at "¥"")
1321:           (setq fname (get-quoted-string))
1322:         (progn
1323:           (setq beg (point))
1324:           (re-search-forward "[ ¥t¥n¥"]" nil)
1325:           (setq end (point))
1326:           (setq fname (buffer-substring beg end))))
1327:       )
1328:     (call-process
1329:      (concat (si:system-root) "xyzzycli.exe " 
1330:            (get-clipboard-data)))
1331:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

60 firstline

引数の文字列の第一行を抽出して返します。

1332: (defun firstline (str)
1333:   (if (string-match "^(.*)¥n" str)
1334:       (match-string 1)
1335:     str))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

61 Fref -- 他のファイルの特定の場所にjump

Fref は、他のファイルの特定の箇所に jump するための仕組みです。

別のファイルに

   (Label "tag" "dispword")

のように書いてあるとして、そこに jump するための仕組みです。

 (Fref "tag" "dispword" "foo.lnk" "filename")

のように書いておき、そこで評価すると、"foo.lnk" と "filename" で指定されるファイルを開いて

 (Label "tag" ... )

の箇所に jump します。

第一引数 "tag" は ?(incomlete)==>(Label 関数の第一引数の文字列です。この文字列を第一引数に持つ ?(incomlete)==>(Label 第一引数 の形の文字列に jump します。

第二引数 dispword には意味はありませんが、Label 関数と合わせています。つまり、Fref の第一引数と第二引数は、対応する Label 関数の第一引数、第二引数と同じにします。

第三引数以降は、ファイル名を指定するためのものです。第三引数以降の1個以上の引数を concat で連結してできるファイル名のファイルの Label に jump します。

第三引数の文字列が拡張子 .lnk を含んでいる場合は、そのショートカットが指しているファイル名やディレクトリに置き換えられます。ディレクトリが指定されていない場合は、"C:/dirlink/"が前置されます。

使用例
 (Fref "08345424" "" "sitelisp.lnk" "kh-base.l")

1336: (defun Fref (tag displayWord fname &rest arg)
1337:   "fname 以降で指定されるファイルから (Label ... を検索"
1338:   (let (searchWord)
1339:     (setq searchWord (concat "[^=]¥(Label " "¥¥¥"" tag "¥¥¥""))
1340:     
1341:     (if (not 
1342:          (string=
1343:           (concat (directory-namestring fname)
1344:                   (file-namestring fname))
1345:           fname))
1346:         (if (string= (pathname-type fname) "lnk")
1347:             (setq fname 
1348:                   (concat "C:/dirlink/" fname)))
1349:       )
1350:     
1351:     (if (string= (pathname-type fname) "lnk")
1352:         (setq fname (resolve-shortcut fname))
1353:       )
1354:     
1355:     (if arg
1356:         (setq fname
1357:               (concat fname "/"
1358:                       (apply #'concat arg))))
1359:     
1360:     (refresh-screen)
1361:     (if *sameside*
1362:       (progn
1363:         (my-delete-other-window)
1364:         (refresh-screen)
1365:         (my-split-window -5)
1366:         (refresh-screen))
1367:       )
1368:     
1369:     (find-file fname)
1370:     (goto-char (point-min))
1371:     (if (re-search-forward searchWord t)
1372:         (progn
1373:           (search-forward ")")
1374:           (forward-char 1))
1375:       (if (re-search-backward searchWord t)
1376:           (progn
1377:             (search-forward ")")
1378:             (forward-char 1))
1379:         (my-message-box "対応する Label がありません。"))
1380:       )
1381:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

62 fref -- 他のファイルの特定の箇所に jump する

fref も Fref と同様、他のファイルの特定の箇所に jump するための仕組みです。

Fref とは引数が異なっていて、別の関数です。

別のファイルに

  (Label "tag"

のように書いてあるとして、そこに jump するための仕組みです。

  (fref "tag"

のように書いて置き、そこで評価すると、filename のファイルを開いて

  (Label "tag"

の箇所に jump します。

第一引数 tag は Label 関数の第一引数の文字列です。この文字列を第一引数に持つ L

  (Label 第一引数

の形の文字列に jump します。

第二引数以降は、ファイル名を指定するためのものです。第三引数以降の1個以上の引数を concat で連結してできるファイル名のファイルの Label に jump します。

第二引数の文字列が拡張子 .lnk を含んでいる場合は、そのショートカットが指しているファイル名やディレクトリに置き換えられます。ディレクトリが指定されていない場合は、"C:/dirlink/"が前置されます。

Fref とは大文字と小文字を区別しなければ同じ。 displayword はなし。

使用例
(fref "8776.8454" "bin.lnk" "activate-righttopwin.uws")

これは、(File "bin.lnk" "activate-righttopwin.uws") で、

  (Label "8776.8454"

を探します。

1382: (defun fref (tag fname &rest arg)
1383:   "fname 以降で指定されるファイルから (Label ... を検索"
1384:   (let (searchWord)
1385:     (setq searchWord (concat "[^=]¥(Label " "¥¥¥"" tag "¥¥¥""))
1386:     
1387:     (if (not 
1388:          (string=
1389:           (concat (directory-namestring fname)
1390:                   (file-namestring fname))
1391:           fname))
1392:         (if (string= (pathname-type fname) "lnk")
1393:             (setq fname 
1394:                   (concat "C:/dirlink/" fname)))
1395:       )
1396:     
1397:     (if (string= (pathname-type fname) "lnk")
1398:         (setq fname (resolve-shortcut fname))
1399:       )
1400:     
1401:     (if arg
1402:         (setq fname
1403:               (concat fname "/"
1404:                       (apply #'concat arg))))
1405:     
1406:     (refresh-screen)
1407:     (if *sameside*
1408:       (progn
1409:         (my-delete-other-window)
1410:         (refresh-screen)
1411:         (my-split-window -5)
1412:         (refresh-screen))
1413:       )
1414:     
1415:     (find-file fname)
1416:     (goto-char (point-min))
1417:     (if (re-search-forward searchWord t)
1418:         (progn
1419:           (search-forward ")")
1420:           (forward-char 1))
1421:       (if (re-search-backward searchWord t)
1422:           (progn
1423:             (search-forward ")")
1424:             (forward-char 1))
1425:         (my-message-box "対応する Label がありません。"))
1426:       )
1427:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

63 get-quoted-string -- fdefun の補助の関数

ダブルクォーテーションで始まっている文字列の最初のダブルクォーテーションにカーソルを置いて、この関数を呼び出します。ダブルクォーテーション囲まれる文字列を読み取って関数の戻り値として返します。

この関数を呼び出した後では、カーソルは、後のダブルクォーテーションの一つ後ろの位置に置かれます。

  "abcdef"

このような行があって、最初の " の上にカーソルを置いて、 get-quoted-string を実行すると、abcdef が返されます。

この関数は、関数

  (fdefun "file" "sitelisp.lnk" "kh-base.l")

で使われています。

1428: (defun get-quoted-string ()
1429:   (interactive)
1430:   (let (str curbuf buf bpos epos)
1431:     (forward-char 1)
1432:     (setq bpos (point))
1433:     (if (not (search-forward "¥"" t))
1434:         (progn
1435:           (my-message-box "二重引用符号が見つかりません。")
1436:           ))
1437:     (setq epos (point))
1438:     (forward-char 1)
1439:     (setq str (buffer-substring bpos epos))
1440:     ; (message-box str)
1441:     (setq curbuf (selected-buffer))
1442:     (copy-region-as-kill bpos epos)
1443:     (setq buf (get-buffer-create "*temp*"))
1444:     (switch-to-buffer buf)
1445:     (yank)
1446:     (goto-char (point-min))
1447:     (connect-lines)
1448:     (setq str (buffer-substring (point-min) (point-max)))
1449:     (delete-buffer buf)
1450:     (switch-to-buffer curbuf)
1451:     ; (message-box str)
1452:     ; )
1453:     str)
1454:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

64 gline -- 行末まで ━ を埋めます。 

1455: (defun gline ()
1456:   (interactive)
1457:   (char-line "━"))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

65 goto-first-window -- 先頭の窓に移動

先頭の窓に移動します。先頭の窓は、minibuffer-window の次の窓です。

1458: (defun goto-first-window ()
1459:   (interactive)
1460:   (set-window (next-window (minibuffer-window)))
1461:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

66 goto-last-window -- 最後の窓に移動

最後の窓に移動します。最後の窓は、minibuffer-window の前の窓です。

1462: (defun goto-last-window ()
1463:   (interactive)
1464:   (set-window (previous-window (minibuffer-window)))
1465:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

67 get-window-buffer -- 現在の窓のバッファを取得 

1466: (defun get-window-buffer (win)
1467:   (interactive)
1468:   (let (buf cwin)
1469:     (setq cwin (selected-window))
1470:     (set-window win)
1471:     (setq buf (selected-buffer))
1472:     (set-window cwin)
1473:     buf))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

68 get-long-path-name

http://d.hatena.ne.jp/miyamuko/20050912/p1に紹介されていました。

内容は分かりませんが、これで動きます。

1474: ; (get-short-path-name "c:/program files/000readme.txt")
1475: ; は、"c:/progra~1/000rea~1.txt" を返します。
1476: ; (get-long-path-name "c:/progra~1/000rea~1.txt")
1477: ;
1478: (c:define-dll-entry winapi::DWORD getlongpathname (winapi::LPCSTR winapi::LPCSTR winapi::DWORD)
1479:   "kernel32" "GetlongPathNamea")
1480: 
1481: (defun get-long-path-name (short-path)
1482:   (let ((buf (si:make-chunk nil 512)))
1483:     (getlongpathname (si:make-string-chunk short-path) buf 512)
1484:     (si:unpack-string buf 0)))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

69 goto-window-top -- カーソルを窓の先頭に移動する

カーソルを窓の先頭に移動する。バッファはスクロールしない。

1485: (defun goto-window-top ()
1486:   (interactive)
1487:   (beginning-of-line)
1488:   (while (> (get-window-line) 0)
1489:     (previous-virtual-line)))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

70 goto-window-center -- カーソルを窓の中央に移動する

カーソルを窓の中央に移動する。バッファはスクロールしない。

1490: (defun goto-window-center ()
1491:   (interactive)
1492:   (beginning-of-line)
1493:   (while (> (get-window-line) 0)
1494:     (previous-virtual-line))
1495:   (while (< (get-window-line) (/ (window-height) 2))
1496:          (next-virtual-line))
1497:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

71 goto-window-bottom -- カーソルを窓の最下行に移動する

画面の最下行の一行上に移動します。バッファはスクロールしない。

1498: (defun goto-window-bottom ()
1499:   (interactive)
1500:   (setq *lastpos* (point))
1501:   (refresh-screen)
1502:   (while (> (get-window-line) 0)
1503:      (previous-virtual-line))
1504:   (refresh-screen)
1505:   (forward-virtual-line (- (window-height) 1))
1506:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

72 goto-window-last5 -- 画面の下から5行目にカーソルを移動

画面の下から5行目のラインにカーソルを移動します。

1507: (defun goto-window-last5 ()
1508:   (interactive)
1509:   (beginning-of-line)
1510:   (setq *lastpos* (point))
1511:   (refresh-screen)
1512:   (while (> (get-window-line) 0)
1513:      (previous-virtual-line))
1514:   (refresh-screen)
1515:   (forward-virtual-line (- (window-height) 5))
1516:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

73 hsplitted-p -- 上下にに分割されているか

上下にに分割されているか。下のように分割されているか。

 +-------------------+
 |                   |
 +-------------------+
 |                   |
 +-------------------+

 (hsplitted-p)
 (sfind "hsplitted-p" "sitelisp.lnk" "kh-base.l")

1517: (defun hsplitted-p ()
1518:   (interactive)
1519:   (refresh-screen)
1520:   (if (< (window-height) (- (screen-height) 6))
1521:       t
1522:     nil))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

74 hfill-continue-region-p

□ hfill-continue-region-p

hfill で使います。つぎの一行が継続行かどうか判定します。 fprefix で始まっていれば、原則、継続行とみなします。ただし、 fprefix で始まっていて、その後が空白文字列なら詰め込みを停止します。

1523: (defun hfill-continue-region-p (fprefix)
1524:   (let (continue-p)
1525:     (if fprefix
1526:         ; fprefix が nil でなければ行頭文字列がある。その場
1527:         ; 合は、行頭文字列があって、その後に継続を終了させる
1528:         ; ような文字列がないかチェックします。そうでなければ、
1529:         ; continue-p は t です。
1530:         (setq continue-p
1531:               (and (looking-at fprefix)
1532:                    (not (looking-at (concat fprefix "[ ].*$")))
1533:                    (not (looking-at (concat fprefix "[ ]*$")))
1534:                    (not (looking-at (concat fprefix "[ ]*@end")))
1535:                    (not (looking-at (concat fprefix "[ ]*¥¥¥¥end")))
1536:                    (not (looking-at (concat fprefix "[ ]*¥¥¥¥item")))
1537:                    (not (looking-at (concat fprefix "[ ]*---")))
1538:                    ; (not (looking-at (concat fprefix "[ ]*[.]")))
1539:                    ))
1540:       (setq continue-p
1541:       ; fprefix が nil だったので行頭文字はなし。その場合は、
1542:       ; 継続を終了させるような文字列がないかチェックします。
1543:       ; そうでなければ、continue-p は t です。
1544:             (not (or (looking-at "^[ ].*$")
1545:                      (looking-at "^[ ]*$")
1546:                      (looking-at "^[#%;/:']")
1547:                      (looking-at "^[ ]*@end")
1548:                      (looking-at "^[ ]*¥¥¥¥end")
1549:                      (looking-at "^[ ]*¥¥¥¥item")
1550:                      (looking-at "^[ ]*---")
1551: ; @begin{Inserted at 20160819 18:41}------------------------
1552:                      (looking-at "^¥.¥. ")
1553:                      (looking-at "^¥. ")
1554: ; @end{Inserted at 20160819 18:41}--------------------------
1555:                      ; (looking-at "^[ ]*[.]")
1556:                      ))
1557:             ))
1558:     continue-p))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

75 hfill-nextline -- 前置文字列を考慮して次の行まで連結

hfill-nextline は、

; ああああああああああああああ
;     いいいいいいいい
;  ううううううううううううううう

のように行頭に、コメント文字と空白があるときに、自動的に空白を削除してつなげていく操作をする関数です。

.xyzzy に

  (global-set-key '(#¥C-c #¥k #¥h #¥n) 'hfill-nextline); 

と書き、C-c k h n で、行を接続できるようにしています。

; ああああああああああああああ
;     いいいいいいいい
;  ううううううううううううううう

の最初の行にカーソルを置いて、C-c k h n をタイプすると

; あああああああああああああいいいいいいいい■
;  ううううううううううううううう

のように整形されます。カーソルは■の位置に置かれます。■は、実際に書き込まれません。

hfill-nextline は delete-nextline-and-trailing-spaces と同じ目的で使用できます。

カーソル位置の行から、次の行までを hfill します。

1559: (defun hfill-nextline ()
1560:   (interactive)
1561:   (let (fprefix numprefix i)
1562:     (beginning-of-line)
1563:     (skip-chars-forward myskipchars)
1564:     (set-fill-prefix)
1565:     (setq fprefix nil)
1566:     (if fill-prefix
1567:         (setq fprefix (regexp-quote fill-prefix)))
1568:     (setq numprefix (current-column))
1569:     (end-of-line)
1570:     (delete-char 1)
1571:     (if (and (> numprefix 0) (looking-at fprefix))
1572:         (progn
1573:           (forward-char -1)
1574:           (delete-char 1)
1575:           (setq i numprefix)
1576:           (while (> i 0)
1577:             (delete-char 1)
1578:             (setq i (- i 1)))))
1579:     (delete-horizontal-spaces))
1580:   (end-of-line))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

76 hfill -- ぶら下げインデントの段落を整形

○ 関数 hfill は、こんな風に、段落の最初にだけ段落の開始を
   表す文字列があってその後に、行頭に空白文字列が続く形に
   成形します。

hfill を呼ぶ前に、段落の最初の行にカーソルを持っていくようにする必要があります。

1581: (defun hfill ()
1582:   (interactive "*")
1583:   ; 前行のように書くと、書き込み禁止バッファでは実行できませ
1584:   ; ん。
1585:   (let (begp endp num fprefix prefix numprefix 
1586:              i loopflag lflag flen endmarker)
1587:     (beginning-of-line)
1588:     ;
1589:     (skip-chars-forward myskipchars)
1590:     ;
1591:     ;
1592:     (set-fill-prefix)
1593:     (setq fprefix nil)
1594:     (if fill-prefix
1595:         (setq fprefix (regexp-quote fill-prefix)))
1596:     (setq numprefix (current-column))
1597:     ;
1598:     ; ● このように見出し行があって、見出し行の字下げ量と同
1599:     ; じだけ字下げされた行が続いている場合に、それらの行をす
1600:     ; べて、前の行に詰め込みます。
1601:     (end-of-line)
1602:     (setq loopflag t)
1603:     (while loopflag
1604:       (forward-char 1)
1605:       (if (hfill-continue-region-p fprefix)
1606:           (progn
1607:             (forward-char -1)
1608:             (delete-char 1)
1609:             (if (> numprefix 0)
1610:                 (progn
1611:                   (setq i numprefix)
1612:                   (while (> i 0)
1613:                     (delete-char 1)
1614:                     (setq i (- i 1)))))
1615:             (delete-horizontal-spaces)
1616:             (end-of-line)
1617:             )
1618:         (progn (forward-char -1) (setq loopflag nil))
1619:         )
1620:       )
1621:     (beginning-of-line)
1622:     (skip-chars-forward myskipchars)
1623:     (cond 
1624:           ; 1. 1) a. a) のような見出し行
1625:           ((looking-at "¥¥([0-9][0-9]*¥¥|[a-zA-Z][a-zA-Z]*¥¥)[¥.)] ")
1626:            (goto-char (match-end 0))
1627:            )
1628:           ; (1) (a) のような見出し行
1629:           ((looking-at "¥¥(([0-9][0-9]*¥¥|[a-zA-Z][a-zA-Z]*¥¥)) ")
1630:            (goto-char (match-end 0))
1631:            )
1632:           ; 1.1 や ab.1 や a.1) のような見出し行
1633:           ; foo.bat のように . の後が英字だけのものは見出し
1634:           ; 行とはみなしません。
1635:           ((and (looking-at "[0-9a-zA-Z][¥.0-9a-zA-Z]*[0-9a-zA-Z])? ")
1636:                 (not (looking-at "[0-9a-zA-Z][0-9a-zA-Z]* "))
1637:                 (not (looking-at
1638:                       "[a-zA-Z][0-9a-zA-Z]*¥.[a-zA-Z][a-zA-Z]*"))
1639:                 )
1640:            (looking-at "[0-9a-zA-Z][¥.0-9a-zA-Z]*[0-9a-zA-Z])? ")
1641:            (goto-char (match-end 0))
1642:            )
1643:           ;; つぎの２行は何のためにあるのか。
1644:           ;; これは表の中の : に対応しています。
1645:           ;; コロンの前後に一個以上の空白を置いていることに
1646:           ;; 注意して下さい。
1647:           ((looking-at "[^:¥n][^:¥n]* : ")
1648:            (goto-char (match-end 0))
1649:            )
1650: ;
1651:           ((looking-at "[^:¥n][^:¥n]* :: ")
1652:            (goto-char (match-end 0))
1653:            )
1654: ;
1655:           ((looking-at "¥¥(●¥¥|■¥¥|○¥¥|□¥¥|・¥¥|※¥¥|[-*+][-*+]*¥¥) ?")
1656:            (goto-char (match-end 0))
1657:            ))
1658:     (setq num (current-column))
1659:     ;
1660:     ; flen (最初の行の長さ) を求めています。
1661:     (end-of-line)
1662:     (setq flen (current-column))
1663:     ;
1664:     (beginning-of-line)
1665:     (setq begp (point))
1666:     (next-line 1)
1667:     ;
1668:     ; fprefix を修正して、見出し部分を空白文字に置き換えて、
1669:     ; 見出し行のつぎの行以降の行頭詰め込み文字列の正規表現に
1670:     ; なるようにします。
1671:     (setq i numprefix)
1672:     (while (< i num)
1673:       (setq fprefix (concat fprefix " "))
1674:       (setq i (+ i 1)))
1675:     ;
1676:     ; 見出し行が fill-column より短くて、つぎの行が継続行な
1677:     ; ら、つぎつぎと見出し行に詰め込み、見出し行が 
1678:     ; fill-column より長くなるようにします。
1679:     (while (and (< flen (- fill-column 2))
1680:                 (hfill-continue-region-p fprefix))
1681:         (progn
1682:           (forward-char -1)
1683:           (delete-char 1)
1684:           (if (> numprefix 0)
1685:               (progn
1686:                 (setq i numprefix)
1687:                 (while (> i 0)
1688:                   (delete-char 1)
1689:                   (setq i (- i 1)))))
1690:           (delete-horizontal-spaces)
1691:           (end-of-line)
1692:           (setq flen (current-column))
1693:           (beginning-of-line)
1694:           (next-line 1)))
1695:     ; 
1696:     (setq endp (point))
1697:     ;
1698:     ; 見出し行のつぎの行の行頭を endmarker にセットします。
1699:     (setq endmarker (point-marker))
1700:     (fill-region-as-paragraph begp endp)
1701:     ; 上の行の操作で、
1702:     ; ● あああああああああああああああああああああああああ
1703:     ; (endmarker)いいいいいいいいい
1704:     ; 
1705:     ; のような形式に整形されています。
1706: 
1707:     (goto-char begp)
1708:     (next-line 1) 
1709:     (if (< (point) (marker-point endmarker))
1710:         (progn
1711:           (while (< (point) (marker-point endmarker))
1712:             (progn
1713:               (beginning-of-line)
1714:               (while (< (current-column) numprefix)
1715:                 (forward-char 1))
1716:               (if (not (looking-at " "))
1717:                   (while (< (current-column) num)
1718:                     (insert " ")))
1719:               (next-line)
1720:               (beginning-of-line)))
1721:           ))
1722:     ;
1723:     ; ここまでの操作で、普通は、
1724:     ;
1725:     ; ● あああああああああああああああああああああああああ
1726:     ;    あああああああああああああああああああああああああ
1727:     ;    ああああああああああああ
1728:     ; (endmarker)いいいいいいいいい
1729:     ; 
1730:     ; のような形式に整形されています。この形式を形式Aとしま
1731:     ; す。
1732:     ;
1733:     ; ● あああああああああああああああああああ
1734:     ; (endmarker)いいいいいいいいい
1735:     ;
1736:     ; の形になっているかも知れません。この形式を形式Bとしま
1737:     ; す。以下に出てくる (hfill-continue-region-p fprefix) 
1738:     ; は、このいずれの形かになっているかを検査しています。
1739:     (goto-char begp)
1740:     (next-line 1)
1741:     (if (hfill-continue-region-p fprefix)
1742:         ; 2行目が継続行だったので、形式Aでした。cfillで整形
1743:         ; します。
1744:         (cfill)
1745:       ; 2行目には継続行がありませんので、詰め込みする必要が
1746:       ; ありません。前の行の行末に戻ります。
1747:       (forward-char -1)
1748:       ; 前の行の行末に戻っています。
1749:       )
1750:     (setq endp (point))
1751:     (goto-char begp) (end-of-line)
1752:     (if (> (current-column) (- fill-column 3))
1753:         (goto-char endp))
1754:     )
1755:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

77 insert-date -- 現在の年月日を 2010-05-01 のような形式で挿入する

insert-date は cbar が書きました。

/*
   (Net "http://xyzzy.s53.xrea.com/reference/wiki.cgi?p=format-date-string")
*/

を参考にしました。

  (user::insert-date)
  (ed::insert-date)

上の二つを評価してみると、(user::insert-date) では日付が挿入されますが、(ed::insert-date) ではエラーがでます。したがって、このファイル kh-base.l で書いた関数は

    user パッケージで定義される

ということが分かります。

なぜ、「user パッケージで定義される」かというと、このファイルの一行目にそのように指示しているからです。

1756: (defun insert-date ()
1757:   "現在の年月日を 2010-05-01 のような形式で挿入する"
1758:   (interactive)
1759:   (insert (format-date-string "%Y-%m-%d")))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

78 insert-bdate -- 今日の日付文字列をカギ括弧付きで挿入します。

ab

の b の位置にカーソルを置いて、M-x insert-bdate とすると、

a[2017-09-30]b

のようになります。bdate の b は、bracket の b です。

1760: (defun insert-bdate ()
1761:   "現在の年月日を [2010-05-01] のような形式で挿入する"
1762:   (interactive)
1763:   (insert (format-date-string "[%Y-%m-%d]")))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

79 insert-date-and-time, insert-time 

1764: (defun insert-date-and-time ()
1765:   "現在の年月日を 2015-05-27 19:17:49 のような形式で挿入する"
1766:   (interactive)
1767:   (insert (format-date-string "%Y-%m-%d %H:%M:%S")))
1768: 
1769: (defun insert-time ()
1770:   "現在の年月日を 2015-05-27 19:17:49 のような形式で挿入する"
1771:   (interactive)
1772:   (insert (format-date-string "%Y-%m-%d %H:%M:%S")))
1773: 
1774: ;;; (defalias 'insert-time 'insert-date-and-time)

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

80 item

項目のところに、線と日付を入れるスタイルで項目を書きだすときに使用します。

  1. カーソルが区切り線の上にあるときには、その区切り線のつぎの行に、項目を書き出すように、線と日付を書きます。

  2. カーソルが区切り線の上にないときは、一旦、ファイルの先頭にカーソルを移動して、最初の項目になるように、線と日付を書きます。

1775: (defun item ()
1776:   (interactive)
1777:   (let (bufname)
1778:     (setq bufname (buffer-name (selected-buffer)))
1779:     (if (string= bufname "memo-memo.txt")
1780:         (progn
1781:           (goto-char (point-max))
1782:           (goto-bol)
1783:           (insert "¥n¥n")
1784:           (previous-line)
1785:           (line)
1786:           (insert "¥n** [")
1787:           (insert-date)
1788:           (insert "] ()")
1789:           (forward-char -1)
1790:           )
1791:       (progn
1792:         (goto-bol)
1793:         (if (not (looking-at "-----"))
1794:             (progn
1795:               (goto-char (point-min))
1796:               (re-search-forward "^¥¥*+ ¥¥[")
1797:               (goto-bol)
1798:               (forward-line -1)))
1799:         (goto-bol)
1800:         (insert "¥n¥n")
1801:         (previous-line)
1802:         (previous-line)
1803:         (line)
1804:         (if (string= bufname "todo.txt")
1805:             (insert "¥n** [")
1806:           (insert "¥n* ["))
1807:         (insert-date)
1808:         (insert "] ")))
1809:     )
1810:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

81 itemend -- ファイルの最後に項目を追加

ファイルの最後に項目を追加するときに使います。

1811: (defun itemend ()
1812:   (interactive)
1813:   (goto-char (point-max))
1814:   (goto-bol)
1815:   (insert "¥n¥n")
1816:   (previous-line)
1817:   (line)
1818:   (insert "¥n* [")
1819:   (insert-date)
1820:   (insert "] "))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

82 in-left-window-p -- カーソルが左の窓に居るか

左の窓にいれば、t を返し、そうでなければ、nil を返します。

1821: (defun in-left-window-p ()
1822:   (let (lc bool)
1823:     (setq lc (nth 0 (window-coordinate)))
1824:     (if (> lc 0)
1825:         (setq bool nil)
1826:       (setq bool t))
1827:     bool))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

83 in-upper-window-p -- カーソルが上の窓に居るか

上の窓にいれば、t を返し、そうでなければ、nil を返します。

1828: (defun in-upper-window-p ()
1829:   (let (upw bool)
1830:     (setq upw (nth 1 (window-coordinate)))
1831:     (if (> upw 0)
1832:        (setq bool nil)
1833:      (setq bool t))
1834:    bool))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

84 insert-random8 -- カーソル位置に8桁のランダム数値を挿入

M-x insert-random8 とすると、カーソル位置に8桁のランダムな数値が挿入されます。

19836904

 (sfind "計算、乱数の発生など" "winnote.lnk" "win-xyzzy.txt")

1835: (defun insert-random8 ()
1836:   (interactive)
1837:   (let (num)
1838:     (setq num (random 99999999))
1839:     (insert (format nil "~8,'0D" num))
1840:     )
1841:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

85 insert-random8d -- カーソル位置に8桁のランダム数値を挿入

M-x insert-random8d とすると、カーソル位置に8桁のランダムな数値が挿入されます。8桁の数字の真ん中に . が置かれます。

3260.0118

1842: (defun insert-random8d ()
1843:   (interactive)
1844:   (let (num)
1845:     (setq num (random 9999))
1846:     (insert (format nil "~4,'0D" num))
1847:     (insert ".")
1848:     (setq num (random 9999))
1849:     (insert (format nil "~4,'0D" num))
1850:     )
1851:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

86 insert-random6 -- カーソル位置に6桁のランダム数値を挿入 

1852: (defun insert-random6 ()
1853:   (interactive)
1854:   (let (num)
1855:     (setq num (random 999999))
1856:     (insert (format nil "~6,'0D" num))
1857:     )
1858:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

87 increment-number -- カーソル位置の数字を1増やす

カーソル位置の数字を1増やします。カーソル位置に数字がなければ何もしません。

C-u M-x increment-number とすると、最初数字が始まっていた位置に移動します。

1859: ; カーソル位置の数字を1増やします。カーソル位置に数字がなけ
1860: ; れば何もしません。
1861: ;
1862: ; C-u M-x increment-number とすると、最初数字が始まっていた
1863: ; 位置に移動します。
1864: ;
1865: ; 1234567
1866: ;
1867: ; (fdefun "increment-number" "sitelisp.lnk" "kh-base.l")
1868: (defun increment-number (&optional narg)
1869:   (interactive "P")
1870:   (let ((current (point))
1871:         (start 0)
1872:         (end 0)
1873:         num)
1874:     (skip-chars-backward "0-9") ;; 数字の先頭へ
1875:     (setq start (point))
1876:     (skip-chars-forward "0-9")  ;; 単語の最後尾へ
1877:     (setq end (point))
1878:     (if (= start end)
1879:         nil
1880:       (progn
1881:         (setq num (parse-integer (buffer-substring start end)))
1882:         (delete-region start end)
1883:         (setq num (+ num 1))
1884:         (insert (format nil "~D" num))
1885:         (if narg
1886:             (goto-char start))
1887:         )
1888:       )
1889:     )
1890:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

88 jump-to-the-line -- カーソル行と同じ行を他バッファから探す

現在カーソルがある行と同じ行をもうひとつのバッファから探してそこにカーソルを移動します。

窓が上下に別れていて、一方にC-x @ globalsetCk.bat などとして、表示されたバッファがあり、それは、他の窓に表示されたバッファの一部の行を抽出した行からなっているときに使用します。

1891: (defun jump-to-the-line ()
1892:   (interactive)
1893:   (let (str beg end)
1894:     (beginning-of-line)
1895:     (setq beg (point))
1896:     (end-of-line) (setq end (point))
1897:     (setq str (buffer-substring beg end))
1898:     (if (in-upper-window-p)
1899:         (other-window 1)
1900:       (other-window -1)
1901:       )
1902:     (goto-char (point-min))
1903:     (search-forward str)
1904:     )
1905:   )
1906: 
1907: (defalias 'goto-the-original-line 'jump-to-the-line)

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

89 kh-excr -- コメント領域に記載されている lisp 式を実行する

最初、この関数は、kh-excr.l の中で定義されていましたが、 kh-base.l に統合しました。

関数 kh-excr は、コメントアウトされている範囲に記載されている lisp 式を実行する関数です。

例えば、

 (call-interactively #'(lambda ()
  (interactive) (find-file "~/000readme.txt")))

のように複数行に渡って記載されている lisp 式を実行することができます。そのために、

  1. 実行したい lisp 式が記載されていて、コメントアウトされている範囲を範囲指定します。
  2. m-x kh-excr とします。

この関数 kh-excr は、範囲指定された領域を *ecrfunc* という名前のバッファに書き出して、行頭のコメント文字を取り除いて、ecr-func という関数を定義する形にするために必要なコードを前後に挿入してから、全体を評価します。これで、関数 ecr-func が定義されるので、それをインターラクティブに実行します。

コメントアウトするのに使われる行頭文字は、そのファイルの拡張子に対応した lisp mode に対応して決まります。例えば、 lisp では、このファイルのように、行頭に ;; を置くことにします。bat-mode では、::、tex-mode では、% です。この関数 kh-excr は、現在編集しているバッファのモードを考慮しています。

 (call-interactively #'(lambda ()
  (interactive) (find-file "~/000readme.txt")))

のように、コメント記号より前に複数個数の半角空白があっても問題ないようです。

2014-03-21 継続行に対応しました。

1908: (defun kh-excr (beg end)
1909:   (interactive "r")
1910:   (let (begp endp)
1911:     ; 範囲を指定します。行頭から行頭までを指定するように補正
1912:     ; します。
1913:     (goto-char (min beg end))
1914:     (beginning-of-line)
1915:     (setq begp (point))
1916:     (goto-char (max beg end))
1917:     (beginning-of-line)
1918:     (setq endp (point))
1919:     ; 指定した範囲を kill バッファに記憶します。
1920:     (copy-region-as-kill begp endp)
1921:     ; バッファ *ecrfunc* を作ります。
1922:     (switch-to-buffer (get-buffer-create "*ecrfunc*"))
1923:     ; 念のためバッファ *ecrfunc* の内容を削除します。
1924:     (delete-region (point-min) (point-max))
1925:     ; kill バッファの内容を *ecrfunc* に書き出します。
1926:     (yank)
1927:     ; コメントアウトするのに使われている行頭文字を削除します。
1928:     ; 
1929:     (goto-char (point-min))
1930:     (perform-replace "^[ ]*[/:;%'#]+[ ]+" "" nil t t t)
1931:     (goto-char (point-min))
1932:     (perform-replace "^[ ]*[/:;%'#]+$" "" nil t t t)
1933:     ;
1934:     ; 継続行の処理をします
1935:     (goto-char (point-min))
1936:     (connect-lines)
1937:     ; 関数 ecr-func を定義する形にするために前後にコードを挿
1938:     ; 入します。
1939:     (goto-char (point-min))
1940:     (insert "(defun ecr-func () (interactive)¥n")
1941:     (goto-char (point-max))
1942:     (insert ")¥n")
1943:     ; コードを保存済みと認識させます。
1944:     (set-buffer-modified-p nil)
1945:     ; バッファを評価して、関数 ecr-func を定義します。
1946:     (eval-region (point-min) (point-max))
1947:     ; バッファ *ecrfunc* を削除します。
1948:     (delete-buffer "*ecrfunc*")
1949:     (call-interactively 'ecr-func)
1950:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

90 kh-excr-in-other-window -- kh-excr を他窓で実行

 (fdefun "kh-excr-in-other-window")
 (fdefun "kh-excr-in-other-window" "sitelisp.lnk" "kh-base.l")

 /*
 (File "sitelisp.lnk" "kh-xyzzyfunc.l")
 */

 /#
 (File "sitelisp.lnk" "kh-xyzzyfunc.l")
 #/

1951: (defun kh-excr-in-other-window (beg end)
1952:   (interactive "r")
1953:   (let (begp endp)
1954:     ; 範囲を指定します。行頭から行頭までを指定するように補正
1955:     ; します。
1956:     (goto-char (min beg end))
1957:     (beginning-of-line)
1958:     (setq begp (point))
1959:     (goto-char (max beg end))
1960:     (beginning-of-line)
1961:     (setq endp (point))
1962:     ; 指定した範囲を kill バッファに記憶します。
1963:     (copy-region-as-kill begp endp)
1964:     ;
1965:     ; 
1966:     ; 窓が一つなら水平方向に分割して、窓を上下二つにする
1967:     ; 窓を一つにします。
1968:     ; (refresh-screen)
1969:     ; (my-delete-other-window)
1970:     ; (refresh-screen)
1971:     ; 窓を分割して、下の窓にカーソルを移動します。
1972:     ; (my-split-window -5)
1973:     ; (refresh-screen)
1974:     ;
1975:     ; 窓が左右に分割されていれば、反対側の窓に表示したい
1976:     (refresh-screen)
1977:     (if (vsplitted-p)
1978:         (if (= (nth 0 (window-coordinate)) 0)
1979:             ; 左側の窓に居たので、右の窓に移動したい
1980:             (while (= (nth 0 (window-coordinate)) 0)
1981:               (other-window))
1982:           ; 右側の窓にいたので左の窓に移動したい
1983:           (while (> (nth 0 (window-coordinate)) 0)
1984:             (move-previous-window))
1985:           )
1986:       (progn
1987:         (my-delete-other-window)
1988:         (refresh-screen)
1989:         (my-split-window -5)
1990:         (refresh-screen)))
1991:     ;
1992:     ; 下の窓で、*evalwork* バッファを作成し、そこに記憶して
1993:     ; いたlisp 式を挿入して評価します。その後、*evalwork* バ
1994:     ; ッファを削除します。
1995:     (switch-to-buffer (get-buffer-create "*evalwork*"))
1996:     (delete-region (point-min) (point-max))
1997:     (goto-char (point-min))
1998:     (yank)
1999:     (insert "¥n")
2000:     ;
2001:     ; コメントアウトするのに使われている行頭文字を削除します。
2002:     ; 
2003:     (goto-char (point-min))
2004:     (perform-replace "^[ ]*[/:;%'#]+[ ]+" "" nil t t t)
2005:     (goto-char (point-min))
2006:     (perform-replace "^[ ]*[/:;%'#]+$" "" nil t t t)
2007:     ;
2008:     ; 継続行の処理をします
2009:     (goto-char (point-min))
2010:     (connect-lines)
2011:     ;
2012:     ; バッファを評価して、関数 ecr-func を定義します。
2013:     (eval-region (point-min) (point-max))
2014:     ; バッファ *ecrfunc* を削除します。
2015:     (delete-buffer "*evalwork*")
2016:     (refresh-screen)
2017:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

91 kh-move-to-next-same-length-line

現在の桁位置より長いつぎの行にカーソルを移動する。バッファの最後に到達したらその旨、表示する。

この後に定義する kh-move-to-next-same-length-line-and-cutと連携して動作します。

(sfind "my-colon-menu" "commondotfiles.lnk" ".xyzzy")

2018: (defun kh-move-to-next-same-length-line ()
2019:   (interactive)
2020:   (let (bpos cpos flag bl cl)
2021:     (setq bpos (current-column))
2022:     (setq cl (current-line-number))
2023:     (setq flag t)
2024:     (block wloop
2025:       (while flag
2026:         (setq bl cl)
2027:         (next-line 1)
2028:         (setq cl (current-line-number))
2029:         (if (eq cl bl)
2030:             ; next-line を実行したのに行数が変わらなかったの
2031:             ; で、バッファの最後に到達したと判定できる。
2032:             (progn
2033:               (my-message-box "Reached the end of the buffer.")
2034:               (return-from wloop)))
2035:         (end-of-line)
2036:         (setq cpos (current-column))
2037:         (if (< cpos bpos)
2038:             (setq flag t)
2039:           (progn
2040:             ; bpos の位置まで桁位置を戻す。
2041:             (let (n)
2042:               (setq n (current-column))
2043:               (while (> n bpos)
2044:                 (forward-char -1)
2045:                 (setq n (current-column)))
2046:               )
2047:             ; bpos の位置の文字を検査
2048:             ;
2049: ;;             (if (eq (char-after (point)) #¥-)
2050: ;;                 ; bpos の位置に - があったので、区切り線の上
2051: ;;                 ; と判定。
2052: ;;                 (setq flag nil)
2053: ;;               )
2054:             ; もう少しいいロジックを。行末まで、- が続いていると
2055:             ; か。
2056:             (if (or (looking-at "--*$") (looking-at "==*$"))
2057:                 (setq flag nil))
2058:             )
2059:           )
2060:         ); end of while loop
2061:       ); end of block wloop
2062:     ); end of let
2063:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

92 kh-move-to-next-same-length-line-and-cut

区切り線の長さを同じにするために使用します。

2064: (defun kh-move-to-next-same-length-line-and-cut ()
2065:   (interactive)
2066:   (if (or (looking-at "--*$") (looking-at "==*$") (looking-at ",,*$"))
2067:     (progn 
2068:       (call-interactively 'kill-line)
2069:       (refresh-screen)
2070:       ))
2071:   (kh-move-to-next-same-length-line)
2072:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

93 kh-move-to-next-line

"-----$" か ",,,,,$" にマッチする行を探して、その行に移動します。

2073: ; "-----$" か ",,,,,$" にマッチする行を探して、
2074: ; その行に移動します。
2075: 
2076: (defun kh-move-to-next-line ()
2077:   (interactive)
2078:   (let (bl cl flag)
2079:     (setq cl (current-line-number))
2080:     (setq flag t)
2081:     (block wloop
2082:       (while flag
2083:         (setq bl cl)
2084:         (next-line 1)
2085:         (setq cl (current-line-number))
2086:         (if (eq cl bl)
2087:             ; next-line を実行したのに行数が変わらなかっ
2088:             ; たので、バッファの最後に到達したと判定でき
2089:             ; る。
2090:             (progn
2091:               (my-message-box "Reached the end of the buffer.")
2092:               (call-process (concat (si:system-root) "xyzzycli.exe"))
2093:               (return-from wloop)))
2094:         (end-of-line)
2095:         (if (or (looking-at-backward "-----$")
2096:                 (looking-at-backward ",,,,,$")
2097:                 )
2098:             (if (not (= (current-column) fill-column))
2099:                 (setq flag nil)))
2100:         )
2101:       ); end of block wloop
2102:     ); end of let
2103:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

94 kh-line-adjust

"-----$" か、"=====$"、",,,,,$" にマッチする行の長さを fill-column になるように調整します。

2104: (defun kh-line-adjust ()
2105:   (interactive)
2106:   (end-of-line)
2107:   (if (or (looking-at-backward "-----$")
2108:           ; (looking-at-backward "=====$")
2109:           (looking-at-backward ",,,,,$")
2110:           )
2111:       (progn
2112:         (cond 
2113:          ((looking-at-backward "-----$")
2114:           (adjust-line "-"))
2115:          ; ((looking-at-backward "=====$")
2116:          ;  (adjust-line "="))
2117:          ((looking-at-backward ",,,,,$")
2118:           (adjust-line ","))
2119:          )
2120:         (refresh-screen)
2121:         )
2122:     ); end of if
2123:   (kh-move-to-next-line)
2124:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

95 kh-quiet-match-paren

なぜか、my-match-paren を呼び出すと、「不正なデータ型です。」と表示するメッセージボックスが表示されます。これは、

.xyzzy につぎのように書いていることが原因と思われます。

  (global-set-key #¥% 'my-match-paren)

% をタイプするのではなく、他の lisp code の中から呼び出すために内容は同じですが、つぎの kh-quiet-match-paren を定義しました。

コードの意味はよく分かっていません。

2125: (defun kh-quiet-match-paren (&optional arg)
2126:  "Go to the matching parenthesis if on parenthesis otherwise insert %."
2127:  (interactive "p")
2128:   (setq *temp-mode* buffer-mode)
2129:   (lisp-mode)
2130:   (cond 
2131:    ((looking-at "[([{]") (forward-sexp 1) (backward-char))
2132:    ((looking-at "[])}]") (forward-char) (backward-sexp 1))
2133:    (t (self-insert-command (or arg 1))))
2134:   (funcall *temp-mode*)
2135:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

96 kill-ring-yank-pointer-reset

region.l の補足
  (File "C:/tools/xyzzy/lisp.old/region.l")

yank-pop が書き出す文字列の位置を最初に戻します。

2136: (defun kill-ring-yank-pointer-reset ()
2137:   (interactive)
2138:   (setq ed::*kill-ring-yank-pointer* ed::*kill-ring*)
2139:   (setq ed::*last-yank-point* ed::*kill-ring*)
2140:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

97 kill-shell-buffer

xyzzy の中の shell バッファを閉じます。窓は残して、バッファだけを閉じます。

2141: (defun kill-shell-buffer ()
2142:   (interactive)
2143:   (if (not 
2144:        (or
2145:         (string= (buffer-name (selected-buffer)) "*Shell*")
2146:         (string= (buffer-name (selected-buffer)) "*PowerShell*")
2147:         (string= (buffer-name (selected-buffer)) "Python")
2148:         )
2149:        )
2150:       (progn
2151:         (message-box "Not in a shell buffer")
2152:         (return-from kill-shell-buffer)))
2153:   (goto-char (point-max))
2154:   (insert "exit")
2155:   (ed::shell-send-input)
2156:   (sleep-for 2)
2157:   (kill-buffer (selected-buffer))
2158:   ; (sleep-for 1)
2159:   ; (delete-window)
2160:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

98 kill-shell-window

xyzzy の中の shell 窓を閉じます。バッファだけでなく窓も閉じます。

2161: (defun kill-shell-window ()
2162:   (interactive)
2163:   (if (not 
2164:        (or
2165:         (string= (buffer-name (selected-buffer)) "*Shell*")
2166:         (string= (buffer-name (selected-buffer)) "*PowerShell*")
2167:         (string= (buffer-name (selected-buffer)) "Python")
2168:         )
2169:        )
2170:       (progn
2171:         (message-box "Not in a shell buffer")
2172:         (return-from kill-shell-window)))
2173:   (goto-char (point-max))
2174:   (insert "exit")
2175:   (ed::shell-send-input)
2176:   (sleep-for 2)
2177:   (kill-buffer (selected-buffer))
2178:   (sleep-for 1)
2179:   (delete-window)
2180:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

99 kill-window -- 選択されている窓と窓に対応しているバッファを削除

現在選択されている窓と窓に対応しているバッファを削除します。現在選択されている窓を削除するのは簡単で、C-x 0 とタイプします。この kill-window がいいところは同時に対応するバッファも削除してくれるところです。

2012-11-16
窓が上下に分かれていなければ、kill-buffer だけにして、窓は消さないことにしました。窓が上下に分かれているときに、 kill-window して、あ、窓は消さなくてもよかったかなと思うことが多いので。

2181: (defun kill-window ()
2182:   (interactive)
2183:   ; Cannot kill only one window
2184:   (if (< (count-windows nil) 2)
2185:       (my-message-box "Cannot kill only one window.")
2186:     (progn
2187:       (let ((buf (selected-buffer)) (win (selected-window)) 
2188:             (found nil) (end nil) (cwin (selected-window)))
2189:         (while (not end)
2190:           (setf win (next-window win))
2191:           (if (equal win cwin)
2192:               (setq end t)
2193:             (if (equal buf (get-window-buffer win))
2194:                 (progn
2195:                   (setq found t)
2196:                   (setq end t))))
2197:           )
2198:         (if (not found)
2199:             (kill-buffer buf)
2200:           (my-message-box (concat (buffer-name buf) ": this buffer is used in another window."))
2201:           )
2202:         (if (< (window-height) (- (screen-height) 6))
2203:             (delete-window))
2204:         ))
2205:     )
2206:   )
2207: 
2208: (defalias 'kw 'kill-window)

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

100 line

スマフォにもマッチするような長さの線を引きます。

他に

  - cline   ; 行末まで , (カンマ) を埋めます。
  - dline   ; 行末まで = (等号) を埋めます。
  - gline   ; 行末まで ━ (全角の太線) を埋めます。
  - zline   ; 行末まで ー (全角長音記号) を埋めます。

があります。

2209: (defun line ()
2210:   (interactive)
2211:   (let (lenline cnum)
2212:     (setq lenline fill-column)
2213:     (if (> fill-column 64)
2214:         (setq lenline 64))
2215:     (end-of-line)
2216:     (setq cnum (current-column))
2217:     (while (< cnum lenline)
2218:       (insert "-")
2219:       (end-of-line)
2220:       (setq cnum (current-column))
2221:       )
2222:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

101 list-buffer-window

引数で指定したバッファを持つ窓のリストを返します。そういう窓が無ければ nil を返します。

使用例
現在編集中のバッファが他の窓に表示されていないか調べるには、次の値が1より大きいかを見ます。

  (length (list-buffer-window (selected-buffer)))

2223: (defun list-buffer-window (buffer)
2224:   (let ((rw nil); rw は、返す window のリスト。最初に nil に設定する。
2225:         (wl (list-window)); 
2226:         (w nil))
2227:     (if (eq buffer nil) (return-from list-buffer-window nil))
2228:     (while wl
2229:       (setq w (car wl))    ; 窓を取り出す
2230:       (setq wl (cdr wl))   ; 残りの窓
2231:       (if (eq (get-window-buffer w) buffer)
2232:           (push w rw)))    ; リスト rw の前に w を入れます。
2233:     rw))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

102 list-windows

https://gist.github.com/608651を参照しました。

window のリストを返します。

2234: (defun list-window ()
2235:   (let ((r nil)
2236:         (w (selected-window)))
2237:     (loop
2238:       (push w r)
2239:       (setf w (next-window w))
2240:       (when (equal w (selected-window))
2241:         (return)))
2242:     r))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

103 lookfor-headline

「¥ や * など正規表現のメタ文字をエスケープしたい」のように、「と」で囲まれた文字列がある行にカーソルを置いて、

   m-x lookfor-headline 

とすると、「と」で囲まれた文字列で始まる見出し行に jump します。

たとえば、「dynamic 型」と書いてある行で、lookfor-headline を実行した場合、

 ...
 *** dynamic 型

があるとき、2番目の見出し行に jump します。1番目の見出し行は、"dynamic 型" で始まっていないからです。

探している見出し行が無かったときにメッセージを表示して、元の位置にカーソル位置を戻します。

2243: (defun lookfor-headline ()
2244:   (interactive)
2245:   (setq *lastpos* (point))
2246:   (let (str beg end)
2247:     (goto-bol)
2248:     (if (not (looking-at ".*?「"))
2249:         (progn
2250:           (my-message-box "検索語を含んだ見出し行が見つかりません。")
2251:           (return-from lookfor-headline)))
2252:     (re-search-forward "「" t)
2253:     (forward-char 1)
2254:     (setq beg (point))
2255:     (if (not (looking-at ".*?」"))
2256:         (progn
2257:           (my-message-box "検索語を含んだ見出し行が見つかりません。")
2258:           (return-from lookfor-headline)))
2259:     (re-search-forward "」" t)
2260:     (setq end (point))
2261:     (setq str (regexp-quote (buffer-substring beg end)))
2262:     (goto-char (point-min))
2263:     (if (not (re-search-forward (concat "^[/%; ]*¥¥*¥¥** " str) t))
2264:         (progn
2265:           (my-message-box 
2266:            (concat "検索語¥n¥n「" str "」¥n¥nを含んだ見出し行"
2267:                    "が見つかりません。"))
2268:           (goto-char beg))
2269:       ))
2270:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

104 linkpath -- リンクファイルの指す先を返す 

  (linkpath "c:/dirlink/saloon.lnk")

のようにすると、リンクファイル c:/dirlinke/saloon.lnk が指している先のパスを返します。

もうこの関数を使わないこと。resolve-shortcut を使えばいい。

2271: (defun linkpath (link)
2272:   (resolve-shortcut link))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

105 looking-at-backward -- looking-at 後方版 (正規表現で後方マッチ)

looking-at 後方版 (正規表現で後方マッチ)

使用例
カーソル位置の直前に右括弧があるか。
(if (looking-at-backward "\)$") (message-box "just after )"))

XyzzyWiki 質問箱/175 より

2273: (defun looking-at-backward (regexp &optional case-fold)
2274:    (save-excursion
2275:      (save-restriction
2276:        (narrow-to-region (point-min) (point))
2277:        (goto-char (point-min))
2278:        (scan-buffer (format nil "¥¥(?:~A¥¥)¥¥'" regexp)
2279:                     :regexp t :case-fold case-fold))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

106 make-window-half -- 画面を上下二つに分けて、二つのバッファの内容を表示

画面を上下二つに分けて、二つのバッファの内容を表示します。

  1. 現在のバッファをまず上下の２つの窓に表示します。
  2. 下側の窓に表示するバッファをユーザに選択させます。

2280: (defun make-window-half ()
2281:    "make the window half"
2282:   (interactive)
2283:   ; カーソルを窓の先頭行に移動します。
2284:   (while (> (get-window-line) 0)
2285:         (previous-virtual-line))
2286:   (beginning-of-line)
2287:   (refresh-screen)
2288:   (my-delete-other-window)
2289:   (split-window)
2290: ;; (previous-buffer)
2291: ;; 単に画面を2つにしたいときにも使える方が便利なので、上の行
2292: ;; をコメントアウトしました。
2293:   (global-set-key #¥C-¥; 'previous-buffer)
2294:   (global-set-key #¥C-¥: 'next-buffer)
2295:   (message "C-; や C-: をタイプして上窓のバッファを変更可能。青色がCrrntBffr。")
2296: ;;  (other-window 1)
2297:   (refresh-screen)
2298: ;;   (message-box "select buffer to be shown in the lower window")
2299: ;;   (call-interactively 'select-buffer)
2300: ;;   (refresh-screen)
2301:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

107 make-window-half-next-buffer -- 画面を上下二つに分けて、二つのバッファの内容を表示

画面を上下二つに分けて、二つのバッファの内容を表示します。

  1. 現在のバッファをまず上下の２つの窓に表示します。
  2. 下側の窓に表示するバッファをユーザに選択させます。

2302: (defun make-window-half-next-buffer ()
2303:    "make the window half"
2304:   (interactive)
2305:   ; カーソルを窓の先頭行に移動します。
2306:   (while (> (get-window-line) 0)
2307:         (previous-virtual-line))
2308:   (beginning-of-line)
2309:   (my-delete-other-window)
2310:   (refresh-screen)
2311:   (split-window)
2312:   (other-window 1)
2313:   (next-buffer)
2314: ;; 単に画面を2つにしたいときにも使える方が便利なので、上の行
2315: ;; をコメントアウトしました。
2316:   (global-set-key #¥C-¥; 'previous-buffer)
2317:   (global-set-key #¥C-¥: 'next-buffer)
2318:   (message "C-; や C-: をタイプして下窓のバッファを変更可能")
2319:   (refresh-screen)
2320: ;;   (message-box "select buffer to be shown in the lower window")
2321: ;;   (call-interactively 'select-buffer)
2322: ;;   (refresh-screen)
2323:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

108 make-window-half-vertically

現在編集中のバッファを左窓に置き、右窓に表示するバッファを選択する

2324: (defun make-window-half-vertically ()
2325:   "make the window half vertically"
2326:   (interactive)
2327:   ; 他の窓を消します。
2328:   (delete-other-windows)
2329:   ; 現在の窓を左右二つの窓に分けます。
2330:   (beginning-of-line)
2331:   (split-window-vertically)
2332:   ;; カーソルは左の窓のまま。バッファは previous-buffer
2333:   ; (other-window 1)
2334:   (refresh-screen)
2335:   (previous-buffer)
2336:   (beginning-of-line)
2337:   (global-set-key #¥C-¥; 'previous-buffer)
2338:   (global-set-key #¥C-¥: 'next-buffer)
2339:   (message "C-; や C-: をタイプして左窓のバッファを変更可能。青色がCrrntBffr。")
2340: ;  (message-box "C-; や C-: をタイプして¥n右窓に表示するバッファを変更できます。¥n¥nシアンのタブのバッファが¥n右窓に表示されています。¥n¥nこのメッセージを確認したら¥nスペースキーを押してください。")
2341:   (refresh-screen)
2342:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

109 mark-first-half 

2343: (defun mark-first-half ()
2344:   (interactive)
2345:   (set-mark (point-min))
2346:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

110 mark-latter-half 

2347: (defun mark-latter-half ()
2348:   (interactive)
2349:   (set-mark (point-max))
2350:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

111 move-to-sixth-line 

2351: (defun move-to-sixth-line ()
2352:   (interactive)
2353:   (let (cl)
2354:     (setq *lastpos* (point))
2355:     (setq cl (- (current-line-number) 1))
2356:     (user::scroll-to-window-top)
2357:     (refresh-screen)
2358:     (if (> cl 5)
2359:         (setq cl 6))
2360:     (scroll-window (* -1 cl))
2361:     (refresh-screen)
2362:     (forward-virtual-line cl)
2363:     (refresh-screen)
2364:     )
2365:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

112 move-to-fifth-line 

2366: (defun user::move-to-fifth-line ()
2367:   (interactive)
2368:   (let (cl)
2369:     (setq *lastpos* (point))
2370:     (setq cl (- (current-line-number) 1))
2371:     (user::scroll-to-window-top)
2372:     (refresh-screen)
2373:     (if (> cl 3)
2374:         (setq cl 4))
2375:     (scroll-window (* -1 cl))
2376:     (refresh-screen)
2377:     (forward-virtual-line cl)
2378:     (refresh-screen)
2379:     )
2380:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

113 my-adjust-mini-buffer-height

高すぎるミニバッファを調整する

2381: (defun my-adjust-mini-buffer-height ()
2382:   (interactive)
2383:   (refresh-screen)
2384:   (enlarge-window (- (screen-height) (window-height) 5)))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

114 my-buffer-exist-p -- 指定するファイルのバッファがあるか

get-file-buffer でいいかも。指定するファイルのバッファがあるか検査します。 filename はフルパスで指定しないといけません。 "c:/home/me/.xyxxy" のような引数が指定されても、 "c:/home/me/.xyzzy" のように正しい指定がされたように動作しないといけません。いまは不完全。

  (my-buffer-exist-p "~/.xyzzy")
  (my-buffer-exist-p "c:/home/me/.xyzzy")

2385: (defun my-buffer-exist-p (filename)
2386:   (interactive "f")
2387:   (let (buf 
2388:         (originalbuf (selected-buffer))
2389:         (lst (find-name-buffer (file-namestring filename)))
2390:         (found nil))
2391:     (setq filename (standard-filename-expression filename))
2392:     (while (and lst (not found))
2393:       (setq buf (car lst))
2394:       (switch-to-buffer buf)
2395:       (setq lst (cdr lst))
2396:       (if (equal filename 
2397:                  (standard-filename-expression
2398:                   (get-buffer-file-name (selected-buffer))))
2399:           (progn
2400:             (setq found t))
2401:         ))
2402:     (switch-to-buffer originalbuf)
2403:     (if (not found) (setq buf nil))
2404:     buf))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

115 my-clear-rectangle

矩形リージョンを切り取り (clear-rectangle) を実行して、つぎに、Shift + F9 を押せというメッセージを表示します。

2405: (defun my-clear-rectangle ()
2406:   (interactive)
2407:   (call-interactively 'copy-rectangle)
2408:   (refresh-screen)
2409:   (message-box 
2410:     "Shift + F9 でクリアした矩形領域を「貼付け」できます。")
2411:   (call-process (concat (si:system-root) "xyzzycli.exe"))
2412:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

116 my-close-all-buffers-except-this

/*
   (Net "http://www2.ocn.ne.jp/~cheerful/script/xyzzy/library/buffer.html#cb_ex_close")
*/

2413: (defun my-close-all-buffers-except-this()
2414:   "今カーソルのあるバッファ以外を閉じる"
2415:   (interactive)
2416:   (let (tb)
2417:     (setq tb (get-buffer-file-name))
2418:     (close-session-dialog)
2419:    (find-file tb)
2420:   )
2421: )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

117 my-copy-rectangle

矩形リージョンの複写 (copy-rectangle) を実行して、つぎに、Shift + F9 を押せというメッセージを表示します。

2422: (defun my-copy-rectangle ()
2423:   (interactive)
2424:   (call-interactively 'copy-rectangle)
2425:   (refresh-screen)
2426:   (message-box 
2427:     "Shift + F9 でコピーした矩形領域を「貼付け」できます。")
2428:   (call-process (concat (si:system-root) "xyzzycli.exe"))
2429:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

118 my-delete-rectangle

矩形リージョンの削除 (delete-rectangle) を実行します。

2430: (defun my-delete-rectangle ()
2431:   (interactive)
2432:   (call-interactively 'delete-rectangle)
2433:   (refresh-screen)
2434:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

119 my-delete-window

上下に分かれている窓を閉じることを優先する方針で窓を閉じます。

+----------+---------+
|          |         |
|     A    |    B    |
|          |         |
+----------+---------+
|          |         |
|     C    |    D    |
|          |         |
+----------+---------+

のようになっていて、B にカーソルがあるときに、

+----------+---------+
|          |         |
|     A    |         |
|          |         |
+----------+    D    |
|          |         |
|     C    |         |
|          |         |
+----------+---------+

のようになるように、B の窓を閉じます。

(1) 窓が上下に分かれているかチェックします。
(2) 窓が上下に分かれている場合。カーソルがある窓を閉じます。ただし、左または右の窓で高さが同じ窓があるときに、うまくいかないのを回避するために、窓をちょっとだけ大きくしてから、窓を閉じます。
(3) 窓が上下に分かれていない場合、何もしません。

C-x 8 0 を割り当てます。

2435: (defun my-delete-window ()
2436:   (interactive)
2437:   (if (< (window-height) (- (screen-height) 6))
2438:       (progn
2439:         (enlarge-window 1)
2440:         (delete-window))
2441:     (message-box "  窓は上下に分かれていません。  " "my-delete-window")))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

120 my-delete-other-window

窓が下の図のように上下方向に分かれているときに、現在カーソルがある窓を残して、他の窓をすべて閉じます。

+--------------------+
|         A          |
+--------------------+
|         B          |
+--------------------+
|         C          |
+--------------------+

例えば、カーソルが B の窓にあるときは、A, C の窓を閉じます。

2442: (defun my-delete-other-window ()
2443:   (interactive)
2444:   (let (uwl)
2445:     (if (< (window-height) (- (screen-height) 6))
2446:       ; 窓の高さがスクリーン一杯ではない、すなわち
2447:       ; 窓が上下に分割されていると確認した
2448:         (while (< (window-height) (- (screen-height) 6))
2449:           ; 窓が上下に分割されていない状態になるまで、現在の
2450:           ; 窓以外の上下の窓を閉じます。
2451:           (progn
2452:             (setq uwl (nth 1 (window-coordinate)))
2453:             (if (> uwl 0)
2454:                   (progn
2455:                     ; (message-box "上側の窓ではない")
2456:                     (other-window -1)
2457:                     (delete-window))
2458:               (progn
2459:                   (other-window 1)
2460:                   (delete-window))
2461:               )
2462:             (refresh-screen)
2463:             )
2464:           )
2465:       ;(message-box "      窓は上下に分かれていません。      " "my-delete-other-window")
2466:       )
2467:     )
2468:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

121 my-delete-other-window-vertically

左右に分かれた窓があるときに、現在カーソルがある窓ではない方の窓を閉じます。窓が左右に分かれていると考えられない場合は何もしません。

+-----+-----+     +-----------+
|     |     |     |           |
|     |     | ->  |           |
|     |     |     |           |
+-----+-----+     +-----------+


2469: (defun my-delete-other-window-vertically ()
2470:   (interactive)
2471:   (let (lc)
2472:     (if (< (window-width) (- (screen-width) 4))
2473:       ; 窓の幅がスクリーン一杯ではない、すなわち
2474:       ; 窓が左右に分割されていると確認した
2475:       (progn
2476:         (setq lc (nth 0 (window-coordinate)))
2477:         (if (> lc 0)
2478:             ; 右側の窓
2479:             (progn
2480:               (other-window -1)
2481:               (delete-window))
2482:           ; 左側の窓
2483:           (progn
2484:             (other-window 1)
2485:             (delete-window))
2486:           )
2487:         ))
2488:     )
2489:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

122 my-delete-previous-window 

2490: (defun my-delete-previous-window ()
2491:   (interactive)
2492:   (other-window -1)
2493:   (delete-window))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

123 my-delete-next-window 

2494: (defun my-delete-next-window ()
2495:   (interactive)
2496:   (other-window 1)
2497:   (delete-window))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

124 my-eval-last-sexp -- 現在の窓で、カーソル位置のlisp式を実行

define-barfunc で関数 barfunc を動的に定義して、 call-interactively を使って実行します。

 /*
 (call-interactively #'(lambda ()
  (interactive) (find-file "~/001me.txt")))
 */

/* の / の上、または */ の / の後ろにカーソルを置いて、
 M-x my-eval-last-sexp または C-c C-e とタイプして見てください。

[2014-04-13] カーソルの前に半角空白があるときは、カーソルを前に移動するようにしよう。

 (fdefun "define-barfunc")
 (fdefun "my-eval-last-sexp")

[2015-11-16] セレクションを指定して、C-c C-e とすると、セレクションをリージョンに変換して、kh-excr を実行します。

2498: (defun my-eval-last-sexp ()
2499:   (interactive)
2500:   (let (cbuf)
2501:     (setq cbuf (selected-buffer))
2502:     ; 2014-03-22 */ の直後にカーソルがあれば、
2503:     ; /* ... */ で囲まれた範囲を範囲指定して、kh-excr を
2504:     ; 呼びだすようにしました。これで、コメント中に、lisp 
2505:     ; code が置かれたときにも実行できるようになりました。
2506:     ;
2507:     ;; /*
2508:     ;;  (Net "http://xyzzy.s53.xrea.com/wiki/index.php?_
2509:     ;;    QuickTour%2Fetc%2F%A4%D8%A4%CA%A4%C1%A4%E7%A4%B3%A5_
2510:     ;;    %EA%A5%D5%A5%A1%A5%EC%A5%F3%A5%B9%A4%CE%BB%C8%A4%A4_
2511:     ;;    %CA%FD" _
2512:     ;;    _
2513:     ;;    _
2514:     ;;    "■ QuickTour/etc/へなちょこリファレンスの使い方")
2515:     ;; */
2516:     ;;
2517:     ;; */ の後ろにカーソルを置くか、/* の / の上にカーソルを
2518:     ;; 置いて、my-eval-last-sexp を実行してみてください。
2519:     ;;
2520:     ;; */ の後ろにカーソルを置く場合には、*/ の後に半角空白
2521:     ;; が1個以上あっても構いません。
2522:     ;;
2523:     ;; */ の後ろにカーソルを置いてあるときに、
2524:     ;; my-eval-lastsexpを実行すると、各行の前にある行頭のコ
2525:     ;; メント記号を取り除きます。それを実行している関数が 
2526:     ;; kh-excr です。
2527:     ;; 
2528:     ;; コメント文字があるところでなければ、/* ... */ で囲む
2529:     ;; 必要はありません。
2530:     ;; 
2531:     ;; 行末に _ を置いたときに、つぎの行に継続する約束を考慮
2532:     ;; して解析してくれるのは、define-barfunc 関数です。
2533:     ;; define-barfunc 関数の中にそのようなコードがあります。
2534:     ; ------------------------------------------------------
2535:     ; [2014-04-13] カーソルの前に半角空白があるときは、カー
2536:     ; ソルを前に移動するように、つぎの3行を挿入しました。
2537:     ;
2538:     ; [2018-11-24]
2539:     ; C++ のプログラムの中では、/* ... */ で囲むという方法は
2540:     ; 使えないので、/# ... #/ で囲んだ場合も同じ処理をする機
2541:     ; 能を追加しました。
2542:     (if (not (looking-at "[(/]"))
2543:       (while (looking-at-backward "[ ]$")
2544:         (forward-char -1)))
2545:     ; ------------------------------------------------------
2546:     (if (looking-at-backward "¥¥*/$")
2547:       (progn
2548:         (let (begp endp)
2549:           (goto-bol) (setq endp (point))
2550:           ; (message-box "here3")
2551:           (search-backward "/*")
2552:           (forward-line 1)
2553:           (goto-bol) (setq begp (point))
2554:           (goto-char endp)
2555:           ;; 関数 kh-excr は、コメントアウトされている範囲に
2556:           ;; 記載されている lisp 式を実行する関数です。
2557:           ;;
2558:           ;; 例えば、
2559:           ;;
2560:           ;; (call-interactively #'(lambda ()
2561:           ;;  (interactive) (find-file "~/000readme.txt")))
2562:           ;; 
2563:           ;; のように複数行に渡って記載されている lisp 式を
2564:           ;; 実行することができます。
2565:           (kh-excr begp endp))
2566:         (return-from my-eval-last-sexp)))
2567:     
2568:     (if (looking-at-backward "#/$")
2569:       (progn
2570:         (let (begp endp)
2571:           (goto-bol) (setq endp (point))
2572:           ; (message-box "here3")
2573:           (search-backward "/#")
2574:           (forward-line 1)
2575:           (goto-bol) (setq begp (point))
2576:           (goto-char endp)
2577:           ;; 関数 kh-excr は、コメントアウトされている範囲に
2578:           ;; 記載されている lisp 式を実行する関数です。
2579:           ;;
2580:           ;; 例えば、
2581:           ;;
2582:           ;; (call-interactively #'(lambda ()
2583:           ;;  (interactive) (find-file "~/000readme.txt")))
2584:           ;; 
2585:           ;; のように複数行に渡って記載されている lisp 式を
2586:           ;; 実行することができます。
2587:           (kh-excr begp endp))
2588:         (return-from my-eval-last-sexp)))
2589:     ;
2590:     (if (looking-at "/¥¥*")
2591:       (progn
2592:         (let (begp endp)
2593:           (search-forward "¥*/") (goto-bol) (setq endp (point))
2594:           (search-backward "/*")
2595:           (forward-line 1)
2596:           (goto-bol) (setq begp (point))
2597:           (goto-char endp)
2598:           (kh-excr begp endp))
2599:         (return-from my-eval-last-sexp)))
2600:     
2601:     (if (looking-at "/#")
2602:       (progn
2603:         (let (begp endp)
2604:           (search-forward "#/") (goto-bol) (setq endp (point))
2605:           (search-backward "/#")
2606:           (forward-line 1)
2607:           (goto-bol) (setq begp (point))
2608:           (goto-char endp)
2609:           (kh-excr begp endp))
2610:         (return-from my-eval-last-sexp)))
2611:     ;
2612:     ; つぎの define-barfunc は、この関数の直後で定義していま
2613:     ; す。
2614:     (if (define-barfunc)
2615:         (call-process "xyzzycli.exe -f barfunc")
2616:       )
2617:    )
2618:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

125 my-eval-last-sexp-in-other-horizontal-window -- 別の窓で実行 

2619: (defun my-eval-last-sexp-in-other-horizontal-window ()
2620:   (interactive)
2621:   ; 窓が一つなら水平方向に分割して、窓を上下二つにする
2622:   ; 窓を一つにします。
2623:   (refresh-screen)
2624:   (my-delete-other-window)
2625:   (refresh-screen)
2626:   ; 窓を分割して、下の窓にカーソルを移動します。
2627:   (my-split-window -4)
2628:   (refresh-screen)
2629:   (call-interactively 'my-eval-last-sexp)
2630:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

126 my-exchange-window

上下または左右の窓を入れ替えます。

 (fdefun "my-switch-window-horizontally")
 (fdefun "my-switch-window-vertically")

2631: (defun my-exchange-window ()
2632:   (interactive)
2633:   (if (hsplitted-p)
2634:       ; 上下方向に分割されていた。
2635:       (my-switch-window-horizontally)
2636:     (progn
2637:       (if (vsplitted-p)
2638:           (my-switch-window-vertically)
2639:         (my-message-box "not splitted."))
2640:       ))
2641:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

127 my-filer-cleandir

現在アクティブなファイラー窓のディレクトリを引数に指定して cleandir.bat を実行します。

2642: (defun my-filer-cleandir ()
2643:   (interactive)
2644:   (call-process
2645:    (concat "¥me¥¥bat¥¥cleandir¥¥cleandir.bat "
2646:            (map-slash-to-backslash
2647:             (filer-get-directory)))
2648:            :show :minimize)
2649:   (sleep-for 1)
2650:   (filer-reload)
2651:   (my-message-box "cleandir を実行しました。")
2652:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

128 my-filer-everything 

2653: (defun my-filer-everything ()
2654:   (interactive)
2655:   (let (path filename)
2656:     (setq path (filer-get-current-file))
2657:     (if (file-directory-p path)
2658:         (setq path (substring path 0 (- (length path) 1))))
2659:     (setq filename (file-namestring path))
2660:     (call-process
2661:      (concat "c:¥¥tools¥¥everything¥¥everything.exe -filename "
2662:              filename))
2663:     ; (message-box filename)
2664:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

129 my-filer-filesdir

カーソル位置のファイルの .files ディレクトリがなければ作成し、カーソル位置のファイルの .files ディレクトリに移動します。

2665: (defun my-filer-filesdir ()
2666:   (interactive)
2667:   (let (subdir filename)
2668:     (setq filename (filer-get-current-file))
2669:     (setq subdir (concat filename ".files"))
2670:     (if (not (file-directory-p subdir))
2671:         (create-directory subdir))
2672:     (folder subdir)))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

130 my-filer-filesdirectory

 foo.txt <-> foo.txt.files

のようにファイルの表示行と、そのファイルの files directory の表示行の間を相互に jump します。

2673: (defun my-filer-filesdirectory ()
2674:   (interactive)
2675:   (let (filename fname)
2676:     (setq filename (filer-get-current-file))
2677:     (if (file-directory-p filename)
2678:         (progn
2679:           (if (string-match "^¥¥(.*¥¥)¥¥.files/$" filename)
2680:               (progn
2681:                 (setq fname
2682:                       (substring filename 
2683:                                  (match-beginning 1)
2684:                                  (match-end 1)))
2685:                 (filer-goto-file (file-namestring fname))
2686:                 (return-from my-filer-filesdirectory))
2687:             (progn
2688:               (my-message-box "not files directory")
2689:               (return-from my-filer-filesdirectory)))
2690:           )
2691:       (progn
2692:         (setq fname (concat filename ".files"))
2693:         (if (file-exist-p fname)
2694:             (filer-goto-file (file-namestring fname))
2695:           (my-message-box "no files directory")))
2696:       )
2697:     )
2698:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

131 my-filer-msd

現在アクティブなファイラー窓のディレクトリを引数に指定して msd.exe を実行します。オプションを指定するための問い合わせ窓が表示されます。

msd.bat を実行した後、もう一つのファイラー窓に、c:/users/me/desktop/mksdshortcutdirを表示します。

2699: (defun my-filer-msd ()
2700:   (interactive)
2701:   (let (option)
2702:     ; 変数 option を dialog-box を使って対話的に指定します。
2703:     (setq option
2704:      (multiple-value-bind (result data)
2705:       (dialog-box
2706:         `(dialog 0 0 175 57 
2707:                (:caption "command to be applied on the current path")
2708:                (:font 9 "ＭＳ Ｐゴシック")
2709:                (:control 
2710:                 (:static nil "enter options for mksd (ex. /clear /num /nonum /postnum)" #x50020000 5 3 139 21)
2711:                 (:edit line nil #x50810480 5 24 165 12) 
2712:                 (:button idok "ok" #x50010001 130 40 40 13) 
2713:                 )); (dialog で始まる行の終わり
2714:            (list (cons 'line "/clear /postnum"))
2715:            nil)
2716:           ;; dialog-box 関数の残りの引数を指定しているところ
2717:           ;; ここの dialog-box の結果が、result と data に
2718:           ;; 格納されま
2719:           ;; す。data はリストのはず。
2720:           ;; ここで、dialog-box 関数は終わりました。
2721:         ;; この後は、multiple-value-bind の３つ目の引数以降が
2722:         ;; 並び
2723:         ;; ます。戻り値 result, data を利用して、
2724:         ;; multiple-value-bind の戻り値を指定します。この例では、
2725:         ;; 一つだけ値を指定しています。
2726:         ;; (cdr (car data)); 
2727:        (cdr (assoc 'line data))
2728:        ); end of (multiple-value-bind
2729:      ); end of (setq option
2730:     ;
2731:     ; 対話的に指定された option を指定して、バッチファイル
2732:     ; mksd.bat を実行します。
2733:     (call-process 
2734:      (concat "msd.bat" 
2735:        " "
2736:        option " "
2737:        (map-slash-to-backslash (filer-get-directory))
2738:        ))
2739:     ;
2740:     (filer-swap-windows)
2741:     ; 2画面ファイラーでもう一方のウィンドウへフォーカスを移しま
2742:     ; す。
2743:     (sleep-for 1)
2744:     (filer-chdir (concat *my-userdir* "Desktop/msdSdir"))
2745:     (filer-reload)
2746:     (refresh-screen)
2747:     )
2748:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

132 my-filer-001file

現在のディレクトリの説明ファイルを作成する。

 "001" + 現在のディレクトリの名前 + ".txt"

の形のテキストファイルを作成します。

現在のディレクトリの説明ファイルが既に存在している場合は、そのファイルを開きます。

2749: (defun my-filer-001file ()
2750:   (interactive)
2751:   (let (dirname ldirname filename)
2752:     (setq dirname (filer-get-directory))
2753:     (setq dirname (substring dirname 0 (- (length dirname) 1)))
2754:     (setq ldirname (file-namestring dirname))
2755:     (setq filename
2756:           (concat dirname "/001" ldirname ".txt"))
2757:     (find-file filename)
2758:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

133 my-filer-mksamedir

カーソル位置のディレクトリと同じ名前のディレクトリをもう一方の窓に作成する。

2759: (defun my-filer-mksamedir ()
2760:   (interactive)
2761:   (let (path sdir dirname)
2762:     (setq path (filer-get-current-file))
2763:     (if (not (file-directory-p path))
2764:         (progn
2765:           (message-box 
2766:            (concat path " is not a directory.")
2767:            "my-filer-mksamedir"
2768:            '(:exclamation)
2769:            )
2770:           (call-process (concat (si:system-root) "xyzzycli.exe"))
2771:           (return-from my-filer-mksamedir)))
2772:     (setq sdir (filer-get-directory t))
2773:     (setq dirname
2774:           (file-namestring (substring path 0 (- (length path) 1))))
2775:     (create-directory (concat sdir dirname))
2776:     (filer-reload "*" t)
2777:     (refresh-screen)
2778:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

134 my-filer-mk-shortcut

カーソル位置のファイルのショートカットを作成して、必要なら名前を変更します。

2779: (defun my-filer-mk-shortcut ()
2780:   (interactive)
2781:   (let (filename name dir)
2782:     (setq filename (filer-get-current-file))
2783:     (setq name (file-namestring filename))
2784:     (setq dir (filer-get-directory))
2785:     (create-shortcut filename dir)
2786:     (filer-reload)
2787:     (filer-goto-file (concat name ".lnk"))
2788:     (filer-rename)
2789:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

135 my-goto-leftwindow

窓が左右に分割されていて、しかもカーソルが右側の窓にあるとき、現在のバッファを左側に表示し、カーソルも左側の窓に移動させる。

2790: (defun my-goto-leftwindow ()
2791:   (interactive)
2792:   (let (lc)
2793:     (setq lc (nth 0 (window-coordinate)))
2794:     (if (> lc 0)
2795:         (my-switch-window-vertically))
2796:     )
2797:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

136 my-goto-line-end

行末または fill-column の位置にカーソルを移動します。

2798: (defun my-goto-line-end ()
2799:   (interactive)
2800:   (let (cpos n)
2801:     (end-of-line)
2802:     (setq n (- (current-column) fill-column))
2803:     (if (<= n 0)
2804:         (my-message-box
2805:          (concat "The line end is located before the "
2806:                  "fill-column.¥n¥n"
2807:                  "To fill spaces at the line end, type "
2808:                  "M-x sline")
2809:          )
2810:       (while (> n 0)
2811:         (forward-char -1)
2812:         (setq n (- (current-column) fill-column)))
2813:       )
2814:     )
2815:   )
2816: 
2817: (defalias 'ge 'my-goto-line-end)

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

137 my-insert-file

普通に insert-file を実行すると、カレントフォルダからファイルを選択するようなプロンプトが表示されるので、 default-directory を変更してから、insert-file を呼び出します。

2818: (defun my-insert-file ()
2819:   (interactive)
2820:   (let (dir)
2821:     (setq dir (default-directory (selected-buffer)))
2822:     (set-default-directory 
2823:      "c:/Users/me/Dropbox/DropboxData/xyzzy/insert")
2824:     (call-interactively 'insert-file)
2825:     (set-default-directory dir)))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

138 my-kill-buffer

現在編集中のバッファが他の窓でも表示されている場合は、その旨を伝えるメッセージを表示し、代わりにその窓に表示するバッファを対話的に選択します。

2826: (defun my-kill-buffer ()
2827:   (interactive)
2828:   (if (> (length (list-buffer-window (selected-buffer))) 1)
2829:       (progn
2830:         (case
2831:             (message-box 
2832:              (concat "このバッファを開いている窓が他にもあります。¥n¥n"
2833:                      "バッファは残して、窓を閉じますか。")
2834:              nil
2835:              '(:yes-no-cancel :question :button1))
2836:           (:yes (delete-window))
2837:           (:no
2838:            (message-box
2839:             (concat
2840:              "この窓に表示する別のバッファを、次に表示する¥n"
2841:              "「バッファ選択」メニューから選択してください。"))
2842:            (select-buffer))
2843:           (t nil)
2844:           )
2845:         (call-process (concat (si:system-root) "xyzzycli.exe"))
2846:         )
2847:     ;(call-interactively 'kill-buffer)
2848:     (delete-buffer (selected-buffer))
2849:     )
2850:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

139 my-kill-rectangle

矩形リージョンを切り取り (kill-rectangle) を実行して、つぎに、Shift + F9 を押せというメッセージを表示します。

2851: (defun my-kill-rectangle ()
2852:   (interactive)
2853:   (call-interactively 'kill-rectangle)
2854:   (refresh-screen)
2855:   (message-box 
2856:     "Shift + F9 で切り取った矩形領域を「貼付け」できます。")
2857:   (call-process (concat (si:system-root) "xyzzycli.exe"))
2858:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

140 my-kill-word

カーソル位置から始まる一連の空白文字と続く空白文字列を削除します。

2859: (defun my-kill-word ()
2860:   (interactive)
2861:   (let (sp ep)
2862:     (setq sp (point))
2863:     (re-search-forward "[ ¥t¥n]")
2864:     (setq ep (point))
2865:     (while (looking-at "[ ¥t]")
2866:       (forward-char 1)
2867:       (setq ep (+ ep 1)))
2868:     (delete-region sp ep)
2869:     )
2870:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

141 my-match-paren -- 対応する括弧にジャンプ 

2871: (defun my-match-paren (&optional arg)
2872:  "Go to the matching parenthesis if on parenthesis otherwise insert %."
2873:  (interactive "p")
2874:   (setq *temp-mode* buffer-mode)
2875:   (lisp-mode)
2876:   (cond 
2877:    ((looking-at "[([{]") (forward-sexp 1) (backward-char))
2878:    ((looking-at "[])}]") (forward-char) (backward-sexp 1))
2879:    (t (self-insert-command (or arg 1))))
2880:   (funcall *temp-mode*)
2881:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

142 my-message-box

message-box を呼んだ後に、xyzzy の窓をアクティブにするようにします。

引数が一つしかない message-box の呼び出しの代わりに my-message-box を呼ぶといいでしょう。

message-box は複数の引数を受け付けるのに対して、この my-message-box は、引数が一つなので、すべての message-box に対応することはできません。

message-box を呼び出した後で、xyzzy の窓がアクティブにならなくて困ったときは、そのコードを調べて、

(call-process (concat (si:system-root) "xyzzycli.exe"))

を付加するとよいでしょう。

(my-message-box "foo")

2882: (defun my-message-box (str)
2883:   (interactive)
2884:   (message-box str)
2885:   (call-process (concat (si:system-root) "xyzzycli.exe"))
2886:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

143 my-open-directory-where-buffer-file-be

/*
 (Net "http://www2.ocn.ne.jp/~cheerful/script/xyzzy/library/buffer.html#cb_ex_close")
*/

2887: (defun my-open-directory-where-buffer-file-be (&optional buffer-name)
2888:   (interactive)
2889:   (let (b-f-name d-name)
2890:     (if buffer-name
2891:         (and
2892:          (setq b-f-name (get-buffer-file-name buffer-name))
2893:          (setq d-name (directory-namestring b-f-name)))
2894:       (setq d-name 
2895:             (read-directory-name "open direcory: " 
2896:                  &key (get-buffer-file-name ))))
2897:     (shell-execute d-name)
2898:   )
2899: )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

144 my-open-directory-where-current-buffer-file-be

現在編集中のバッファに対応するファイルがあるディレクトリを開きます。

 (fdefun "explorer")
 (fdefun "explorer" "sitelisp.lnk" "kh-base.l")

と同じ。

2900: (defun my-open-directory-where-current-buffer-file-be ()
2901:   (interactive)
2902:   (my-open-directory-where-buffer-file-be 
2903:    (buffer-name (selected-buffer))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

145 my-open-rectangle

矩形リージョンに空白を挿入 (open-rectangle) を実行します。

2904: (defun my-open-rectangle ()
2905:   (interactive)
2906:   (call-interactively 'open-rectangle)
2907:   (refresh-screen)
2908:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

146 my-set-height

現在カーソルがある窓の高さをスクリーンの高さの num/10 にします。num には、1から9の数字を入れてください。窓が二つ以上あることを前提にしています。

2909: (defun my-set-height (num)
2910:   (interactive "Nwindow height (1--9): ")
2911:   (let ((h 0))
2912:      (if (< (window-height) 
2913:             (- (screen-height) 4)
2914:             )
2915:          (progn
2916:            (setq h (floor (/ (* (- (screen-height) 4) num) 10)))
2917:            (enlarge-window (- h (window-height))))
2918:        (progn
2919:          (setq h (floor (/ (* (window-height) num) 10)))
2920:          (split-window h nil)))
2921:     )
2922:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

147 my-split-window

my-split-windowは現在の窓を上下二つに分割します。上の窓の高さを元の高さの num/10 にします。num には、1から9の数字を入れてください。カーソルは上の窓に置かれます。 num に、負の数を指定すると、カーソルは、下の窓に置かれます。例. (my-split-window -3) とすると、上下の窓の高さが 7 対 3 になるように分割し、分割後、カーソルは下側の窓に置かれます。

2923: (defun my-split-window (num)
2924:   (interactive "Nwindow height (1--9): ")
2925:   (let ((h 0))
2926:     (setq h (floor (/ (* (window-height) num) 10)))
2927:     (split-window h nil)))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

148 my-switch-window-horizontally

上下の窓を入れ替えます。

outline-mode にある窓が下に来たときなど上下の窓の配置を変えたくなったときに呼び出します。上の窓にカーソルを置いて、この関数を実行してください。

2928: (defun my-switch-window-horizontally ()
2929:   "switch window"
2930:   (interactive)
2931:   (let (upw)
2932:     (if (< (window-height) (- (screen-height) 6))
2933:         ;; 窓の高さがスクリーン一杯ではない、すなわち
2934:         ;; 窓が分割されていると確認した
2935:         (progn
2936:           ; upw は分割された窓の上端の上から数えた行数
2937:           ; upw > 0 なら下の窓
2938:           (setq upw (nth 1 (window-coordinate)))
2939:           (if (> upw 0)
2940:               (other-window -1))
2941:           (delete-window)
2942:           (split-window)
2943:           (switch-to-buffer-other-window (other-buffer))
2944:           (if (> upw 0)
2945:               (other-window -1))
2946:           )
2947:       (my-message-box "not splitted horizontally.")
2948:       )
2949:     )
2950:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

149 my-switch-window-vertically

左右の窓を入れ替えます。

2951: (defun my-switch-window-vertically ()
2952:   (interactive)
2953:   (let (lc)
2954:     (if (< (window-width) (- (screen-width) 4))
2955:         (progn
2956:           (setq lc (nth 0 (window-coordinate)))
2957:           (if (> lc 0)
2958:               (other-window -1))
2959:           (delete-window)
2960:           (split-window-vertically)
2961:           (switch-to-buffer-other-window (other-buffer))
2962:           (if (> lc 0)
2963:               (other-window -1))
2964:           )
2965:       (progn
2966:         (my-message-box "not splitted vertically.")
2967:         )
2968:       )
2969:     )
2970:   )
2971: 
2972: ;(message-box "2910")

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

150 my-split-window-vertically

窓を左右に二つの窓に分割して、左側の窓にカーソルを置きます。

  1. この関数が呼ばれたときに、すでに窓が分割されていたときは、カーソルを左窓に移します。
  2. そうでない場合は、窓を左右に分割します。右の窓に置くバッファを選択させます。

2973: (defun my-split-window-vertically ()
2974:   (interactive)
2975:   (if (< (window-height) (- (screen-height) 6))
2976:       ;; 窓の高さがスクリーン一杯でない。すなわち、
2977:       ;; 窓が上下に分かれている。
2978:       (progn
2979:         (enlarge-window 1)
2980:         (delete-window)))
2981:   (if (< (window-width) (- (screen-width) 4))
2982:       ;; 窓が既に左右に分割されている。もし右窓にいるなら、左窓
2983:       ;; に移動する。
2984:       (if (not (in-left-window-p))
2985:           (other-window -1))
2986:     (split-window-vertically))
2987:   
2988:   ; カーソルを右の窓に移動します。
2989:   (other-window 1)
2990:   (refresh-screen)
2991:   (my-message-box "select buffer to be shown in the right window")
2992:   (call-interactively 'select-buffer)
2993:   (message " ")
2994:   (other-window -1)
2995:   (refresh-screen))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

151 my-same-buffer-in-other-window -- 同じバッファを反対の窓で表示

同じバッファを反対側のの窓で表示する。カーソルは反対側の窓に移ります。

2996: (defun my-same-buffer-in-other-window ()
2997:   (interactive)
2998:   (let (buf)
2999:     (if (or (in-upper-window-p) (in-left-window-p))
3000:         (progn
3001:           (setq buf (selected-buffer))
3002:           (other-window 1)
3003:           (switch-to-buffer buf))
3004:       (progn
3005:         (setq buf (selected-buffer))
3006:         (other-window -1)
3007:         (switch-to-buffer buf))
3008:       )
3009:     )
3010:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

152 mysearch-forward-in-line

現在カーソルのある位置から行末までの範囲で string に格納された文字列を探し、カーソルを発見した文字列の先頭に移動します。

そのような文字列を発見できなかったときは、nil を返します。

利用例

 (defun foo ()
   (interactive)
   (if (not (mysearch-forward-in-line "@begin{"))
       (my-message-box "not found."))
   )

3011: (defun mysearch-forward-in-line (string)
3012:   (interactive "sSearch string: ")
3013:   (let (cpos endpos foundp)
3014:     (setq cpos (point))
3015:     (end-of-line)
3016:     (setq endpos (point))
3017:     (save-restriction
3018:       (narrow-to-region cpos endpos)
3019:       (goto-char (point-min))
3020:       (setq foundp (search-forward string t))
3021:       )
3022:     (return-from mysearch-forward-in-line foundp)
3023:     )
3024:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

153 myre-search-forward-in-line

現在カーソルのある位置から行末までの範囲で string に格納された正規表現文字列を探し、カーソルを発見した文字列の先頭に移動します。

そのような文字列を発見できなかったときは、nil を返します。

利用例

 /*
 (defun foo ()
   (interactive)
   (if (not (myre-search-forward-in-line "@begin{"))
       (my-message-box "myre-search-forward-in-line: not found.")
      (goto-char (match-end 0))
   ))
 */

3025: (defun myre-search-forward-in-line (string)
3026:   (interactive "sRegular search string: ")
3027:   (let (cpos endpos foundp)
3028:     (setq cpos (point))
3029:     (end-of-line)
3030:     (setq endpos (point))
3031:     (save-restriction
3032:       (narrow-to-region cpos endpos)
3033:       (goto-char (point-min))
3034:       (setq foundp (re-search-forward string t))
3035:       )
3036:     (return-from myre-search-forward-in-line foundp)
3037:     )
3038:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

154 myre-search-backward-in-line -- カーソル位置より前で行内検索

現在カーソルのある位置から行頭までの範囲で string に格納された正規表現文字列を探し、カーソルを発見した文字列の先頭に移動します。

そのような文字列を発見できなかったときは、nil を返します。

利用例

 行末に一旦移動し、その行の後ろから初めて見つかる右括弧 ) 
 の後ろにカーソルを移動します。

/*
(defun foo ()
  (interactive)
  (if (not (myre-search-forward-in-line "¥)"))
      (my-message-box "myre-search-backward-in-line: not found.")
     (goto-char (match-end 0))
  ))
*/

 */ の後ろにカーソルを置いて、C-c C-s とします。

3039: (defun myre-search-backward-in-line (string)
3040:   (interactive "sRegular search string: ")
3041:   (let (cpos beginningpos foundp)
3042:     (setq cpos (point))
3043:     (beginning-of-line)
3044:     (setq beginningpos (point))
3045:     (save-restriction
3046:       (narrow-to-region beginningpos cpos)
3047:       (goto-char (point-max))
3048:       (setq foundp (re-search-backward string t))
3049:       )
3050:     (return-from myre-search-backward-in-line foundp)
3051:     )
3052:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

155 mycombine-lines

範囲を指定して、指定した範囲内の改行コードを削除します。

3053: (defun mycombine-lines ()
3054:   (interactive)
3055:   (let (startmarker endmarker cpos)
3056:     (setq startmarker (make-marker))
3057:     (setq endmarker (make-marker))
3058:     (set-marker startmarker (mark))
3059:     (set-marker endmarker (point))
3060:     (goto-char (marker-point startmarker))
3061:     (end-of-line)
3062:     (setq cpos (point))
3063:     (while (< cpos (marker-point endmarker))
3064:       (progn
3065:         (delete-char 1)
3066:         (delete-trailing-spaces)
3067:         (end-of-line)
3068:         (setq cpos (point)))
3069:       )
3070:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

156 mycombine

mycombine-lines は、範囲を指定しないといけないので、もっと簡便に使えるように、つぎの空白行を探して、そこを範囲の最後に指定したい。

この関数が呼ばれた時点で、行頭の非空白文字にカーソルを移動して、そこにマークを設定し、その後に最初に発見される空白行にカーソルを移動し、その前の行の行末にカーソルを移動してから、 mycombine-lines を呼び出します。

3071: (defun mycombine ()
3072:   (interactive)
3073:   (back-to-indentation)
3074:   (set-mark-command)
3075:   (re-search-forward "^[ ¥t]*$")
3076:   (beginning-of-line)
3077:   (forward-char -1)
3078:   (mycombine-lines)
3079:   (forward-char 1)
3080:   ;
3081:   (re-search-forward "^[ ¥t]*$")
3082:   (next-line 1)
3083:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

157 moveto-nextline

現在のカーソル以降にある文字列を次の行の空白文字列の直後に移動し、カーソルをその行の最初の非空白文字列の前に位置づけます。

3084: (defun moveto-nextline ()
3085:   (interactive)
3086:   (let (cpos)
3087:     (kill-line)
3088:     (next-line)
3089:     (beginning-of-line)
3090:     (if (looking-at " ")
3091:         (progn
3092:           (skip-chars-forward " ")
3093:           (skip-chars-forward myskipchars)
3094:           (setq cpos (point))
3095:           (yank)
3096:           (goto-char cpos))
3097:       (progn
3098:         (yank)
3099:         (insert "¥n")))
3100:     ); end of let
3101:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

158 my-get-file-buffer

(my-get-file-buffer fullpathfilename)

は、フルパスで与えたファイル名 fullpathfilename に対して、そのファイルを開いているバッファを返します。fullpathfilename を開いているバッファが無ければ nil を返します。

[2016-08-20]
get-file-buffer が同じ機能を持っているはずですが、get-file-buffer はうまく動作しません。

3102: (defun my-get-file-buffer (filename)
3103:   "引数のファイルを編集しているバッファを返す"
3104:   (interactive "f")
3105:   (let (buf 
3106:         (originalbuf (selected-buffer))
3107:         (lst (find-name-buffer (file-namestring filename)))
3108:         (found nil))
3109:     (setq filename 
3110:           (substitute-string 
3111:            (expand-file-name filename) "c:" "C:"))
3112:     (while (and lst (not found))
3113:       (setq buf (car lst))
3114:       (switch-to-buffer buf)
3115:       (setq lst (cdr lst))
3116:       (if (equal filename 
3117:                  (substitute-string (expand-file-name (get-buffer-file-name)) "c:" "C:"))
3118:           (progn
3119:             (setq found t))
3120:         ))
3121:     (switch-to-buffer originalbuf)
3122:     (if (not found) (setq buf nil))
3123:         buf))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

159 newlineafterkuten

範囲を指定して実行します。範囲内の句点の後に、改行を挿入します。

例えば、次のような文章

基本編 では、クラスの定義とインラインメンバ関数をヘッダファイルに、その他のメンバ関数をソースファイルに記述する事について書いた。応用編では更にヘッダファイルを細かく分割していく。クラス y の参照を引数として受け取るメンバ関数 f を持つクラス x について考える。

を範囲に指定して、M-x newlineafterkuten とすると、つぎように整形されます。

基本編 では、クラスの定義とインラインメンバ関数をヘッダファイルに、その他のメンバ関数をソースファイルに記述する事について書いた。
応用編では更にヘッダファイルを細かく分割していく。
クラス y の参照を引数として受け取るメンバ関数 f を持つクラス x について考える。 

3124: (defun newlineafterkuten ()
3125:   "句点の後に改行コードを挿入します。"
3126:   (interactive)
3127:   (filter-region 
3128:     "sed.exe -f C:/scriptfile/newlineAfterKuten.sed"
3129:    (region-beginning) (region-end))
3130: )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

160 open-folder

フォルダをミニバッファからあるいは引数で指定して、2画面ファイラーを指定したフォルダに移動します。

3131: (defun open-folder (directory)
3132:   (interactive "DFolder: ")
3133:   (open-filer)
3134:   (filer-activate-toplevel)
3135:   (filer-chdir directory)
3136:   (open-filer))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

161 open-this-folder

２画面ファイラーを、バッファに書いてあるフォルダに移動する。

  c:/home/me

のようにフォルダの名前ががバッファに書いてあるときに、フォルダを表している文字列の先頭にカーソルを置いて、

  M-x open-this-folder 

とします。

3137: (defun open-this-folder ()
3138:   (interactive)
3139:   (let (url beg end)
3140:     (setq beg (point))
3141:     (re-search-forward "[ ¥t¥n¥"]" nil)
3142:     (setq end (point))
3143:     (goto-char beg)
3144:     (setq url (buffer-substring beg end))
3145:     (open-folder url)
3146:     )
3147:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

162 polite

[2018-03-01] 範囲指定して、M-x polite とすると、語尾を丁寧にします。

C:/scriptfile/polite.sed

3148: (defun polite ()
3149:   (interactive)
3150:   (filter-region 
3151:    ; (concat "sed.exe -f "
3152:    ;        (scrf "polite" ".sed"))
3153:    "sed.exe -f C:/scriptfile/polite.sed"
3154:    (region-beginning) (region-end))
3155:   (forward-line 1)
3156: )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

163 powershell-in-other-window 

3157: (defun powershell-in-other-window ()
3158:    (interactive)
3159:    (let (uwl)
3160:      (refresh-screen)
3161:      (if (< (window-height) (- (screen-height) 6))
3162:          ; 窓の高さがスクリーン一杯でない。
3163:          (progn
3164:            ; (message-box "The window is splitted horizontally.")
3165:            (setq uwl (nth 1 (window-coordinate)))
3166:            ; uwl は窓の左上角のy座標。上端が0。
3167:            (if (> uwl 0)
3168:                (progn
3169:                  ; (message-box "上側の窓ではない")
3170:                  (call-interactively 'powershell)
3171:                  )
3172:              (progn
3173:                ; (message-box "上側の窓です。")
3174:                (other-window)
3175:                (call-interactively 'powershell)
3176:                )
3177:              )
3178:            )
3179:        (progn
3180:          (while (> (get-window-line) 0)
3181:            (previous-virtual-line))
3182:          (refresh-screen)
3183:          (split-window)
3184:          (other-window)
3185:          (call-interactively 'powershell)
3186:          (refresh-screen)
3187:          ))
3188:      (set-third-height)
3189:      )
3190:    )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

164 prepare-other-window

現在の窓とは別の窓を用意し、そこに現在のバッファを表示します。

窓が2列に分かれているときは、反対側の窓に移動します。窓が単列なら、その列は、窓を一つにし、上下に窓を分割し、下側の窓に移動します。

3191: (defun prepare-other-window ()
3192:   (interactive)
3193:   (let (buffer)
3194:     (setq buffer (selected-buffer))
3195:     (refresh-screen)
3196:     (if (vsplitted-p)
3197:         (progn
3198:           (if (= (nth 0 (window-coordinate)) 0)
3199:             ; 左側の窓に居たので、右の窓に移動したい
3200:             (while (= (nth 0 (window-coordinate)) 0)
3201:               (other-window))
3202:           ; 右側の窓にいたので左の窓に移動したい
3203:             (while (> (nth 0 (window-coordinate)) 0)
3204:               (move-previous-window))
3205:             )
3206:           (switch-to-buffer buffer)
3207:           )
3208:       (progn
3209:         (my-delete-other-window)
3210:         (refresh-screen)
3211:         (my-split-window -5)
3212:         (refresh-screen)))
3213:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

165 print-selected-region-dialog

指定したリージョンを一時的なバッファ *foo* に挿入して、それを印刷するダイアログを表示します。

将来の改良
*print-region* がすでにあるときの処理を考える必要があります。

3214: (defun print-selected-region-dialog (from to)
3215:   (interactive "r")
3216:   (copy-region-as-kill from to)
3217:   (switch-to-buffer "*print-region*")
3218:   (yank)
3219:   (display-buffer (get-buffer-create "*print-region*"))
3220:   (print-selected-buffer-dialog))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

166 restore-mode -- mode を *temp-mode* に戻す

現在編集中のバッファの mode を *temp-mode* に戻します。

3221: (defun restore-mode ()
3222:   (interactive)
3223:   (if *temp-mode*
3224:       (funcall *temp-mode*)))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

167 rd4

現在編集中のファイルを html ファイルにして表示します。

3225: (defun rd4 ()
3226:   (interactive)
3227:   (let (filename)
3228:     (setq filename 
3229:           (map-slash-to-backslash (get-buffer-file-name)))
3230:     (execute-shell-command (concat "rd4.bat " filename))
3231:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

168 run-explorer

引数にディレクトリをユニックス形式またはWindows形式で指定して、そのディレクトリをexplorer で開きます。
[2017-02-22] 第一引数に拡張子が .lnk のファイルを指定できるようにしました。dirlink ディレクトリにある、拡張子が .lnk のファイルを指定する場合は、ディクトリ名を省略できます。

例: (run-explorer "dropboxdata.lnk" "CommonDotfiles")

[2015-02-07] 少し変更します。元のままだと、すでに Explorer が起動されているときでも、新しく

3232: (defun run-explorer (arg &rest z)
3233:   (interactive)
3234:   (if (string= arg "")
3235:       (return-from run-explorer))
3236:   (let (dir extension)
3237:     (setq dir arg)
3238:     (if (not
3239:          (string=
3240:           (concat (directory-namestring dir)
3241:                   (file-namestring dir))
3242:           dir))
3243:         (if (string= (pathname-type dir) "lnk")
3244:             (progn
3245:               (setq dir (concat "C:/dirlink/" dir))
3246:               (if (not (file-exist-p dir))
3247:                   (progn
3248:                     (my-message-box 
3249:                      (concat dir " は存在しません。")
3250:                      "Folder"
3251:                      )
3252:                     (return-from run-explorer)))
3253:               (setq dir (resolve-shortcut dir))
3254:               )
3255:           )
3256:       )
3257:     
3258:     (if z
3259:         (setq dir
3260:               (merge-pathnames 
3261:                (apply #'concat z) dir)))
3262: 
3263:     (setq extension (pathname-type dir))
3264:     (if (string= extension "lnk")
3265:         (progn
3266:           (setq dir (resolve-shortcut dir))
3267:           (setq extension (pathname-type dir))))
3268:     (if (file-directory-p dir)
3269:         (shell-execute (expand-file-name dir) t)
3270:       (progn 
3271:         (my-message-box (concat dir " is not a directory."))))
3272:     )
3273:   )
3274: ;; (run-explorer "c:/home/me")
3275: ;; (run-explorer "dropboxdata.lnk" "CommonDotfiles")

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

169 right-justify

カーソル位置から右側の文字列を右詰します。

3276: (defun right-justify ()
3277:   (interactive)
3278:   (let (n np)
3279:     (setq np (point))
3280:     (end-of-line)
3281:     (setq n (- fill-column (current-column)))
3282:     (goto-char np)
3283:     (while (> n 0)
3284:       (insert " ")
3285:       (setq n (- n 1)))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

170 recordXyzzyRunDate

今日の日付を 「xyzzy を起動した日付を書いたファイル」に書き込みます。「xyzzy を起動した日付を書いたファイル」のファイル名については、下記のコードの fname を参照してください。

 (File "~/homefiles/xyzzyRundateOf.ini")

C-c C-s でファイルの内容が表示されます。

~/homefiles の下にあるファイルは、Dropbox にあるので、cbar が使用しているマシンではどのマシンでも同一のファイルです。

3286: (defun recordXyzzyRunDate ()
3287:   (interactive)
3288:   (let (fo date fname today)
3289:     (setq fname 
3290:           (concat 
3291:            "~/homefiles/xyzzyRundateOf.ini"))
3292:     (with-open-file (fo fname :direction :output)
3293:       (format fo "~A¥n" (format-date-string "%Y-%m-%d"))
3294:       )
3295:     )
3296:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

171 repthisfile

パス名が格納された引数を1個取り、(repthisfile pathname) のような形で使用します。

(repthisfile pathname) は、引数の pathname の中に、 kh-base.l、kh-base、@DIRNAME@ があったら、現在のバッファのファイル名の basename、directory に置き換えます。

現在のバッファのファイル名が c:/home/me/foo.bar.txt なら、 basename は、foo.bar.txt directory は、c:/home/me です。

 (message-box (repthisfile "C:/Users/shiiba/Dropbox/DropboxData/saloon/openpage/xyzzylisp/kh-base.l.foo.txt"))
 (message-box (repthisfile "C:/Users/shiiba/Dropbox/DropboxData/saloon/openpage/xyzzylisp¥kh-base.l.foo.txt"))
 (message-box (repthisfile "C:/Users/shiiba/Dropbox/DropboxData/saloon/openpage/xyzzylisp¥kh-base.foo.txt"))

パス名を unix 形式で返します。引数は、unix 形式でも windows 形式でも構いません。この関数の中で、unix 形式に変換して使用します。

3297: (defun repthisfile (pathname)
3298:   (let (bfname basename basepart dirname newname)
3299:     (setq bfname (get-buffer-file-name))
3300:     ;
3301:     (setq basename (file-namestring bfname))
3302:     (setq basepart (pathname-name basename))
3303:     (setq directory (user::cut-last-char (directory-namestring bfname)))
3304:     ;
3305:     (setq newname (map-backslash-to-slash pathname))
3306:     (setq newname (substitute-string newname "¥@BASENAME¥@" basename))
3307:     (setq newname (substitute-string newname "¥@BASEPART¥@" basepart))
3308:     (setq newname (substitute-string newname "¥@DIRECTORY¥@" directory))
3309:     newname))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

172 readin-file

filename の内容を読み込んで、文字列のリストにして返します。

3310: (defun readin-file (filename)
3311:   (let (lines)
3312:     (with-open-file
3313:       (fi filename :direction :input)
3314:       (while (setq line (read-line fi nil nil nil))
3315:         (if (not lines)
3316:             (setq lines (cons line nil))
3317:           (setq lines (append lines (cons line nil)))
3318:           )
3319:         )
3320:       )
3321:     lines)
3322:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

173 remaining-charlength-to-line-end

; 現在のカーソル位置から行末まで何文字あるかを計算して返しま ; す。漢字があると正しくないかも知れません。

3323: (defun remaining-charlength-to-line-end ()
3324:   (let (cpos endpos num)
3325:     (setq cpos (point))
3326:     (end-of-line)
3327:     (setq endpos (point))
3328:     (goto-char cpos)
3329:     (setq num (- endpos cpos))
3330:     num))
3331: 
3332: ; ; delete-three
3333: ; (defun delete-three ()
3334: ;   (interactive)
3335: ;
3336: ;   (delete-char (min (remain-charlength-to-line-end) 3))
3337: ;   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

174 reset-half-width -- 窓の幅を半幅に戻す。

窓の幅を半幅に戻します。小さくなった方の窓でも、大きくなった方の窓でも、どちらでも、この関数を実行すると、窓幅を同じにします。

窓の幅を 82 桁にするには、M-x enlarge-half-width とします。

3338: (defun reset-half-width ()
3339:   (interactive)
3340:   (enlarge-window 
3341:    (* -1 (- (window-width) (/ (- (screen-width) 10) 2))) t))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

175 set-timer -- 分指定のタイマー

分指定のタイマー

タイマーセット後、他のアプリをアクティブにして作業してると 時間が来ても、MessageBoxが隠れて見えない（Beep音は スピーカー繋げてないので役にたたない）のを対策 API使うので require必須。

必要ならつぎのコードをつける。

  (require "wip/winapi")

3342: (export '(set-timer))
3343: 
3344: (defun set-timer (cnt)
3345:   (interactive "n待ち時間は(分)?:" )
3346:   (start-timer (* cnt 60)
3347:     #'(lambda ()
3348:           (winapi:ShowWindow (get-window-handle) 6)  ; SW_MINIMIZE(最小化)
3349:           (winapi:ShowWindow (get-window-handle) 9)  ; SW_RESTORE(元に戻す)
3350:           (my-message-box (format nil "~D分たったよ！" cnt) "xyzzyタイマー" '(:exclamation) )
3351:        ) t)
3352: 
3353:   (message (format nil "~D 分タイマーセットしたよ!" cnt))
3354: )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

176 set-half-height

現在カーソルがある窓の高さを全体の半分にします。窓が一つのときは最初に窓を2分割します。

3355: (defun set-half-height ()
3356:   (interactive)
3357:   (let ((h 0))
3358:     (if (>= (window-height) (- (screen-height) 6))
3359:         (progn
3360:           (split-window)
3361:           (refresh-screen)
3362:           ))
3363:     (setq h (floor (/ (- (screen-height) 5) 2)))
3364:     (enlarge-window (- h (window-height)))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

177 set-third-height 

3365: (defun set-third-height ()
3366:   (interactive)
3367:   (let ((h 0))
3368:     (if (>= (window-height) (- (screen-height) 6))
3369:         (progn
3370:           (split-window)
3371:           (refresh-screen)
3372:           ))
3373:     (setq h (floor (/ (- (screen-height) 5) 3)))
3374:     (enlarge-window (- h (window-height)))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

178 set-twothird-height 

3375: (defun set-twothird-height ()
3376:   (interactive)
3377:   (let ((h 0))
3378:     (if (>= (window-height) (- (screen-height) 6))
3379:         (progn
3380:           (split-window)
3381:           (refresh-screen)
3382:           ))
3383:     (setq h (floor (/ (* (- (screen-height) 5) 2) 3)))
3384:     (enlarge-window (- h (window-height)))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

179 set-quarter-height 

3385: (defun set-quarter-height ()
3386:   (interactive)
3387:   (let ((h 0))
3388:     (if (>= (window-height) (- (screen-height) 6))
3389:         (progn
3390:           (split-window)
3391:           (refresh-screen)
3392:           ))
3393:     (setq h (floor (/ (- (screen-height) 5) 4)))
3394:     (enlarge-window (- h (window-height)))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

180 sitelisp -- site-lisp の下のファイルを編集 

3395: (defun sitelisp ()
3396:   (interactive)
3397:   (let (fname)
3398:     (setq fname 
3399:        (read-file-name 
3400:         "filename: "
3401:         :default (concat (si::system-root) "site-lisp/")))
3402:     ; (leave-howm-frame)
3403:     (find-file fname))
3404: )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

181 sline, sfill -- 行末まで半角空白を埋める

行末に移動して、fill-column まで半角空白を埋めます。

  (global-set-key '(#¥C-c #¥l #¥s) 'sline)
  (global-set-key '(#¥C-c #¥k #¥s #¥l) 'sline)

3405: (defun sline ()
3406:   (interactive)
3407:   (char-line " "))
3408: 
3409: (defun sfill ()
3410:   (interactive)
3411:   (char-line " "))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

182 start -- ファイル名文字列の先頭にカーソルを置いて start

ファイル名が書かれている文字列の先頭にカーソルを置いて start を実行します。

3412: (defun start ()
3413:   (interactive)
3414:   (let (beg end fname)
3415:     (save-excursion
3416:       (if (looking-at "¥"")
3417:           (setq fname (get-quoted-string))
3418:         (progn
3419:           (setq beg (point))
3420:           (re-search-forward "[ ¥t¥n¥"]" nil)
3421:           (setq end (point))
3422:           (setq fname (buffer-substring beg end))))
3423:       )
3424:     
3425:     (Start fname)
3426:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

183 save-mode -- 現在編集中の mode を*temp-mode*に記憶

現在編集中の mode を *temp-mode* に記憶し、一時的に text-mode にします。

reset-mode で元のモードに戻します。

3427: (defun save-mode ()
3428:   (interactive)
3429:   (setq *temp-mode* buffer-mode)
3430:   (text-mode)
3431:   (set-fill-column 60)
3432:   (auto-fill-mode 1)
3433:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

184 scratch-in-other-window -- 下の窓に*scratch*を表示

 (sfind "scratch-in-other-window" "sitelisp.lnk" "kh-base.l")

下の窓に *scratch* を表示します。窓は上下方向に2分割以下であるという前提で書かれています。つまり、窓はまだ上下に分割されていないか、または上下に2分割されているとします。上下に分割されていない場合は、下側に窓が取られて、そこに *scratch* が表示されます。

+---------------------+    +---------------------+
|                     |    |          A          |
|          A          |    +---------------------+
|                     |    |      *scratch*      |
+---------------------+    +---------------------+

上下に分割されている場合、カーソルは、上の窓と下の窓のいずれにあっても構いませんが、この関数による窓の操作の後、上の窓はそのまま残され、下の窓に、*scratch* が表示されることになります。

+--------------------+     +---------------------+
|         A          |     |          A          |
+--------------------+     +---------------------+
|         B          |     |      *scratch*      |
+--------------------+     +---------------------+


3434: (defun scratch-in-other-window ()
3435:   (interactive)
3436:   (let (uwl)
3437:     (if (< (window-height) (- (screen-height) 6))
3438:         ; 窓の高さがスクリーン一杯でない。
3439:         (progn
3440:           ; (message-box "The window is splitted horizontally.")
3441:           (setq uwl (nth 1 (window-coordinate)))
3442:           (if (> uwl 0)
3443:               (progn
3444:                 ; (message-box "上側の窓ではない")
3445:                 (switch-to-buffer "*scratch*")
3446:                 (other-window -1)
3447:                 )
3448:             (progn
3449:               ; (message-box "上側の窓です。")
3450:               (other-window)
3451:               (switch-to-buffer "*scratch*")
3452:               (other-window -1)
3453:               )
3454:             )
3455:           )
3456:       (progn
3457:         (while (> (get-window-line) 0)
3458:           (previous-virtual-line))
3459:         (beginning-of-line)
3460:         (refresh-screen)
3461:         (split-window)
3462:         (other-window)
3463:         (switch-to-buffer "*scratch*")
3464:         (other-window -1)
3465:         (refresh-screen)))
3466:     (set-twothird-height)
3467:     )
3468:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

185 shell-in-other-window

shell-in-other-window は、
  (File "sitelisp.lnk" "kh-base.l"))

で定義されています。

shell-in-other-window は下の窓に shell バッファを用意します。

下の窓に shellバッファ を表示します。窓は上下方向に2分割以下であるという前提で書かれています。つまり、窓はまだ上下に分割されていないか、または上下に2分割されているとします。上下に分割されていない場合は、下側に窓が取られて、そこに shellバッファ が表示されます。

+---------------------+    +---------------------+
|                     |    |          A          |
|          A          |    +---------------------+
|                     |    |        shell        |
+---------------------+    +---------------------+

上下に分割されている場合、カーソルは、上の窓と下の窓のいずれにあっても構いませんが、この関数による窓の操作の後、上の窓はそのまま残され、下の窓には、shell が表示されることになります。

+--------------------+     +---------------------+
|         A          |     |          A          |
+--------------------+     +---------------------+
|         B          |     |        shell        |
+--------------------+     +---------------------+

標準ではつぎのようになっています。

  set prompt=$p$g

つぎのようにすると、短くなります。

  set prompt=$g

3469: (defun shell-in-other-window ()
3470:   (interactive)
3471:   (let (uwl)
3472:     (if (< (window-height) (- (screen-height) 6))
3473:         ; 窓の高さがスクリーン一杯でない。
3474:         (progn
3475:           ; (message-box "The window is splitted horizontally.")
3476:           (setq uwl (nth 1 (window-coordinate)))
3477:           ; uwl は窓の左上角のy座標。上端が0。
3478:           (if (> uwl 0)
3479:               (progn
3480:                 (call-interactively 'shell)
3481:                 )
3482:             (progn
3483:               (other-window)
3484:               (call-interactively 'shell)
3485:               )
3486:             )
3487:           )
3488:       (progn
3489:         (refresh-screen)
3490:         (while (> (get-window-line) 0)
3491:           (previous-virtual-line)
3492:           (refresh-screen)
3493:           )
3494:         (split-window)
3495:         (refresh-screen)
3496:         (other-window)
3497:         (call-interactively 'shell)
3498:         (refresh-screen)
3499:         ))
3500:     ; prompt を変更します。
3501:     (goto-char (point-max))
3502:     (insert (concat "prompt=$G"))
3503:     (ed::shell-send-input)
3504:     (set-third-height)
3505:     )
3506:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

186 sfind

  1. 窓を２分割します。

  2. 下の窓に、指定されたファイルを開いて、指定された語を含む行にカーソルを移動します。

  3. *マークがあり、その後に任意の文字列があって、半角空白が 1個あって、指定された語がある行を探します。

     (re-search-forward (concat "¥*.* " (regexp-quote word)))

    なかったら defun の後を探すようにしたい。

使用例
  (sfind "keyword" "sitelisp.lnk" "kh-fk.l")

発見した後、同じキーワードで再検索したいときは、Esc を押してから、s をタイプします。 fdefun の方がいいかも。

[2016-07-22]
第２引数に、拡張子が .lnk の名前を指定することができるようにしました。

[2014-04-04]
窓が左右に分割されているときは、反対側の窓に表示するように変更しました。

[2014-07-21]
窓が左右に分割されているとき、反対側の窓に表示しないようにしました。

[2014-07-23]
引数を１つしか指定しなかった場合は、現在編集中のファイルから探すように変更しました。ただし、第2引数を省略した lisp 式を評価するときは、 M-x eval-in-other-window (C-c C-s) は使用できません。 M-x my-eval-lase-sexp (C-c C-e) を使用してください。

  (sfind "sline")
  (sfind "sfind")

C-c C-s とタイプすれば、反対側の窓に表示されます。

3507: (defun sfind (word &rest arg)
3508:   "第一引数で指定する語句を第二引き数以下で指定するファイルから探す"
3509:   (interactive)
3510:   ;
3511:   (let (fname buffer win)
3512:     
3513:     (if arg
3514:         (progn
3515:           (setq fname (car arg))
3516:           (setq arg (cdr arg))
3517:           (if (not
3518:                (string= 
3519:                 (concat (directory-namestring fname)
3520:                         (file-namestring fname))
3521:                 fname))
3522:               (if (not (string-match "^¥¥(¥.¥¥|¥.¥.¥¥)/" fname))
3523:                   (setq fname 
3524:                         (concat "C:/dirlink/" fname)))
3525:             )
3526:           ; (message-box fname)
3527:           (if (string= (pathname-type fname) "lnk")
3528:               (setq fname (resolve-shortcut fname))
3529:             )
3530:           
3531:           (if arg
3532:               (setq fname
3533:                     (merge-pathnames 
3534:                      (apply #'concat arg) fname)))
3535:                                      
3536:           ; (message-box fname)
3537:           )
3538:       (setq fname (get-buffer-file-name (selected-buffer)))
3539:       )
3540:     
3541:     ;
3542:     (refresh-screen)
3543:     (if (not (boundp *sameside*))
3544:         (setq *sameside* t))
3545:     (if *sameside*
3546:       (progn
3547:         (my-delete-other-window)
3548:         (refresh-screen)
3549:         (my-split-window -5)
3550:         (refresh-screen))
3551:       )
3552:         
3553:     ; (find-file fname)
3554:     (setq buffer (my-get-file-buffer fname))
3555:     (if buffer
3556:         (progn
3557:           (my-message-box 
3558:            (concat "ファイル¥n¥n  " fname 
3559:                    "¥n¥nは既に開かれていました。"))
3560:           (set-buffer buffer)
3561:           (refresh-screen)
3562:           )
3563:      (find-file fname))
3564:     
3565: ;    (file fname)
3566:     (goto-char (point-min))
3567:     (re-search-forward (concat "¥*.* " (regexp-quote word)))
3568:     (setf *kill-ring* (cons (list (concat word)) *kill-ring*))
3569:     (setf ed::*kill-ring-yank-pointer* *kill-ring*)
3570:     (message "type ctrl + s and ctrl + y, if you want to search the word.")
3571:     )
3572:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

187 shell-command-to-string -- 外部コマンドの標準出力への文字

列を取得

http://lisperblog.blogspot.com/2008/10/xyzzy.html

で紹介された関数です。

「cat」は、このファイルの別のところで定義されています。

3573: (defun shell-command-to-string (command)
3574:   "Execute shell command COMMAND and return its output as a string."
3575:   (let ((outfile (make-temp-file-name "xyzzycmd-")))
3576:     (unwind-protect
3577:         (with-output-to-string (stream)
3578:           (call-process command :output outfile
3579:                         :show :minimize :wait t)
3580:           (cat outfile stream))
3581:       (delete-file outfile))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

188 standard-filename-expression

ファイル名の標準的な表記法を返します。

~ は展開します。ドライブレターは大文字に変換します。引数は保存されます。

 (standard-filename-expression "c:/home/me/.xyzzy")
 (standard-filename-expression "~/.xyzzy")

3582: (defun standard-filename-expression (filename)
3583:   (let (driveletter reststring newfilename)
3584:     (setq newfilename (expand-file-name filename))
3585:     (if (string-match "¥¥([a-z]¥¥):" newfilename)
3586:       (progn
3587:         (setq driveletter 
3588:               (string-capitalize (substring newfilename 0 1)))
3589:         (setq reststring 
3590:               (substring newfilename 1))
3591:         (return-from standard-filename-expression
3592:           (concat driveletter reststring)))
3593:     newfilename)
3594:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

189 show-other-buffer

反対の窓のバッファを表示

窓が上下または左右に分割されているという前提で、現在の窓をいったん閉じて、窓を、元の分割方向に、上下または左右に分割します。

これにより、現在の窓に、反対側の窓に表示されているバッファを表示します。

3595: (defun show-other-buffer ()
3596:   (interactive)
3597:   (let (rightp downp)
3598:     (if (vsplitted-p); 左右に分割されているか
3599:       (progn
3600:         (if (> (nth 0 (window-coordinate)) 0)
3601:             (setq rightp t))
3602:         ; 右側の窓なら、rightp が t になった。
3603:         
3604:         (delete-window)
3605:         (split-window-vertically)
3606:         (if rightp
3607:             (other-window))
3608:         )
3609:       (if (hsplitted-p); 上下に分割されているか
3610:           (progn
3611:             (if (> (nth 1 (window-coordinate)) 0)
3612:                 (setq downp t))
3613:             ; 下側の窓なら、downp が t になった。
3614:             
3615:             (delete-window)
3616:             (split-window)
3617:             (if downp
3618:                 (other-window))
3619:             )
3620:         )
3621:       ); if (vsplitted-p)
3622:     ); let
3623:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

190 show-kill-ring

cbar が書きました。毎回 ed::*kill-ring* と書くのが面倒なので。

3624: (defun show-kill-ring ()
3625:   (interactive)
3626:   (describe-variable 'ed::*kill-ring*))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

191 scroll-to-window-top

現在行を窓の再上行にスクロールする

3627: (defun scroll-to-window-top ()
3628:   (interactive)
3629:   (scroll-window (get-window-line))
3630:   (while (> (get-window-line) 0)
3631:        (previous-virtual-line))
3632:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

192 scroll-to-window-bottom

現在行を窓の最下行にスクロールする

3633: (defun scroll-to-window-bottom ()
3634:   (interactive)
3635:   (scroll-window 
3636:    (- (get-window-line) 
3637:       (- (window-height) 1)))
3638:   (while (< (get-window-line) (- (window-height) 1))
3639:     (next-virtual-line))
3640:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

193 show-in-other-window -- 現在の半窓のバッファを反対側の窓で表示

現在の窓で表示されているバッファを、反対側の窓に表示します。現在の窓は閉じます。

 +-------------+-------------+
 |      C      |             |
 +-------------+      B      |
 |      A      |             |
 +-------------+-------------+

A の窓にカーソルがあるときに、show-in-other-window を実行すると、A のバッファに表示していた内容を、右の窓に表示するので、次の図のようになります。

 +-------------+-------------+
 |             |             |
 |      C      |     A       |
 |             |             |
 +-------------+-------------+


3641: (defun show-in-other-window ()
3642:   (interactive)
3643:   (let (cbuf cwin)
3644:     (if (>= (window-height) (- (screen-height) 6))
3645:         (progn
3646:           (my-message-box "窓が上下に分割されていません。")
3647:           (return-from show-in-other-window)))
3648:     (setq cbuf (selected-buffer))
3649:     (setq *lastpos* (point))
3650:     (delete-window)
3651:     (if (= (nth 0 (window-coordinate)) 0)
3652:         ; 左側の窓に居たので、右の窓に移動したい
3653:         (while (= (nth 0 (window-coordinate)) 0)
3654:           (other-window))
3655:       ; 右側の窓にいたので左の窓に移動したい
3656:       (while (> (nth 0 (window-coordinate)) 0)
3657:         (move-previous-window))
3658:       )
3659:     (refresh-screen)
3660:     (switch-to-buffer cbuf)
3661:     (goto-char *lastpos*)
3662:     (refresh-screen)
3663:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

194 show-in-two-windows

現在の窓で表示されているバッファを、2列の窓に表示します。

3664: (defun show-in-two-windows ()
3665:   (interactive)
3666:   (delete-other-windows)
3667:   (split-window-vertically)
3668:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

195 scroll-toline5

現在行を画面の上から5行目に移動します。

3669: (defun scroll-toline5 ()
3670:   (interactive)
3671:   (setq *lastpos* (point))
3672:   (refresh-screen)
3673:   (scroll-to-window-top)
3674:   (refresh-screen)
3675:   (scroll-window -5)
3676:   (refresh-screen)
3677:   (forward-virtual-line 5)
3678:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

196 scroll-page

現在の画面の下から5行目の行が、画面の上から5行目に表示されるようにスクロールします。

3679: (defun scroll-page ()
3680:   (interactive)
3681:   (setq *lastpos* (point))
3682:   (refresh-screen)
3683:   (while (> (get-window-line) 0)
3684:      (previous-virtual-line))
3685:   (refresh-screen)
3686:   (forward-virtual-line (- (window-height) 5))
3687:   (refresh-screen)
3688:   (scroll-to-window-top)
3689:   (refresh-screen)
3690:   (scroll-window -5)
3691:   (refresh-screen)
3692:   (forward-virtual-line 5)
3693:   (setq *lastfunc* 'scroll-page)
3694:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

197 search-clipboard-string

クリップボードに含まれている文字列を検索します。

3695: (defun search-clipboard-string ()
3696:   (interactive)
3697:   (search-forward (get-clipboard-data))
3698:   (end-of-line)
3699:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

198 strrun

引数の文字列を clipboard にコピーして、clipboardtorun を実行します。



3700: (defun strrun (arg)
3701:   (interactive "sEnter a string ")
3702:   (copy-to-clipboard arg)
3703:   (call-process "clipboardtorun.exe")
3704:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

199 todayFirstRunP

 (File "sitelisp.lnk" "xyzzy-start.l")

に、todayFirsttRunP や recordXyzzyRunDateP を使ったコードを書き込みます。

「xyzzy を起動した日付を書いたファイル」を読み込んで、それが今日の日付かどうか調べて、今日初めての起動かどうかを判定する。

「xyzzy を起動した日付を書いたファイル」は、

 (File "~/homefiles/xyzzyRundateOf.ini")

であり、~/homefiles の下にあるファイルは、Dropbox にあるので、cbar が使用しているマシンではどのマシンでも同一のファイルです。

従って、別のマシン BANJYO で、今日既に login したら、KUMANO に login したときには、既に今日 login したものとされます。

今日初めての起動なら t を返す。

「xyzzy を起動した日付を書いたファイル」が存在しなければ、 t を返す。つまり、今日始めての起動とみなします。

(user::todayFirstRunP)

3705: (defun todayFirstRunP ()
3706:   (interactive)
3707:   (let (fp date fname today)
3708:     (setq fname 
3709:           (concat 
3710:            "~/homefiles/xyzzyRundateOf.ini"))
3711:     (if (not (file-exist-p fname))
3712:         (return-from todayFirstRunP t))
3713:     (with-open-file (fp fname)
3714:       (setq date (read-line fp nil nil nil)))
3715:     (not (string= date (format-date-string "%Y-%m-%d")))))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

200 url

  "http://rfri.org"

3716: (defun url ()
3717:   (interactive)
3718:   (let (fname beg end)
3719:     (save-excursion
3720:       (if (looking-at "¥"")
3721:           (setq fname (get-quoted-string))
3722:         (progn
3723:           (setq beg (point))
3724:           (re-search-forward "[ ¥t¥n¥"]" nil)
3725:           (setq end (point))
3726:           (setq fname (buffer-substring beg end))))
3727:       )
3728:     (call-process (concat "mychrome.exe " "¥"" fname "¥""))
3729:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

201 view-register-list-key

http://www2.ocn.ne.jp/~cheerful/script/xyzzy/textEditor/register.html

から複写しました。

3730: (defun view-register-list-key ()
3731:   (interactive)
3732:   (let ((val)(list)(r))
3733: 
3734:     (with-output-to-temp-buffer ("*output*")
3735:    (dotimes (i 255)
3736:     (setq r (code-char i))
3737:     (setq val (ed::get-register r))
3738:     (when  val
3739:         (format t "Register ¥"~a¥" contains " r)
3740:         (cond ((markerp val)
3741:                (let ((buffer (marker-buffer val)))
3742:                  (if (null buffer)
3743:                      (princ "a marker in deleted buffer.")
3744:                    (format t "a buffer position:¥nbuffer ~a, position ~a¥n"
3745:                            (buffer-name buffer) (marker-point val)))))
3746:               ((and (consp val)
3747:                     (eq (car val) 'window-configuration))
3748:                (princ "a window configuration.¥n"))
3749:               ((consp val)
3750:                (format t "the rectangle:¥n~{~a~^¥n~}¥n" val))
3751:               ((stringp val)
3752:                (format t "the text:¥n~a¥n" val))
3753:               (t
3754:                (format t "Garbage:¥n~s¥n" val)))))))
3755:   (set-buffer "*output*")
3756:   (sit-for 4)
3757: )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

202 vsplitted-p -- 左右に分割されているか

左右に分割されているか。下のように分割されているか。

+---------+---------+
|         |         |
|         |         |
|         |         |
+---------+---------+

  (vsplitted-p)
  (sfind "vsplitted-p" "sitelisp.lnk" "kh-base.l")

3758: (defun vsplitted-p ()
3759:   (interactive)
3760:   (refresh-screen)
3761:   (if (< (window-width) (- (screen-width) 4))
3762:       t
3763:     nil))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

203 writeto-file

文字列のリスト lines に格納されているデータを filename に書き出します。filename はファイル名をフルパスで指定します。 filename のファイルが無ければ作られ、あれば上書きされます。

3764: (defun writeto-file (lines filename)
3765:   (let ((wlist lines) line)
3766:     (with-open-file (fo filename :direction :output)
3767:       (while wlist
3768:         (setq line (car wlist))
3769:         (setq wlist (cdr wlist))
3770:         (format fo "~A¥n" line)
3771:         ))
3772:     )
3773:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

204 xactivate

xyzzy.exe の窓をアクティブにします。通常は使う必要はありませんが、message-box を使ってメッセージボックスを表示した後に、xyzzy の窓がアクティブにならないことがあるので、強制的に xyzzy の窓をアクティブにするのに使用します。

3774: (defun xactivate ()
3775:   (call-process (concat (si:system-root) "xyzzycli.exe"))
3776:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

205 yank

再定義したらどうなるのだろう

region.l にあった yank の一部を変更しました。

3777: (in-package "editor")
3778: 
3779:   (defun yank (&optional prefix (arg 0))
3780:     (interactive "*P¥np")
3781:     ; 次の4行を cbar が追加しました。
3782:     (if (eq ed::*kill-ring* nil)
3783:         (progn
3784:           (message "kill-ring is emply")
3785:           (return-from yank)))
3786:     ;
3787:     (if (eq prefix 'universal-argument)
3788:         (ed::yank-insert 0 t)
3789:       (ed::yank-insert arg nil)))
3790: 
3791: (in-package "user")

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

206 zline

行末まで全角長音記号を埋めます。ーーーーーーーーーーーーーー

3792: (defun zline ()
3793:   (interactive)
3794:   (char-line "ー"))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

207 mytagjump

関数の定義位置に jump します。

(mytagjump "fdq")

上の行の関数を評価すると、関数 fdq の定義位置に jump します。

[2018-10-16] 正常に動作しなくなっていましたが、

  ; (find-file (concat *my-sitelisp* "/siteinit.l"))
  (find-file "C:/Users/shiiba/Dropbox/DropboxData/xyzzy/site-lisp/trainning.l")

の変更で動くようになりました。

3795: (defun mytagjump (arg)
3796:   (interactive "sFunction name: ")
3797:   (my-delete-other-window)
3798:   (refresh-screen)
3799:   ; my-split-window は現在の窓を上下二つに分割します。
3800:   ; 引数に -4 を指定しているので、下の窓の高さを元の高さの 
3801:   ; 4/10 にし、カーソルを下の窓に置きます。
3802:   (my-split-window -4)
3803:   (refresh-screen)
3804:   ; (find-file (concat *my-sitelisp* "/siteinit.l"))
3805:   (find-file "C:/Users/shiiba/Dropbox/DropboxData/xyzzy/site-lisp/trainning.l")
3806:   (goto-char (point-max))
3807:   (insert (concat "; " arg "¥n"))
3808:   (backward-char 2)
3809:   (save-buffer)
3810:   (call-interactively 'jump-tag)
3811:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

208 show-current-line

コードの途中で、バッファ行を確認のために表示したい場合に使用します。

3812: (defun show-current-line ()
3813:   (let* (bp ep cp)
3814:     (setq cp (point))
3815:     (beginning-of-line)
3816:     (setq bp (point))
3817:     (end-of-line)
3818:     (setq ep (point))
3819:     (goto-char cp)
3820:     (message-box (buffer-substring bp ep))
3821:     ))

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

209 save-winconf

現在の窓分割の状態をグローバル変数 *winconf* に保存します。

3822: (defun save-winconf ()
3823:   (interactive)
3824:   (setq *winconf* (current-window-configuration))
3825:   )

 

[CTop] [Contents][TopHdngList][Prev][□][Next][SameLvlPrev][Child][SameLvlNext][Parent][Top][End]

210 revert-winconf

グローバル変数 *winconf* に保存しておいた窓分割の状態に戻します。

3826: (defun revert-winconf ()
3827:   (interactive)
3828:   (set-window-configuration *winconf*)
3829:   )

 

カレントディレクトリ以外を参照しています。 at line 6240 (File "scriptfile.lnk" "polite.sed")
Produced by the use of o2h version 13.04.
[CTop] [Top] [Prev] [Body] [BodyStart] .