昔Yahooの記事で、仕事の効率化として、ファイル名に日付を自動的に入れることがあったと思います。それを実現するxyzzy-lispをずっと前に作成したので、残しておきます。機能としては、ファイル名にyyyymmddが付いていれば現在の日付で更新し、すでに現在の日付があれば枝番を追加します。
filer-get-copy-file-nameは元々filer.lにある関数を上書きして、自作した関数make-file-date-nameを呼ぶようにしただけです。
(in-package "editor")
;filer-get-copy-file-nameを上書き
(defun filer-get-copy-file-name (name)
(multiple-value-bind (result data)
(dialog-box '(dialog 0 0 215 71
(:caption "別名でコピー")
(:font 9 "MS UI Gothic")
(:control
(:static nil "新しいファイル名(&N):" #x50020000 7 38 55 8)
(:edit new nil #x50810080 7 48 144 14)
(:button IDOK "OK" #x50010001 153 7 55 14)
(:button IDCANCEL "キャンセル" #x50010000 153 24 55 14)
(:static nil "元のファイル名(&O):" #x50020000 7 7 50 8)
(:edit old nil #x50810880 7 17 144 14)))
(list (cons 'new (make-file-date-name name))
(cons 'old name))
'((new :non-null "新しいファイル名を入力して" :enable (IDOK))))
(when result
(cdr (assoc 'new data)))))
;ファイル名から、現在日付-枝番を更新したファイル名をつける
(defun make-file-date-name (name)
(let ((rtnstr) (patstr) (brastr))
(setq patstr "\([0-9]\{8\}\)\(-\([0-9]\)\)?\.")
(if (string-match patstr name)
;現在日付と一致するかを確認
(if (string= (match-string 1) (format-date-string "%Y%m%d"))
;現在日付と一致する場合、枝版があれば枝版の値を追加し、枝版がなければ追加。
(if (match-string 2)
(progn
;枝版の文字列を作成
(setq brastr (format nil "-~D" (1+ (parse-integer (match-string 3)))))
(setq rtnstr (substitute-string name patstr (concat "\1" brastr "\.")))
)
(setq rtnstr (substitute-string name patstr "\1-1\."))
)
;現在日付と一致しない場合、古い日付のファイルのみがあり、現在日付のファイルはないものとする
;枝版の有無
(if (match-string 2)
;枝版があれば、現在日付に"-1."を付与
(setq rtnstr (substitute-string name patstr (concat (format-date-string "%Y%m%d") "-1\.")))
;枝版がなければ現在日付をそのままつける
(setq rtnstr (substitute-string name patstr (concat (format-date-string "%Y%m%d") "\.")))
)
)
(setq rtnstr (concat name "~"))
)
rtnstr
)
)