find-file-name.l

;;
;; write-buffer-as
;;
(provide 'write-buffer-as)


(defun write-buffer-as (new-name)
  (interactive "FWrite file as: " :default0 (if (get-buffer-file-name)
                                                (get-buffer-file-name)
                                              (concat (get-special-folder-location :desktop)
                                                      "\\" (substitute-string (buffer-name (selected-buffer)) "*" ""))))
  (flet ((make-directory-recursive (dir)
           (call-process (concat "mkdir -p " dir) :show :hide :wait t)))
    (when (and (stringp new-name)
             (not (string= new-name (buffer-name (selected-buffer)))))
      (make-directory-recursive (directory-namestring new-name))
      (write-file new-name)
      (let ((ro buffer-read-only)
            (buf-old (selected-buffer)))
        (if (string= (buffer-name buf-old) "*scratch*")
            (erase-buffer "*scratch*")
          (delete-buffer (selected-buffer)))
        (find-file new-name)
        (setq buffer-read-only ro)))))

(global-set-key '(#\C-x #\C-w) 'write-buffer-as)


(defun save-buffer-gnrr ()
  (interactive)
  (if (get-buffer-file-name)
      (call-interactively 'save-buffer)
    (call-interactively 'write-buffer-as)))


(global-set-key '(#\C-x #\C-s) 'save-buffer-gnrr)

grep-result.l

;;;
;;; grep-result.l
;;;
;;; based on http://www.geocities.jp/m_hiroi/xyzzy_lisp/xyzzy02.html
;;;

; フック
;(defvar *grep-result-mode-hook* nil)

; キーマップ
;(defvar *grep-result-mode-map* nil)
;(unless *grep-result-mode-map*
;  (setq *grep-result-mode-map* (make-sparse-keymap)))

; キーワード
(defvar *grep-result-keyword-hash-table* nil)
(defvar *grep-result-keyword-file* "GREP-RESULT")   ;; d:\shishido\util\xyzzy\etc\GREP-RESULT

; シンタックステーブル
(defvar *test-mode-syntax-table* nil)
(unless *test-mode-syntax-table*
  (setq *test-mode-syntax-table* (make-syntax-table)))

(defun grep-result-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq buffer-mode 'grep-result-mode)
  (setq mode-name "GrepResult")
;  (use-keymap *grep-result-mode-map*)
  (use-syntax-table *grep-result-mode-syntax-table*)
  ; キーワードのロード
  (and *grep-result-keyword-file*
       (null *grep-result-keyword-hash-table*)
       (setq *grep-result-keyword-hash-table*
             (load-keyword-file *grep-result-keyword-file* t)))
  (when *grep-result-keyword-hash-table*
    (make-local-variable 'keyword-hash-table)
    (setq keyword-hash-table *grep-result-keyword-hash-table*))
  ; フックの実行
;  (run-hooks '*grep-result-mode-hook*)
  )

;;
(defvar *grep-result-mode-syntax-table* nil)
(unless *grep-result-mode-syntax-table*
  (setq *grep-result-mode-syntax-table* (make-syntax-table))
  (set-syntax-start-multi-comment*grep-result-mode-syntax-table* ">>> PAT")
  (set-syntax-end-comment *grep-result-mode-syntax-table* #\LFD t t))

grep.l

;;; -*- Mode: Lisp; Package: EDITOR -*-
;;;
;;; This file is part of xyzzy.
;;;
;;; modified

(provide "grep")

(in-package "editor")

(export '(*last-fgrep-pattern* *last-grep-regexp* grep fgrep
	  *grep-highlight-match* *grep-hook*))

(defvar *last-fgrep-pattern* "")
(defvar *last-grep-regexp* "")
(defvar *grep-highlight-match* '(:bold t))
(defvar *grep-hook* nil)

(defun fgrep (pattern &optional arg)
  (interactive "sfgrep: \np" :default0 *last-fgrep-pattern* :history0 'search)
  (setq *last-fgrep-pattern* pattern)
  (grep1 pattern arg))

(defun grep (regexp &optional arg)
  (interactive "sgrep: \np" :default0 *last-grep-regexp* :history0 'search)
  (setq *last-grep-regexp* regexp)
  (grep1 (compile-regexp regexp *case-fold-search*) arg))

(defun grep-scanner (pattern case-fold word-search)
  #'(lambda (&optional limit)
      (scan-buffer pattern
		   :case-fold case-fold
		   :left-bound word-search
		   :right-bound word-search
		   :limit limit)))

(defun grep-scan-file (file scanner)
  (let ((found nil))
    (while (funcall scanner)
      (setq found t)
      (let ((beg (progn (goto-bol) (point)))
	    (end (progn (goto-eol) (point))))
	(format t "~A:~D:~A~%" file (current-line-number) (buffer-substring beg end))
	(when (and *grep-highlight-match*
		   (buffer-stream-p *standard-output*))
	  (save-excursion
	    (set-buffer (buffer-stream-buffer *standard-output*))
	    (let ((p (- (buffer-stream-point *standard-output*) end 1)))
          ;; mod beg
          (save-excursion (save-restriction
          (goto-char (point-min))
          (let ((s (buffer-substring (+ (match-beginning 0) p) (+ (match-end 0) p))))
            (while (scan-buffer s :tail t)
              ;; (user::dbg-msgbox s (match-beginning 0))
              ;; (apply #'set-text-attribute (+ (match-beginning 0) p) (+ (match-end 0) p)
              (apply #'set-text-attribute (match-beginning 0) (match-end 0)
                     'grep *grep-highlight-match*)
              ))))
          ;; mod end
          ))))
      (or (forward-char 1)
	  (return)))
    found))

(defun grep1 (pattern arg)
  (long-operation
    (and arg
	 (setq arg (selected-buffer)))
    (with-output-to-temp-buffer ("*compilation*")
      (let ((sbuffer (buffer-stream-buffer *standard-output*))
	    (scanner (grep-scanner pattern *case-fold-search* *word-search*)))
	(save-excursion
	  (set-buffer sbuffer)
	  (make-local-variable '*find-error-scanner*)
	  (setq *find-error-scanner* scanner)
	  (set-buffer-fold-width nil sbuffer)
	  (dolist (buffer (if arg (list arg) (buffer-list)))
	    (let ((bufname (buffer-name buffer)))
	      (unless (or (eq buffer sbuffer)
			  (string-match "^ " bufname))
		(message "Scanning (~A)" bufname)
		(set-buffer buffer)
		(save-excursion
		  (goto-char (point-min))
		  (grep-scan-file (concatenate 'string "<" bufname ">") scanner))))))))
    (run-hooks '*grep-hook*)
    (message "completed.")
    t))

grepd.l

;;; -*- Mode: Lisp; Package: EDITOR -*-
;;;
;;; This file is part of xyzzy.
;;;
;;; modified

(require "glob")
(require "grep")                ; mod

(provide "grepd")

(in-package "editor")

(export '(grep-dialog *grep-directory-name-hook* *grepd-hook*))

(defvar *last-grepd-regexp* "")
(defvar *regexp-search* nil)
(defvar *understand-escape-sequences* nil)
(defvar *grepd-hook* nil)

(define-history-variable *grep-directory-history* nil)
(define-history-variable *grep-file-history* nil)
(define-history-variable *grep-case-fold-search* *case-fold-search*)
(define-history-variable *grep-word-search* *word-search*)
(define-history-variable *grep-regexp-search* *regexp-search*)
(define-history-variable *grep-subdir* nil)
(define-history-variable *grep-name-only* nil)
(define-history-variable *grep-understand-escape-sequences* *understand-escape-sequences*)
(define-history-variable *grep-async* nil)

(defvar *grep-directory-name-hook* nil)


(defun scan-files-1 (file pattern buffer scanner)
  (let ((file-buffer (get-file-buffer file)))
    (if file-buffer
        (set-buffer file-buffer)
      (progn
        (set-buffer buffer)
        (erase-buffer buffer)
        (ignore-errors (insert-file-contents file))))
    (save-excursion
      (goto-char (point-min))
      (message "scanning (~A)" file)
      (cond (*grep-name-only*
             (when (funcall scanner)
               (princ file)
               (terpri)
               t))
            (t
             (grep-scan-file file scanner))))))

(defun scan-files-setup (dir buffer temp scanner)
  (pop-to-buffer buffer t)
  (set-buffer temp)
  (set-default-directory dir)
  (set-buffer buffer)
  ;; (erase-buffer buffer) ;; mod
  (set-buffer-fold-width nil)
  (setq buffer-read-only nil)
  (setq need-not-save t)
  (setq kept-undo-information nil)
  (setq auto-save nil)
  (set-default-directory dir)
  (make-local-variable '*find-error-scanner*)
  (setq *find-error-scanner* scanner))

(defun scan-files-sync (pattern buffer temp scanner file dir)
  (unwind-protect
      (let ((dirlist (if (consp dir) (glob-expand-list dir) (glob-expand dir))))
        (unless dirlist
          (error "~A~%ディレクトリが見つかりません" dir))
        (scan-files-setup (glob-common-path dirlist)
                          buffer temp scanner)
        (refresh-screen)
        (use-keymap *grep-map*)        ;; mod
        (goto-char (point-min))        ;; mod

        (with-output-to-selected-buffer
          ;; mod
          (let (beg end)
            (format t ">>> PAT:\"~A\" | DIR: ~A | MASK: ~A\n" pattern dir file)
            (save-excursion
              ;; hilight line
              (backward-line)
              (goto-bol) (setq beg (1+ (point)))
              (goto-eol) (setq end (point))
              (set-text-attribute beg end 'all :background 6 :extend nil)
              ;; hilight pattern string
              (goto-bol)
              (when (scan-buffer "\".*\"" :no-dup 0 :regexp t)
                (setq beg (1+ (match-beginning 0)))
                (setq end (1- (match-end 0)))
                (set-text-attribute beg end 'all :background 2 :extend nil))))
          ;; mod
          (let ((last-tick (get-internal-real-time))
                (found nil)
                tick)
            (glob-exec dirlist
                       :recursive *grep-subdir*
                       :file-only t :wild file
                       :callback
                       #'(lambda (f)
                           (when (scan-files-1 f pattern temp scanner)
                             (setq found t))
                           (when found
                             (setq tick (get-internal-real-time))
                             (when (> (- tick last-tick) 500)
                               (setq last-tick tick)
                               (set-buffer buffer)
                               (goto-char (buffer-stream-point *standard-output*))
                               (refresh-screen)
                               (setq found nil)))
                           (do-events))))))
    (delete-buffer temp)
    (set-buffer buffer)
    (goto-char (point-min)))
  (set-buffer-modified-p nil)
  (run-hooks '*grepd-hook*)
  (message "done"))

(or (boundp 'async-grep-mode)
    (setq-default async-grep-mode nil))
(or (boundp 'async-grep-status)
    (setq-default async-grep-status nil))
(or (boundp 'async-grep-timer-callback)
    (setq-default async-grep-timer-callback nil))
(pushnew '(async-grep-mode . async-grep-status)
         *minor-mode-alist* :key #'car)

(defvar *async-grep-mode-map* nil)
(unless *async-grep-mode-map*
  (setq *async-grep-mode-map* (make-sparse-keymap))
  (define-key *async-grep-mode-map* #\C-g 'stop-async-grep))

(defun async-grep-mode ()
  (kill-all-local-variables)
  (setq buffer-mode 'async-grep-mode)
  (setq mode-name "Grep")
  (use-keymap *async-grep-mode-map*)
  (make-local-variable 'async-grep-timer-callback)
  (setq async-grep-timer-callback nil)
  (make-local-variable 'async-grep-temp-buffer)
  (setq async-grep-temp-buffer nil)
  (make-local-variable 'async-grep-last-update)
  (setq async-grep-last-update (get-internal-real-time))
  (make-local-variable 'async-grep-mode)
  (setq async-grep-mode nil)
  (make-local-variable 'async-grep-status))

(defun stop-async-grep ()
  (interactive)
  (when async-grep-timer-callback
    (set-buffer-modified-p nil)
    (setq async-grep-status "done")
    (update-mode-line (selected-buffer))
    (stop-timer async-grep-timer-callback)
    (setq async-grep-timer-callback nil)
    (when async-grep-temp-buffer
      (delete-buffer async-grep-temp-buffer)
      (setq async-grep-temp-buffer nil))
    (run-hooks '*grepd-hook*)
    (message "done"))
  t)

(defun grep-async-scanner (pattern buffer temp scanner glob)
  #'(lambda ()
      (let ((update (get-buffer-window buffer)))
        (with-set-buffer
          (save-excursion
            (set-buffer buffer)
            (if (null async-grep-timer-callback)
                (setq update nil)
              (let ((file (funcall glob))
                    (timer async-grep-timer-callback)
                    (last-tick async-grep-last-update))
                (cond ((stringp file)
                       (with-output-to-buffer (buffer (point-max))
                         (cond ((not (scan-files-1 file pattern temp scanner))
                                (setq update nil))
                               (update
                                (let ((tick (get-internal-real-time)))
                                  (cond ((> (- tick last-tick) 500)
                                         (set-buffer buffer)
                                         (setq async-grep-last-update tick))
                                        (t
                                         (setq update nil))))))
                         (start-timer 0 timer t)))
                      (file
                       (setq update nil)
                       (start-timer 0 timer t))
                      (t
                       (stop-async-grep)))))))
        (and update (refresh-screen)))))

(defun scan-files-async (pattern buffer temp scanner file dir)
  (let* ((dirlist (if (consp dir) (glob-expand-list dir) (glob-expand dir)))
         (commonl (glob-common-length dirlist)))
    (unless dirlist
      (error "~A~%ディレクトリが見つかりません" dir))
    (scan-files-setup (subseq (car dirlist) 0 commonl)
                      buffer temp scanner)
    (async-grep-mode)
    (setq async-grep-temp-buffer temp)
    (setq async-grep-timer-callback
          (grep-async-scanner pattern buffer temp scanner
                              (glob-enumerator (mapcar #'(lambda (x)
                                                           (subseq x commonl))
                                                       dirlist)
                                               file *grep-subdir* t)))
    (start-timer 0 async-grep-timer-callback t)
    (setq async-grep-mode t)
    (setq async-grep-status "running")))

(defun scan-files (pattern file dir &optional async)
  (long-operation
    (let ((buffer (get-buffer-create "*grep*")))
      (when (save-excursion  ;; async
              (set-buffer buffer)
              async-grep-timer-callback)
        (if (yes-or-no-p "grepはすでに動作中です。死なす?")
            (save-excursion
              (set-buffer buffer)
              (stop-async-grep))
          (quit)))
      (when *grep-regexp-search*
        (setq pattern (compile-regexp pattern *grep-case-fold-search*)))
      (let ((temp (create-new-buffer "*grep temp*"))
            (scanner (grep-scanner pattern *grep-case-fold-search*
                                   *grep-word-search*)))
        (if async
            (scan-files-async pattern buffer temp scanner file dir)
          (scan-files-sync pattern buffer temp scanner file dir))))))

(defun grep-dialog-1 (template dirlist)
  (interactive)
  (let ((pattern (selection-start-end (start end)
                   (buffer-substring start end)))
        (no-dirs (if dirlist
                     (dolist (d dirlist ':disable)
                       (if (file-directory-p d)
                           (return))))))
    (multiple-value-bind (result data)
        (dialog-box template
                    (list (cons 'pat pattern)
                          (cons 'pat *minibuffer-search-string-history*)
                          (cons 'file (or (car *grep-file-history*) "*"))
                          (cons 'file *grep-file-history*)
                          (cons 'dir
                                (if dirlist
                                    nil
                                  (let ((dir (and *grep-directory-name-hook*
                                                  (funcall *grep-directory-name-hook*))))
                                    (if (stringp dir)
                                        dir
                                      (default-directory)))))
                          (cons 'dir *grep-directory-history*)
                          (cons 'case-fold (cfs2dialog *grep-case-fold-search*))
                          (cons 'word *grep-word-search*)
                          (cons 'regexp *grep-regexp-search*)
                          (cons 'escseq *grep-understand-escape-sequences*)
                          (cons 'subdir *grep-subdir*)
                          (cons 'async *grep-async*)
                          (cons 'name *grep-name-only*))
                    `((file :disable ,no-dirs)
                      (file-static :disable ,no-dirs)
                      (subdir :disable ,no-dirs)
                      (word :disable (regexp))
                      (pat :non-null "検索文字列を入力して" :enable (IDOK))
                      (ref :related dir :directory-name-dialog (:title "参照"))))
      (when result
        (let ((pattern (cdr (assoc 'pat data)))
              (file (or (cdr (assoc 'file data)) "*"))
              (dir (or dirlist (namestring (or (cdr (assoc 'dir data))
                                               (default-directory))))))
          (when pattern
            (si:*activate-toplevel)
            (add-history pattern '*minibuffer-search-string-history*)
            (or no-dirs (add-history file '*grep-file-history*))
            (or dirlist (add-history dir '*grep-directory-history*))
            (setq *grep-case-fold-search* (dialog2cfs (cdr (assoc 'case-fold data))))
            (setq *grep-word-search* (cdr (assoc 'word data)))
            (setq *grep-regexp-search* (cdr (assoc 'regexp data)))
            (setq *grep-understand-escape-sequences* (cdr (assoc 'escseq data)))
            (when *grep-understand-escape-sequences*
              (setq pattern (decode-escape-sequence pattern *grep-regexp-search*)))
            (or no-dirs (setq *grep-subdir* (cdr (assoc 'subdir data))))
            (setq *grep-async* (cdr (assoc 'async data)))
            (setq *grep-name-only* (cdr (assoc 'name data)))
            (scan-files pattern (split-string file #\; t " ")
                        (or dirlist dir) *grep-async*)
            t))))))

(defun grep-dialog ()
  (interactive)
  (grep-dialog-1 '(dialog 0 0 271 157
                   (:caption "Grep")
                   (:font 9 "MS UI Gothic")
                   (:control
                    (:static nil "パターン(&P):" #x50020000 7 10 42 8)
                    (:combobox pat nil #x50210042 51 8 157 96)
                    (:static nil "ファイル名(&F):" #x50020000 7 27 42 8)
                    (:combobox file nil #x50210042 51 25 157 96)
                    (:static nil "ディレクトリ(&D):" #x50020000 7 45 42 8)
                    (:combobox dir nil #x50210042 51 42 157 96)
                    (:button case-fold "大文字小文字を区別する(&C)" #x50010006 51 61 105 10)
                    (:button word "単語単位で検索する(&W)" #x50010003 51 74 92 10)
                    (:button regexp "正規表現(&E)" #x50010003 51 87 58 10)
                    (:button escseq "エスケープシーケンスを理解しろ(&Y)" #x50010003 51 100 106 10)
                    (:button subdir "ついでにサブディレクトリも(&U)" #x50010003 51 113 95 10)
                    (:button async "非同期でgrep(&A)" #x50010003 51 126 65 10)
                    (:button name "ファイル名だけ出力(&O)" #x50010003 51 139 87 10)
                    (:button IDOK "検索(&S)" #x50010001 214 7 50 14)
                    (:button IDCANCEL "キャンセル" #x50010000 214 24 50 14)
                    (:button ref "参照(&R)..." #x50010000 214 41 50 14)))
                 nil))

insert-paren.l

;;
;;insert-paren    (), [], {}, <>, "", ''
;;
(provide 'insert-paren)

(defun insert-paren()
  "Insert paired () working like insert-parenthesis."
  (interactive)
  (insert #\()
  (save-excursion
    (insert #\))))

(global-set-key #\M-\9 'insert-paren)
(global-unset-key #\M-\8)

(defvar insert-paren-kaku-state nil)
(defun insert-paren-kaku ()
  "Insert paired {} or [] working like insert-parenthesis."
  (interactive)
  (if (eq *last-command* 'insert-paren-kaku)
      (progn
        (forward-char -1)
        (delete-char 2)
        (if (null insert-paren-kaku-state)
            (progn
              (insert #\{)
              (save-excursion
                (insert #\}))
              (setq insert-paren-kaku-state t))
          (progn
            (insert #\[)
            (save-excursion
              (insert #\]))
            (setq insert-paren-kaku-state nil))))
    (progn
      (insert #\[)
      (save-excursion
        (insert #\]))
      (setq insert-paren-kaku-state nil))))
  
(global-set-key #\M-\[ 'insert-paren-kaku)

(defvar insert-paren-quote-state nil)
(defun insert-paren-quote ()
  "Insert paired single-quote or double-quote working like insert-parenthesis."
  (interactive)
  (if (eq *last-command* 'insert-paren-quote)
      (progn
    (forward-char -1)
    (delete-char 2)
    (if (null insert-paren-quote-state)
        (progn
          (insert #\")
          (save-excursion
        (insert #\"))
          (setq insert-paren-quote-state t))
      (progn
        (insert #\')
        (save-excursion
          (insert #\'))
        (setq insert-paren-quote-state nil))))
    (progn
      (insert #\')
      (save-excursion
    (insert #\'))
      (setq insert-paren-quote-state nil))))

(global-set-key #\M-\' 'insert-paren-quote)

(defun insert-paren-gtlt()
  "Insert paired <> working like insert-parenthesis."
  (interactive)
  (insert #\<)
  (save-excursion
    (insert #\>)))

(global-set-key #\M-\, 'insert-paren-gtlt)
(global-unset-key #\M-\.)

makefile-mode.l

(provide "makefile-mode")

(in-package "editor")

(export '(makefile-mode
         *makefile-mode-hook*))

(defvar *makefile-mode-hook* nil)

(defvar *makefile-mode-map* nil)
(unless *makefile-mode-map*
 (setq *makefile-mode-map* (make-sparse-keymap)))

(defvar *makefile-mode-syntax-table* nil)
(unless *makefile-mode-syntax-table*
 (setq *makefile-mode-syntax-table* (make-syntax-table))
 (set-syntax-start-comment *makefile-mode-syntax-table* #\# t)
 (set-syntax-end-comment *makefile-mode-syntax-table* #\LFD nil t))

(defvar *makefile-regexp-keyword-list* nil)
(setq *makefile-regexp-keyword-list*
     (compile-regexp-keyword-list
      '(("^\t+\\([+---@]+\\)" nil (:keyword 1 :bold) nil 1 1)
        ("^ *\\(\\.DEFAULT\\|\\.DELETE_ON_ERROR\\|\\.EXPORT_ALL_VARIABLES\\|\\.IGNORE\\|\\.INTERMEDIATE\\|\\.PHONY\\|\\.POSIX\\|\\.PRECIOUS\\|\\.SECONDARY\\|\\.SILENT\\|\\.SUFFIXES\\)[ \t]*:"
         nil (:keyword 0 :underline) nil 1 1)
        ("^ *\\(define\\|endef\\|ifdef\\|ifndef\\|ifeq\\|ifneq\\|else\\|endif\\|include\\|override\\|export\\|unexport\\|vpath\\)\\b"
         nil (:keyword 2) nil 1 1)
        ("\\$%\\|\\$(%D)\\|\\$(%F)\\|\\$(\\*D)\\|\\$(\\*F)\\|\\$(<D)\\|\\$(<F)\\|\\$(\\?D)\\|\\$(\\?F)\\|\\$(@D)\\|\\$(@F)\\|\\$(\\^D)\\|\\$(\\^F)\\|\\$\\*\\|\\$\\+\\|\\$<\\|\\$\\?\\|\\$@\\|\\$\\^"
         nil (:color 1 0) nil 0 0)
        ))
     )

(defun makefile-mode ()
 (interactive)
 (kill-all-local-variables)
 (setq buffer-mode 'makefile-mode)
 (setq mode-name "Makefile")
 (use-keymap *makefile-mode-map*)
 (use-syntax-table *makefile-mode-syntax-table*)
 (make-local-variable 'regexp-keyword-list)
 (setq regexp-keyword-list *makefile-regexp-keyword-list*)
 (run-hooks '*makefile-mode-hook*))


#|
.DEFAULT
.DELETE_ON_ERROR
.EXPORT_ALL_VARIABLES
.IGNORE
.INTERMEDIATE
.PHONY
.POSIX
.PRECIOUS
.SECONDARY
.SILENT
.SUFFIXES

define
endef

ifdef
ifndef
ifeq
ifneq
else
endif

include
override
export
unexport
vpath

+
-
@

$%
$(%D)
$(%F)
$(*D)
$(*F)
$(<D)
$(<F)
$(?D)
$(?F)
$(@D)
$(@F)
$(^D)
$(^F)
$*
$+
$<
$?
$@
$^

|#

my-grep.l

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; @@@ my-grep
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide "my-grep")
(require "grep")
(require "grepd")
(require "errors-mod")
(in-package "editor")

(defun lookup-word-near-cursor ()
  (grep-lookup-word
   #'(lambda (start end)
       (let ((word (buffer-substring start end))
;            (ext (if (string-match "^[^.]+\\."
;                                    (reverse (get-buffer-file-name)))
;                      (reverse (match-string 0))
;                    ""))
;             (dir (directory-namestring (get-buffer-file-name))))
             )
         (unless word
           (seq word ""))
         word))))


(defun grep-lookup-word (fn)
  (apply fn (save-excursion
              (list (progn
                      (skip-syntax-spec-forward "w_")
                      (point))
                    (progn
                      (skip-syntax-spec-backward "w_")
                      (point))))))

(defun get-buffer-parent-directory ()
  (let ((ret "")
        (path (get-buffer-file-name)))
    (if (stringp path)
        (setq ret (directory-namestring path)))
    ret))

(defun my-grep-internal-re (directory pattern-files)
  "moccur style recursive grep command /w regexp"
  (interactive "DGREP-RE: \nsregexp and filemask:"
    :default0 (get-buffer-parent-directory)
    :default1 (concat (lookup-word-near-cursor) "\t*.[ch]"))
  (let ((ed::*grep-case-fold-search* nil)
        (ed::*grep-regexp-search* t) ; enable re
        (ed::*grep-subdir* t)
        (ed::*grep-name-only* nil))
    (let (input)
      (setq input (split-string pattern-files "\t"))
      (setq pattern (car input))
      (setq files (car (cdr input))))

    (ed::scan-files pattern files directory)  ;; exec-grep

    (setq buffer-read-only t)
    (next-line 1)
    ;; (c-mode)
    ))

(defun my-grep-internal-fixed (directory pattern-files)
  "moccur style recursive grep command /w fixed string"
  (interactive "DGREP-FIX: \nsstring and filemask:"
    :default0 (get-buffer-parent-directory)
    :default1 (concat (lookup-word-near-cursor) "\t*.[ch]"))
  (let ((ed::*grep-case-fold-search* nil)
        (ed::*grep-regexp-search* nil); disable re
        (ed::*grep-subdir* t)
        (ed::*grep-name-only* nil))
    (let (input)
      (setq input (split-string pattern-files "\t"))
      (setq pattern (car input))
      (setq files (cond ((car (cdr input)))
                        ("*"))))
    (ed::scan-files pattern files directory)  ;; exec-grep

    (setq buffer-read-only t)
    (next-line 1)
    ;; (c-mode)
    ))

(defun my-grep (&optional arg)
  (interactive "p")
  (if arg
      (call-interactively 'my-grep-internal-re)
    (call-interactively 'my-grep-internal-fixed)))




;;Grepをしたときに特定のディレクトは無視する
;; http://se-suganuma.blogspot.com/2007/12/xyzzygrep.html
;;対象外にするフォルダ
(defvar *ignore-scan-dirs* '("dic" ".svn" ))
;; 元の関数
(defvar *org-scan-files-1* (function ed::scan-files-1))

(defun ed::scan-files-1 (sFile pattern buffer scanner)
  (let (bSkip)
    (dolist (sDir *ignore-scan-dirs*)
      (setq sDir (append-trail-slash sDir))
      (setq iPos (string-match sDir sFile))
      (when iPos
        (setq bSkip t)
        (return)))
    (unless bSkip
      (funcall *org-scan-files-1* sFile pattern buffer scanner))))

;; global-keybind
(global-set-key #\M-o 'my-grep)

(export '(*grep-map*))
(defvar *grep-map* nil)
(unless *grep-map*
  (setq *grep-map* (make-sparse-keymap)))
(define-key *grep-map* #\RET 'first-error-gnrr)

;; (add-hook 'ed::*grep-hook* #'(lambda () (use-keymap *grep-map*)))
;; (add-hook 'ed::*grep-hook* #'(lambda () (setq buffer-read-only t)))
;; (add-hook 'ed::*grepd-hook* #'(lambda () (use-keymap *grep-map*)))
;; (add-hook 'ed::*grepd-hook* #'(lambda () (setq buffer-read-only t)))

;; color
;; (setq-default *grep-highlight-match* '(:bold t :background 6))
(setq-default *grep-highlight-match* '(:background 2))

recentf.l

;;;
;;; recentf.l
;;;

(provide "recentf")

(export '(*recentf-mode-hook* *recentf-mode-map* recentf-mode))
(defvar *recentf-mode-hook* nil)
(defvar *recentf-buf-name* "*recentf*")

;;
;; keymap
;;
(defvar *recentf-mode-map* nil)
(unless *recentf-mode-map*
  (setq *recentf-mode-map* (make-sparse-keymap))
  (define-key *recentf-mode-map* #\RET 'recentf-action-key-enter)
  (define-key *recentf-mode-map* '(#\C-x #\C-s) 'recentf-save)
  (define-key *recentf-mode-map* '(#\C-x #\k) 'recentf-kill-buffer)
  (define-key *recentf-mode-map* #\q 'recentf-kill-buffer))

;;
;; util
;;

(defun recentf-enumulate-file-name ()
  (dolist (e *minibuffer-file-name-history*)
    (insert e "\n")))

(defun recentf-find-file ()
  (flet ((get-current-line ()
           (save-excursion
             (let ((beg (progn (goto-bol) (point)))
                   (end (progn (goto-eol) (point))))
               (buffer-substring beg end)))))
    (let ((fn (get-current-line)))
      (if (file-exist-p fn)
          (progn
            (recentf-update-list fn)
            (delete-buffer *recentf-buf-name*)
            (find-file fn))
        (message (concat "not found: " fn))))))

(defun recentf-update-list (e)
  (let ((l (reverse (set-exclusive-or *minibuffer-file-name-history* (list e) :test #'string=))))
    (setq *minibuffer-file-name-history* (push e l))))

(defun recentf-create-list ()
  (split-string (buffer-substring (point-min) (point-max)) "\n" nil " \t"))

(defun recentf-cleanup-buffer ()
  (save-excursion
    (goto-char (point-min))
    (replace-buffer "^[ \t]*\n" "" :regexp t)))    ; 空行を削除

;;
;; command
;;
(defun recentf-action-key-enter ()
  (interactive)
  (if buffer-read-only
      (recentf-find-file)
    (newline)))

(defun recentf-save ()
  (interactive)
  (unless buffer-read-only
    (recentf-cleanup-buffer)
    (setq *minibuffer-file-name-history* (recentf-create-list))
    (set-buffer-modified-p nil *recentf-buf-name*)
    (message "saved.")))

(defun recentf-kill-buffer ()
  (interactive)
  (delete-buffer *recentf-buf-name*))

(defun recentf ()
  (interactive)
  (when (find-buffer *recentf-buf-name*)
    (delete-buffer *recentf-buf-name*))
  (set-buffer (get-buffer-create *recentf-buf-name*))
  (recentf-enumulate-file-name)
  (goto-char (point-min))
  (set-buffer-modified-p nil)
  (setq buffer-read-only t)
  (recentf-mode))

(defun recentf-mode ()
;  (kill-all-local-variables)
  (setq buffer-mode 'recentf-mode)
  (setq mode-name "recentf")
  (use-keymap *recentf-mode-map*)
  (setq need-not-save t)
  (setq auto-save nil)
  (setq kept-undo-information nil)
  (make-local-variable 'highlight-keyword)
  (setq highlight-keyword nil)
  (run-hooks '*recentf-mode-hook*))

(global-set-key '(#\C-x #\r #\r) 'recentf)
; (define-key ctl-x-map 'recentf)

todo-mode.l

;;; todo-mode.l - major-mode for todo
;;;
;;; based on test-mode at http://www.geocities.jp/m_hiroi/xyzzy_lisp/xyzzy02.html

(provide "todo-mode")

;;; setting
(defvar *todo-mode-file* "~/xyzzy_todo.txt")

;;;
;;; internal functions
;;;
(defun todo-xyzzy-kill-buffer ()
  (interactive)
  (write-file *todo-mode-file* t)
  (kill-buffer (selected-buffer)))


;;;
;;; hooks
(defvar *todo-mode-hook* nil)

;;;
;;; keymap
;;;
(defvar *todo-mode-map* nil)
(unless *todo-mode-map*
  (setq *todo-mode-map* (make-sparse-keymap))
  (define-key *todo-mode-map* '(#\C-x #\k) 'todo-xyzzy-kill-buffer))

;;;
;;; command
;;;
(defun todo-mode ()
  (interactive)
  (switch-to-buffer "*Todo*")
  (kill-all-local-variables)
  (setq buffer-mode 'todo-mode)
  (setq mode-name "Todo")
  (use-keymap *todo-mode-map*)
  (make-local-variable 'need-not-save)
  (setq need-not-save t)
  (make-local-variable 'auto-save)
  (setq auto-save nil)
  (insert-file *todo-mode-file*) ; insert
  (set-buffer-file-name *todo-mode-file*)
  (run-hooks '*todo-mode-hook*))

(defun todo ()
  (interactive)
  ;; (dbg-msgbox *todo-mode-file*)
;;   ;; (if (> (count-windows) 1)
;;       ;; (find-file todo-file)
;;     ;; (find-file-other-window todo-file)))
  (todo-mode))

;;; todo-mode.l ends here

write-buffer-as.l

;;
;; write-buffer-as
;;
(provide 'write-buffer-as)


(defun write-buffer-as (new-name)
  (interactive "FWrite file as: " :default0 (if (get-buffer-file-name)
                                                (get-buffer-file-name)
                                              (concat (get-special-folder-location :desktop)
                                                      "\\" (substitute-string (buffer-name (selected-buffer)) "*" ""))))
  (flet ((make-directory-recursive (dir)
           (call-process (concat "mkdir -p " dir) :show :hide :wait t)))
    (when (and (stringp new-name)
             (not (string= new-name (buffer-name (selected-buffer)))))
      (make-directory-recursive (directory-namestring new-name))
      (write-file new-name)
      (let ((ro buffer-read-only)
            (buf-old (selected-buffer)))
        (if (string= (buffer-name buf-old) "*scratch*")
            (erase-buffer "*scratch*")
          (delete-buffer (selected-buffer)))
        (find-file new-name)
        (setq buffer-read-only ro)))))

(global-set-key '(#\C-x #\C-w) 'write-buffer-as)


(defun save-buffer-gnrr ()
  (interactive)
  (if (get-buffer-file-name)
      (call-interactively 'save-buffer)
    (call-interactively 'write-buffer-as)))


(global-set-key '(#\C-x #\C-s) 'save-buffer-gnrr)