You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

2993 lines
102 KiB

  1. ;;; emacs.el --- 10sr emacs initialization
  2. ;;; Code:
  3. ;; SETUP_LOAD: (let ((file "DOTFILES_DIR/emacs.el"))
  4. ;; SETUP_LOAD: (and (file-readable-p file)
  5. ;; SETUP_LOAD: (byte-recompile-file file nil 0 t)))
  6. (setq debug-on-error t)
  7. ;; make directories
  8. (unless (file-directory-p (expand-file-name user-emacs-directory))
  9. (make-directory (expand-file-name user-emacs-directory)))
  10. (require 'cl-lib)
  11. (require 'simple)
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13. ;; Some macros for internals
  14. (defun call-after-init (func)
  15. "If `after-init-hook' has been run, call FUNC immediately.
  16. Otherwize hook it."
  17. (if after-init-time
  18. (funcall func)
  19. (add-hook 'after-init-hook
  20. func)))
  21. (defmacro safe-require-or-eval (feature)
  22. "Require FEATURE if available.
  23. At compile time the feature will be loaded immediately."
  24. `(eval-and-compile
  25. (message "safe-require-or-eval: Trying to require %s" ,feature)
  26. (require ,feature nil t)))
  27. (defmacro autoload-eval-lazily (feature &optional functions &rest body)
  28. "Define autoloading FEATURE that defines FUNCTIONS.
  29. FEATURE is a symbol. FUNCTIONS is a list of symbols. If FUNCTIONS is nil,
  30. the function same as FEATURE is defined as autoloaded function. BODY is passed
  31. to `eval-after-load'.
  32. After this macro is expanded, this returns the path to library if FEATURE
  33. found, otherwise returns nil."
  34. (declare (indent 2) (debug t))
  35. (let* ((libname (symbol-name (eval feature)))
  36. (libpath (locate-library libname)))
  37. `(progn
  38. (when (locate-library ,libname)
  39. ,@(mapcar (lambda (f)
  40. `(unless (fboundp ',f)
  41. (progn
  42. (message "Autoloaded function `%S' defined (%s)"
  43. (quote ,f)
  44. ,libpath)
  45. (autoload (quote ,f)
  46. ,libname
  47. ,(concat "Autoloaded function defined in \""
  48. libpath
  49. "\".")
  50. t))))
  51. (or (eval functions)
  52. `(,(eval feature)))))
  53. (eval-after-load ,feature
  54. (quote (progn
  55. ,@body)))
  56. (locate-library ,libname))))
  57. (when (autoload-eval-lazily 'tetris nil
  58. (message "Tetris loaded!"))
  59. (message "Tetris found!"))
  60. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  61. ;; package
  62. (set (defvar 10sr-package-list)
  63. '(
  64. vimrc-mode
  65. markdown-mode
  66. yaml-mode
  67. gnuplot-mode
  68. php-mode
  69. erlang
  70. js2-mode
  71. js-doc
  72. git-commit
  73. gitignore-mode
  74. adoc-mode
  75. go-mode
  76. ;; It seems malabar has been merged into jdee and this package
  77. ;; already removed
  78. ;; malabar-mode
  79. gosh-mode
  80. scala-mode
  81. ;;ensime
  82. ;; ack
  83. color-moccur
  84. ggtags
  85. flycheck
  86. auto-highlight-symbol
  87. hl-todo
  88. ;; Currently not available
  89. ;; pp-c-l
  90. xclip
  91. foreign-regexp
  92. multi-term
  93. term-run
  94. editorconfig
  95. git-ps1-mode
  96. restart-emacs
  97. fill-column-indicator
  98. pkgbuild-mode
  99. minibuffer-line
  100. which-key
  101. ;; I think this works in place of my autosave lib
  102. super-save
  103. pipenv
  104. imenu-list
  105. page-break-lines
  106. ;; sync-recentf
  107. aggressive-indent
  108. ;; fancy-narrow
  109. dired-filter
  110. wgrep
  111. magit
  112. git-gutter
  113. end-mark
  114. sl
  115. editorconfig
  116. editorconfig-custom-majormode
  117. git-command
  118. prompt-text
  119. ;; 10sr repository
  120. ;; 10sr-extras
  121. terminal-title
  122. recentf-show
  123. dired-list-all-mode
  124. pack
  125. set-modeline-color
  126. read-only-only-mode
  127. smart-revert
  128. autosave
  129. ;;window-organizer
  130. ilookup
  131. pasteboard
  132. ))
  133. (when (safe-require-or-eval 'package)
  134. (setq package-archives
  135. `(,@package-archives
  136. ("melpa" . "https://melpa.org/packages/")
  137. ;; Somehow fails to download via https
  138. ("10sr-el" . "http://10sr.github.io/emacs-lisp/elpa/")))
  139. (package-initialize)
  140. (defun my-auto-install-package ()
  141. "Install packages semi-automatically."
  142. (interactive)
  143. (package-refresh-contents)
  144. (mapc (lambda (pkg)
  145. (or (package-installed-p pkg)
  146. (package-install pkg)))
  147. 10sr-package-list))
  148. )
  149. ;; (lazy-load-eval 'sudoku)
  150. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  151. ;; my-idle-hook
  152. (defvar my-idle-hook nil
  153. "Hook run when idle for several secs.")
  154. (defvar my-idle-hook-sec 5
  155. "Second to run `my-idle-hook'.")
  156. (run-with-idle-timer my-idle-hook-sec
  157. t
  158. (lambda ()
  159. (run-hooks 'my-idle-hook)))
  160. ;; (add-hook 'my-idle-hook
  161. ;; (lambda ()
  162. ;; (message "idle hook message")))
  163. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  164. ;; start and quit
  165. (setq inhibit-startup-message t)
  166. (setq confirm-kill-emacs 'y-or-n-p)
  167. (setq gc-cons-threshold (* 1024 1024 16))
  168. (setq garbage-collection-messages nil)
  169. (when window-system
  170. (add-to-list 'default-frame-alist '(cursor-type . box))
  171. (add-to-list 'default-frame-alist '(background-color . "white"))
  172. (add-to-list 'default-frame-alist '(foreground-color . "gray10"))
  173. ;; (add-to-list 'default-frame-alist '(alpha . (80 100 100 100)))
  174. ;; does not work?
  175. )
  176. ;; (add-to-list 'default-frame-alist '(cursor-type . box))
  177. (if window-system (menu-bar-mode 1) (menu-bar-mode 0))
  178. (and (fboundp 'tool-bar-mode)
  179. (tool-bar-mode 0))
  180. (and (fboundp 'set-scroll-bar-mode)
  181. (set-scroll-bar-mode nil))
  182. (call-after-init
  183. (lambda ()
  184. (message "%s %s" invocation-name emacs-version)
  185. (message "Invocation directory: %s" default-directory)
  186. (message "%s was taken to initialize emacs." (emacs-init-time))
  187. (view-echo-area-messages)
  188. ;; (view-emacs-news)
  189. ))
  190. (cd ".") ; when using windows use / instead of \ in `default-directory'
  191. ;; locale
  192. (set-language-environment "Japanese")
  193. (set-default-coding-systems 'utf-8-unix)
  194. (prefer-coding-system 'utf-8-unix)
  195. (setq system-time-locale "C")
  196. ;; my prefix map
  197. (defvar my-prefix-map nil
  198. "My prefix map.")
  199. (define-prefix-command 'my-prefix-map)
  200. ;; (define-key ctl-x-map (kbd "C-x") 'my-prefix-map)
  201. ;; (define-key my-prefix-map (kbd "C-q") 'quoted-insert)
  202. ;; (define-key my-prefix-map (kbd "C-z") 'suspend-frame)
  203. ;; (comint-show-maximum-output)
  204. ;; kill scratch
  205. (call-after-init (lambda ()
  206. (let ((buf (get-buffer "*scratch*")))
  207. (when buf
  208. (kill-buffer buf)))))
  209. ;; modifier keys
  210. ;; (setq mac-option-modifier 'control)
  211. ;; display
  212. (setq visible-bell t)
  213. (setq ring-bell-function 'ignore)
  214. (mouse-avoidance-mode 'banish)
  215. (setq echo-keystrokes 0.1)
  216. (defun reload-init-file ()
  217. "Reload Emacs init file."
  218. (interactive)
  219. (when (and user-init-file
  220. (file-readable-p user-init-file))
  221. (load-file user-init-file)))
  222. (safe-require-or-eval 'session)
  223. ;; server
  224. (set-variable 'server-name (concat "server"
  225. (number-to-string (emacs-pid))))
  226. ;; In Cygwin Environment `server-runnning-p' stops when server-use-tcp is nil
  227. ;; In Darwin environment, init fails with message like 'Service name too long'
  228. ;; when server-use-tcp is nil
  229. (when (or (eq system-type
  230. 'cygwin)
  231. (eq system-type
  232. 'darwin))
  233. (set-variable 'server-use-tcp t))
  234. ;; MSYS2 fix
  235. (when (eq system-type
  236. 'windows-nt)
  237. (setq shell-file-name
  238. (executable-find "bash"))
  239. '(setq function-key-map
  240. `(,@function-key-map ([pause] . [?\C-c])
  241. ))
  242. (define-key key-translation-map
  243. (kbd "<pause>")
  244. (kbd "C-c"))
  245. '(keyboard-translate [pause]
  246. (kbd "C-c")p)
  247. ;; TODO: move to other place later
  248. (when (not window-system)
  249. (setq interprogram-paste-function nil)
  250. (setq interprogram-cut-function nil)))
  251. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  252. ;; global keys
  253. (global-set-key (kbd "<up>") 'scroll-down-line)
  254. (global-set-key (kbd "<down>") 'scroll-up-line)
  255. (global-set-key (kbd "<left>") 'scroll-down)
  256. (global-set-key (kbd "<right>") 'scroll-up)
  257. ;; (define-key my-prefix-map (kbd "C-h") help-map)
  258. (global-set-key (kbd "C-\\") help-map)
  259. (define-key ctl-x-map (kbd "DEL") help-map)
  260. (define-key ctl-x-map (kbd "C-h") help-map)
  261. (define-key help-map "a" 'apropos)
  262. ;; disable annoying keys
  263. (global-set-key [prior] 'ignore)
  264. (global-set-key (kbd "<next>") 'ignore)
  265. (global-set-key [menu] 'ignore)
  266. (global-set-key [down-mouse-1] 'ignore)
  267. (global-set-key [down-mouse-2] 'ignore)
  268. (global-set-key [down-mouse-3] 'ignore)
  269. (global-set-key [mouse-1] 'ignore)
  270. (global-set-key [mouse-2] 'ignore)
  271. (global-set-key [mouse-3] 'ignore)
  272. (global-set-key (kbd "<eisu-toggle>") 'ignore)
  273. (global-set-key (kbd "C-<eisu-toggle>") 'ignore)
  274. (when (safe-require-or-eval 'which-key)
  275. (which-key-mode))
  276. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  277. ;; editor
  278. (setq kill-whole-line t)
  279. (setq scroll-conservatively 35
  280. scroll-margin 2)
  281. (setq-default major-mode 'text-mode)
  282. (setq next-line-add-newlines nil)
  283. (setq kill-read-only-ok t)
  284. (setq truncate-partial-width-windows nil) ; when splitted horizontally
  285. ;; (setq-default line-spacing 0.2)
  286. (setq-default indicate-empty-lines t) ; when using x indicate empty line
  287. ;; (setq-default tab-width 4)
  288. (setq-default indent-tabs-mode nil)
  289. (setq-default indent-line-function 'indent-to-left-margin)
  290. ;; (setq-default indent-line-function nil)
  291. (setq-default truncate-lines nil)
  292. ;; (pc-selection-mode 1) ; make some already defined keybind back to default
  293. (delete-selection-mode 1)
  294. (cua-mode 0)
  295. (setq line-move-visual nil)
  296. (setq create-lockfiles nil)
  297. (add-hook 'before-save-hook
  298. 'time-stamp)
  299. ;; Add Time-stamp: <> to insert timestamp there
  300. (set-variable 'time-stamp-format
  301. "%:y-%02m-%02d %02H:%02M:%02S %Z 10sr")
  302. ;; key bindings
  303. ;; moving around
  304. ;;(keyboard-translate ?\M-j ?\C-j)
  305. ;; (global-set-key (kbd "M-p") 'backward-paragraph)
  306. (define-key esc-map "p" 'backward-paragraph)
  307. ;; (global-set-key (kbd "M-n") 'forward-paragraph)
  308. (define-key esc-map "n" 'forward-paragraph)
  309. (global-set-key (kbd "C-<up>") 'scroll-down-line)
  310. (global-set-key (kbd "C-<down>") 'scroll-up-line)
  311. (global-set-key (kbd "C-<left>") 'scroll-down)
  312. (global-set-key (kbd "C-<right>") 'scroll-up)
  313. (global-set-key (kbd "<select>") 'ignore) ; 'previous-line-mark)
  314. (define-key ctl-x-map (kbd "ESC x") 'execute-extended-command)
  315. (define-key ctl-x-map (kbd "ESC :") 'eval-expression)
  316. ;; C-h and DEL
  317. (global-set-key (kbd "C-h") (kbd "DEL"))
  318. ;;(global-set-key (kbd "C-m") 'reindent-then-newline-and-indent)
  319. (global-set-key (kbd "C-m") 'newline-and-indent)
  320. ;; (global-set-key (kbd "C-o") (kbd "C-e C-m"))
  321. ;; (global-set-key "\C-z" 'undo) ; undo is M-u
  322. (define-key esc-map "u" 'undo)
  323. (define-key esc-map "i" (kbd "ESC TAB"))
  324. ;; (global-set-key (kbd "C-r") 'query-replace-regexp)
  325. (global-set-key (kbd "C-s") 'isearch-forward-regexp)
  326. (global-set-key (kbd "C-r") 'isearch-backward-regexp)
  327. (require 'page-ext nil t)
  328. (when (safe-require-or-eval 'page-break-lines)
  329. (global-page-break-lines-mode 1))
  330. (when (safe-require-or-eval 'git-gutter)
  331. (custom-set-variables
  332. '(git-gutter:update-interval 2))
  333. (custom-set-variables
  334. '(git-gutter:unchanged-sign " "))
  335. (when (= (display-color-cells)
  336. 256)
  337. (let ((c "color-233"))
  338. (set-face-background 'git-gutter:modified c)
  339. (set-face-background 'git-gutter:added c)
  340. (set-face-background 'git-gutter:deleted c)
  341. (set-face-background 'git-gutter:unchanged c)))
  342. (global-git-gutter-mode 1)
  343. )
  344. ;; (when (safe-require-or-eval 'fancy-narrow)
  345. ;; (fancy-narrow-mode 1))
  346. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  347. ;; title and mode-line
  348. (when (safe-require-or-eval 'terminal-title)
  349. ;; if TERM is not screen use default value
  350. (if (getenv "TMUX")
  351. ;; if use tmux locally just basename of current dir
  352. (set-variable 'terminal-title-format
  353. '((file-name-nondirectory (directory-file-name
  354. default-directory))))
  355. (if (and (let ((tty-type (frame-parameter nil
  356. 'tty-type)))
  357. (and tty-type
  358. (equal (car (split-string tty-type
  359. "-"))
  360. "screen")))
  361. (not (getenv "SSH_CONNECTION")))
  362. (set-variable 'terminal-title-format
  363. '((file-name-nondirectory (directory-file-name
  364. default-directory))))
  365. ;; seems that TMUX is used locally and ssh to remote host
  366. (set-variable 'terminal-title-format
  367. `("em:"
  368. ,user-login-name
  369. "@"
  370. ,(car (split-string (system-name)
  371. "\\."))
  372. ":"
  373. default-directory))
  374. )
  375. )
  376. (terminal-title-mode))
  377. (setq eol-mnemonic-dos "\\r\\n")
  378. (setq eol-mnemonic-mac "\\r")
  379. (setq eol-mnemonic-unix "")
  380. (which-function-mode 1)
  381. (line-number-mode 0)
  382. (column-number-mode 0)
  383. (size-indication-mode 0)
  384. (setq mode-line-position
  385. '(:eval (format "L%%l/%d%s:C%%c"
  386. (count-lines (point-max)
  387. (point-min))
  388. (if (buffer-narrowed-p)
  389. "[N]"
  390. "")
  391. )))
  392. ;; http://www.geocities.jp/simizu_daisuke/bunkei-meadow.html#frame-title
  393. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  394. ;; minibuffer
  395. (setq insert-default-directory t)
  396. (setq completion-ignore-case t
  397. read-file-name-completion-ignore-case t
  398. read-buffer-completion-ignore-case t)
  399. (setq resize-mini-windows t)
  400. (temp-buffer-resize-mode 1)
  401. (savehist-mode 1)
  402. (defvar display-time-format "%Y/%m/%d %a %H:%M")
  403. (set-variable 'help-at-pt-display-when-idle t)
  404. (fset 'yes-or-no-p 'y-or-n-p)
  405. ;; complete symbol when `eval'
  406. (define-key read-expression-map (kbd "TAB") 'completion-at-point)
  407. (define-key minibuffer-local-map (kbd "C-u")
  408. (lambda () (interactive) (delete-region (point-at-bol) (point))))
  409. ;; I dont know these bindings are good
  410. (define-key minibuffer-local-map (kbd "C-p") (kbd "ESC p"))
  411. (define-key minibuffer-local-map (kbd "C-n") (kbd "ESC n"))
  412. (when (safe-require-or-eval 'minibuffer-line)
  413. (set-face-underline 'minibuffer-line nil)
  414. (set-variable 'minibuffer-line-refresh-interval
  415. 25)
  416. ;; Set idle timer
  417. (defvar my-minibuffer-line--idle-timer nil)
  418. (defvar minibuffer-line-mode)
  419. (add-hook 'minibuffer-line-mode-hook
  420. (lambda ()
  421. (when my-minibuffer-line--idle-timer
  422. (cancel-timer my-minibuffer-line--idle-timer)
  423. (setq my-minibuffer-line--idle-timer nil))
  424. (when minibuffer-line-mode
  425. (setq my-minibuffer-line--idle-timer
  426. (run-with-idle-timer 0.5
  427. t
  428. 'minibuffer-line--update)))))
  429. (set-variable 'minibuffer-line-format
  430. `(,(concat user-login-name
  431. "@"
  432. (car (split-string (system-name)
  433. "\\."))
  434. ":")
  435. (:eval (abbreviate-file-name (or buffer-file-name
  436. default-directory)))
  437. (:eval (and (fboundp 'git-ps1-mode-get-current)
  438. (git-ps1-mode-get-current " [GIT:%s]")))
  439. " "
  440. (:eval (format-time-string display-time-format))))
  441. (minibuffer-line-mode 1)
  442. )
  443. (when (safe-require-or-eval 'prompt-text)
  444. (set-variable 'prompt-text-format
  445. `(,(concat ""
  446. user-login-name
  447. "@"
  448. (car (split-string (system-name)
  449. "\\."))
  450. ":")
  451. (:eval (abbreviate-file-name (or buffer-file-name
  452. default-directory)))
  453. (:eval (and (fboundp 'git-ps1-mode-get-current)
  454. (git-ps1-mode-get-current " [GIT:%s]")))
  455. " "
  456. (:eval (format-time-string display-time-format))
  457. "\n"
  458. (:eval (symbol-name this-command))
  459. ": "))
  460. (prompt-text-mode 1))
  461. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  462. ;; letters, font-lock mode and fonts
  463. (setq text-quoting-style 'grave)
  464. ;; (set-face-background 'vertical-border (face-foreground 'mode-line))
  465. ;; (set-window-margins (selected-window) 1 1)
  466. (unless window-system
  467. (setq frame-background-mode 'dark))
  468. (and (or (eq system-type 'Darwin)
  469. (eq system-type 'darwin))
  470. (fboundp 'mac-set-input-method-parameter)
  471. (mac-set-input-method-parameter 'japanese 'cursor-color "red")
  472. (mac-set-input-method-parameter 'roman 'cursor-color "black"))
  473. (when (and (boundp 'input-method-activate-hook) ; i dont know this is correct
  474. (boundp 'input-method-inactivate-hook))
  475. (add-hook 'input-method-activate-hook
  476. (lambda () (set-cursor-color "red")))
  477. (add-hook 'input-method-inactivate-hook
  478. (lambda () (set-cursor-color "black"))))
  479. (when (safe-require-or-eval 'paren)
  480. (show-paren-mode 1)
  481. (setq show-paren-delay 0.5
  482. show-paren-style 'parenthesis) ; mixed is hard to read
  483. ;; (set-face-background 'show-paren-match
  484. ;; "black")
  485. ;; ;; (face-foreground 'default))
  486. ;; (set-face-foreground 'show-paren-match
  487. ;; "white")
  488. ;; (set-face-inverse-video-p 'show-paren-match
  489. ;; t)
  490. )
  491. (transient-mark-mode 1)
  492. (global-font-lock-mode 1)
  493. (setq font-lock-global-modes
  494. '(not
  495. help-mode
  496. eshell-mode
  497. ;;term-mode
  498. Man-mode
  499. magit-diff-mode
  500. magit-revision-mode))
  501. ;; (standard-display-ascii ?\n "$\n")
  502. ;; (defvar my-eol-face
  503. ;; '(("\n" . (0 font-lock-comment-face t nil)))
  504. ;; )
  505. ;; (defvar my-tab-face
  506. ;; '(("\t" . '(0 highlight t nil))))
  507. (defvar my-jspace-face
  508. '(("\u3000" . '(0 highlight t nil))))
  509. (add-hook 'font-lock-mode-hook
  510. (lambda ()
  511. ;; (font-lock-add-keywords nil my-eol-face)
  512. (font-lock-add-keywords nil my-jspace-face)
  513. ))
  514. (when (safe-require-or-eval 'whitespace)
  515. (add-to-list 'whitespace-display-mappings
  516. ;; We need t since last one takes precedence
  517. `(tab-mark ?\t ,(vconcat "^I\t")) t)
  518. ;; (add-to-list 'whitespace-display-mappings
  519. ;; `(newline-mark ?\n ,(vconcat "$\n")))
  520. (setq whitespace-style '(face
  521. trailing ; trailing blanks
  522. ;; tabs
  523. ;; spaces
  524. ;; lines
  525. lines-tail ; lines over 80
  526. newline ; newlines
  527. empty ; empty lines at beg or end of buffer
  528. ;; big-indent
  529. ;; space-mark
  530. tab-mark
  531. newline-mark ; use display table for newline
  532. ))
  533. ;; (setq whitespace-newline 'font-lock-comment-face)
  534. ;; (setq whitespace-style (delq 'newline-mark whitespace-style))
  535. (defun my-whitesspace-mode-reload ()
  536. "Reload whitespace-mode config."
  537. (interactive)
  538. (when whitespace-mode
  539. (whitespace-mode 0)
  540. (whitespace-mode 1)))
  541. (set-variable 'whitespace-line-column nil)
  542. (global-whitespace-mode t)
  543. (add-hook 'dired-mode-hook
  544. (lambda ()
  545. (set (make-local-variable 'whitespace-style) nil)))
  546. (if (= (display-color-cells)
  547. 256)
  548. (set-face-foreground 'whitespace-newline "color-109")
  549. ;; (progn
  550. ;; (set-face-bold-p 'whitespace-newline
  551. ;; t))
  552. ))
  553. (and nil
  554. '(safe-require-or-eval 'fill-column-indicator)
  555. (setq fill-column-indicator))
  556. ;; highlight current line
  557. ;; http://wiki.riywo.com/index.php?Meadow
  558. (face-spec-set 'hl-line
  559. '((((min-colors 256)
  560. (background dark))
  561. (:background "color-234"))
  562. (((min-colors 256)
  563. (background light))
  564. (:background "color-234"))
  565. (t
  566. (:underline "black"))))
  567. (set-variable 'hl-line-global-modes
  568. '(not
  569. term-mode))
  570. (global-hl-line-mode 1) ;; (hl-line-mode 1)
  571. (set-face-foreground 'font-lock-regexp-grouping-backslash "#666")
  572. (set-face-foreground 'font-lock-regexp-grouping-construct "#f60")
  573. ;;(safe-require-or-eval 'set-modeline-color)
  574. ;; (let ((fg (face-foreground 'default))
  575. ;; (bg (face-background 'default)))
  576. ;; (set-face-background 'mode-line-inactive
  577. ;; (if (face-inverse-video-p 'mode-line) fg bg))
  578. ;; (set-face-foreground 'mode-line-inactive
  579. ;; (if (face-inverse-video-p 'mode-line) bg fg)))
  580. ;; (set-face-underline 'mode-line-inactive
  581. ;; t)
  582. ;; (set-face-underline 'vertical-border
  583. ;; nil)
  584. ;; (when (safe-require-or-eval 'end-mark)
  585. ;; (global-end-mark-mode))
  586. ;; M-x highlight-* to highlight things
  587. (global-hi-lock-mode 1)
  588. (unless (fboundp 'highlight-region-text)
  589. (defun highlight-region-text (beg end)
  590. "Highlight text between BEG and END."
  591. (interactive "r")
  592. (highlight-regexp (regexp-quote (buffer-substring-no-properties beg
  593. end)))
  594. (setq deactivate-mark t)))
  595. (when (safe-require-or-eval 'auto-highlight-symbol)
  596. (set-variable 'ahs-idle-interval 0.6)
  597. (global-auto-highlight-symbol-mode 1))
  598. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  599. ;; file handling
  600. (when (safe-require-or-eval 'editorconfig)
  601. ;; (set-variable 'editorconfig-get-properties-function
  602. ;; 'editorconfig-core-get-properties-hash)
  603. (editorconfig-mode 1)
  604. (set-variable 'editorconfig-mode-lighter " EC")
  605. (with-eval-after-load 'org-src
  606. ;; [*.org\[\*Org Src*\[ c \]*\]]
  607. (add-hook 'org-src-mode-hook
  608. 'editorconfig-mode-apply t)))
  609. (when (fboundp 'editorconfig-custom-majormode)
  610. (add-hook 'editorconfig-custom-hooks
  611. 'editorconfig-custom-majormode))
  612. ;; Add readonly=true to set read-only-mode
  613. (add-hook 'editorconfig-custom-hooks
  614. (lambda (props)
  615. (let ((r (gethash 'readonly props)))
  616. (when (and (string= r "true")
  617. (not buffer-read-only))
  618. (read-only-mode 1)))))
  619. ;; (when (fboundp 'editorconfig-charset-extras)
  620. ;; (add-hook 'editorconfig-custom-hooks
  621. ;; 'editorconfig-charset-extras))
  622. (setq revert-without-query '(".+"))
  623. ;; save cursor position
  624. (when (safe-require-or-eval 'saveplace)
  625. (setq-default save-place t)
  626. (setq save-place-file (concat user-emacs-directory
  627. "places")))
  628. ;; http://www.bookshelf.jp/soft/meadow_24.html#SEC260
  629. (setq make-backup-files t)
  630. (setq vc-make-backup-files t)
  631. ;; (make-directory (expand-file-name "~/.emacsbackup"))
  632. (setq backup-directory-alist
  633. (cons (cons "." (expand-file-name (concat user-emacs-directory
  634. "backup")))
  635. backup-directory-alist))
  636. (setq version-control 't)
  637. (setq delete-old-versions t)
  638. (setq kept-new-versions 20)
  639. (setq auto-save-list-file-prefix (expand-file-name (concat user-emacs-directory
  640. "auto-save/")))
  641. ;; (setq delete-auto-save-files t)
  642. (setq auto-save-visited-interval 8)
  643. (auto-save-visited-mode 1)
  644. (add-to-list 'completion-ignored-extensions ".bak")
  645. (set-variable 'completion-cycle-threshold nil) ;; NEVER use
  646. (setq delete-by-moving-to-trash t)
  647. ;; trash-directory "~/.emacs.d/trash")
  648. (add-hook 'after-save-hook
  649. 'executable-make-buffer-file-executable-if-script-p)
  650. (set-variable 'bookmark-default-file
  651. (expand-file-name (concat user-emacs-directory
  652. "bmk")))
  653. (set-variable 'bookmark-save-flag
  654. 1)
  655. (with-eval-after-load 'recentf
  656. (defvar recentf-exclude)
  657. (defvar bookmark-default-file)
  658. (add-to-list 'recentf-exclude
  659. (regexp-quote bookmark-default-file)))
  660. (when (safe-require-or-eval 'smart-revert)
  661. (smart-revert-on))
  662. ;; autosave
  663. ;; auto-save-visited-mode can be used instead?
  664. ;; (when (safe-require-or-eval 'autosave)
  665. ;; (autosave-set 8))
  666. ;; bookmarks
  667. (define-key ctl-x-map "m" 'list-bookmarks)
  668. ;; vc
  669. (set-variable 'vc-handled-backends '(RCS))
  670. (set-variable 'vc-rcs-register-switches "-l")
  671. (set-variable 'vc-rcs-checkin-switches "-l")
  672. (set-variable 'vc-command-messages t)
  673. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  674. ;; share clipboard with x
  675. ;; this page describes this in details, but only these sexps seem to be needed
  676. ;; http://garin.jp/doc/Linux/xwindow_clipboard
  677. (and nil
  678. (not window-system)
  679. (not (eq window-system 'mac))
  680. (getenv "DISPLAY")
  681. (not (equal (getenv "DISPLAY") ""))
  682. (executable-find "xclip")
  683. ;; (< emacs-major-version 24)
  684. '(safe-require-or-eval 'xclip)
  685. nil
  686. (turn-on-xclip))
  687. (and (eq system-type 'darwin)
  688. (safe-require-or-eval 'pasteboard)
  689. (turn-on-pasteboard))
  690. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  691. ;; some modes and hooks
  692. ;; Include some extra modes
  693. (require 'generic-x)
  694. (when (safe-require-or-eval 'wgrep)
  695. (defvar grep-mode-map)
  696. (define-key grep-mode-map
  697. "e"
  698. 'wgrep-change-to-wgrep-mode))
  699. (with-eval-after-load 'remember
  700. (defvar remember-mode-map (make-sparse-keymap))
  701. (define-key remember-mode-map (kbd "C-x C-s") 'ignore))
  702. (with-eval-after-load 'magit-files
  703. ;; `global-magit-file-mode' is enabled by default and this mode overwrites
  704. ;; existing keybindings.
  705. ;; Apparently it is a HARMFUL behavior and it is really awful that I have
  706. ;; to disable thie mode here, but do anyway.
  707. ;; See also https://github.com/magit/magit/issues/3517
  708. (global-magit-file-mode -1))
  709. (with-eval-after-load 'magit-section
  710. (set-face-background 'magit-section-highlight
  711. nil))
  712. (with-eval-after-load 'magit-diff
  713. (set-face-background 'magit-diff-added-highlight
  714. nil)
  715. (set-face-background 'magit-diff-removed-highlight
  716. nil)
  717. (set-face-background 'magit-diff-context-highlight
  718. nil)
  719. )
  720. (when (boundp 'git-rebase-filename-regexp)
  721. (add-to-list 'auto-mode-alist
  722. `(,git-rebase-filename-regexp . text-mode)))
  723. (when (safe-require-or-eval 'aggressive-indent)
  724. (defvar aggressive-indent-excluded-modes)
  725. (setq aggressive-indent-excluded-modes
  726. `(diff-mode
  727. toml-mode
  728. conf-mode
  729. dockerfile-mode
  730. groovy-mode
  731. ,@aggressive-indent-excluded-modes))
  732. (global-aggressive-indent-mode 1))
  733. (when (autoload-eval-lazily 'ggtags)
  734. (add-hook 'c-mode-common-hook
  735. (lambda ()
  736. (when (derived-mode-p 'c-mode 'c++-mode 'java-mode)
  737. (ggtags-mode 1))))
  738. (add-hook 'python-mode-hook
  739. (lambda ()
  740. (ggtags-mode 1))))
  741. (when (autoload-eval-lazily 'imenu-list)
  742. ;; (set-variable 'imenu-list-auto-resize t)
  743. (set-variable 'imenu-list-focus-after-activation t)
  744. (define-key ctl-x-map "l" 'imenu-list-smart-toggle))
  745. (add-hook 'emacs-lisp-mode-hook
  746. (lambda ()
  747. (setq imenu-generic-expression
  748. `(("Sections" ";;;\+\n;; \\(.*\\)\n" 1)
  749. ,@imenu-generic-expression))))
  750. (with-eval-after-load 'compile
  751. (defvar compilation-filter-start)
  752. (defvar compilation-error-regexp-alist)
  753. (require 'ansi-color)
  754. (add-hook 'compilation-filter-hook
  755. (lambda ()
  756. (let ((inhibit-read-only t))
  757. (ansi-color-apply-on-region compilation-filter-start
  758. (point)))))
  759. (add-to-list 'compilation-error-regexp-alist
  760. ;; ansible-lint
  761. '("^\\([^ \n]+\\):\\([0-9]+\\)$" 1 2)))
  762. ;; Workaround to avoid ensime error
  763. (defvar ensime-mode-key-prefix nil)
  764. ;; http://qiita.com/sune2/items/b73037f9e85962f5afb7
  765. (when (safe-require-or-eval 'company)
  766. (global-company-mode)
  767. (set-variable 'company-idle-delay 0.5)
  768. (set-variable 'company-minimum-prefix-length 2)
  769. (set-variable 'company-selection-wrap-around t))
  770. ;; https://github.com/lunaryorn/flycheck
  771. (when (safe-require-or-eval 'flycheck)
  772. (call-after-init 'global-flycheck-mode))
  773. (when (autoload-eval-lazily 'ilookup)
  774. (define-key ctl-x-map "d" 'ilookup-open-word))
  775. (set-variable 'ac-ignore-case nil)
  776. (when (autoload-eval-lazily 'term-run '(term-run-shell-command term-run))
  777. (define-key ctl-x-map "t" 'term-run-shell-command))
  778. (add-to-list 'safe-local-variable-values
  779. '(encoding utf-8))
  780. (setq enable-local-variables :safe)
  781. ;; Detect file type from shebang and set major-mode.
  782. (add-to-list 'interpreter-mode-alist
  783. '("python3" . python-mode))
  784. (add-to-list 'interpreter-mode-alist
  785. '("python2" . python-mode))
  786. (with-eval-after-load 'python
  787. (defvar python-mode-map (make-sparse-keymap))
  788. (define-key python-mode-map (kbd "C-m") 'newline-and-indent))
  789. (when (autoload-eval-lazily 'pipenv)
  790. (add-hook 'python-mode-hook
  791. (lambda ()
  792. (pipenv-mode 1)
  793. (pipenv-projectile-after-switch-default)))
  794. )
  795. (set-variable 'flycheck-python-pycompile-executable "python3")
  796. ;; http://fukuyama.co/foreign-regexp
  797. '(and (safe-require-or-eval 'foreign-regexp)
  798. (progn
  799. (setq foreign-regexp/regexp-type 'perl)
  800. '(setq reb-re-syntax 'foreign-regexp)
  801. ))
  802. (autoload-eval-lazily 'sql '(sql-mode)
  803. (require 'sql-indent nil t))
  804. (when (autoload-eval-lazily 'git-command)
  805. (define-key ctl-x-map "g" 'git-command))
  806. (when (safe-require-or-eval 'git-commit)
  807. (global-git-commit-mode 1))
  808. (with-eval-after-load 'git-commit
  809. (add-hook 'git-commit-setup-hook
  810. 'turn-off-auto-fill t))
  811. (autoload-eval-lazily 'sl)
  812. (with-eval-after-load 'rst
  813. (defvar rst-mode-map)
  814. (define-key rst-mode-map (kbd "C-m") 'newline-and-indent))
  815. (with-eval-after-load 'jdee
  816. (add-hook 'jdee-mode-hook
  817. (lambda ()
  818. (make-local-variable 'global-mode-string)
  819. (add-to-list 'global-mode-string
  820. mode-line-position))))
  821. ;; Cannot enable error thrown. Why???
  822. ;; https://github.com/m0smith/malabar-mode#Installation
  823. ;; (when (autoload-eval-lazily 'malabar-mode)
  824. ;; (add-to-list 'load-path
  825. ;; (expand-file-name (concat user-emacs-directory "/cedet")))
  826. ;; (safe-require-or-eval 'cedet-devel-load)
  827. ;; (call-after-init 'activate-malabar-mode))
  828. (with-eval-after-load 'make-mode
  829. (defvar makefile-mode-map (make-sparse-keymap))
  830. (define-key makefile-mode-map (kbd "C-m") 'newline-and-indent)
  831. ;; this functions is set in write-file-functions, i cannot find any
  832. ;; good way to remove this.
  833. (fset 'makefile-warn-suspicious-lines 'ignore))
  834. (with-eval-after-load 'verilog-mode
  835. (defvar verilog-mode-map (make-sparse-keymap))
  836. (define-key verilog-mode-map ";" 'self-insert-command))
  837. (setq diff-switches "-u")
  838. (with-eval-after-load 'diff-mode
  839. ;; (when (and (eq major-mode
  840. ;; 'diff-mode)
  841. ;; (not buffer-file-name))
  842. ;; ;; do not pass when major-mode is derived mode of diff-mode
  843. ;; (view-mode 1))
  844. (set-face-attribute 'diff-header nil
  845. :foreground nil
  846. :background nil
  847. :weight 'bold)
  848. (set-face-attribute 'diff-file-header nil
  849. :foreground nil
  850. :background nil
  851. :weight 'bold)
  852. (set-face-foreground 'diff-index "blue")
  853. (set-face-attribute 'diff-hunk-header nil
  854. :foreground "cyan"
  855. :weight 'normal)
  856. (set-face-attribute 'diff-context nil
  857. ;; :foreground "white"
  858. :foreground nil
  859. :weight 'normal)
  860. (set-face-foreground 'diff-removed "red")
  861. (set-face-foreground 'diff-added "green")
  862. (set-face-background 'diff-removed nil)
  863. (set-face-background 'diff-added nil)
  864. (set-face-attribute 'diff-changed nil
  865. :foreground "magenta"
  866. :weight 'normal)
  867. (set-face-attribute 'diff-refine-changed nil
  868. :foreground nil
  869. :background nil
  870. :weight 'bold
  871. :inverse-video t)
  872. ;; Annoying !
  873. ;;(diff-auto-refine-mode)
  874. )
  875. ;; (ffap-bindings)
  876. (set-variable 'browse-url-browser-function
  877. 'eww-browse-url)
  878. (set-variable 'sh-here-document-word "__EOC__")
  879. (when (autoload-eval-lazily 'adoc-mode
  880. nil
  881. (defvar adoc-mode-map (make-sparse-keymap))
  882. (define-key adoc-mode-map (kbd "C-m") 'newline))
  883. (setq auto-mode-alist
  884. `(("\\.adoc\\'" . adoc-mode)
  885. ("\\.asciidoc\\'" . adoc-mode)
  886. ,@auto-mode-alist)))
  887. (with-eval-after-load 'markup-faces
  888. ;; Is this too match ?
  889. (set-face-foreground 'markup-meta-face
  890. "color-245")
  891. (set-face-foreground 'markup-meta-hide-face
  892. "color-245")
  893. )
  894. ;; TODO: check if this is required
  895. (when (autoload-eval-lazily 'groovy-mode nil
  896. (defvar groovy-mode-map (make-sparse-keymap))
  897. (define-key groovy-mode-map "(" 'self-insert-command)
  898. (define-key groovy-mode-map ")" 'self-insert-command)
  899. (define-key groovy-mode-map (kbd "C-m") 'newline-and-indent)
  900. )
  901. (add-to-list 'auto-mode-alist
  902. '("build\\.gradle\\'" . groovy-mode)))
  903. (with-eval-after-load 'yaml-mode
  904. (defvar yaml-mode-map (make-sparse-keymap))
  905. (define-key yaml-mode-map (kbd "C-m") 'newline))
  906. (with-eval-after-load 'html-mode
  907. (defvar html-mode-map (make-sparse-keymap))
  908. (define-key html-mode-map (kbd "C-m") 'reindent-then-newline-and-indent))
  909. (with-eval-after-load 'text-mode
  910. (define-key text-mode-map (kbd "C-m") 'newline))
  911. (autoload-eval-lazily 'info nil
  912. (defvar Info-additional-directory-list)
  913. (dolist (dir (directory-files (concat user-emacs-directory
  914. "info")
  915. t
  916. "^[^.].*"))
  917. (when (file-directory-p dir)
  918. (add-to-list 'Info-additional-directory-list
  919. dir)))
  920. (let ((dir (expand-file-name "~/.brew/share/info")))
  921. (when (file-directory-p dir)
  922. (add-to-list 'Info-additional-directory-list
  923. dir))))
  924. (with-eval-after-load 'apropos
  925. (defvar apropos-mode-map (make-sparse-keymap))
  926. (define-key apropos-mode-map "n" 'next-line)
  927. (define-key apropos-mode-map "p" 'previous-line))
  928. ;; `isearch' library does not call `provide' so cannot use with-eval-after-load
  929. ;; (define-key isearch-mode-map
  930. ;; (kbd "C-j") 'isearch-other-control-char)
  931. ;; (define-key isearch-mode-map
  932. ;; (kbd "C-k") 'isearch-other-control-char)
  933. ;; (define-key isearch-mode-map
  934. ;; (kbd "C-h") 'isearch-other-control-char)
  935. (define-key isearch-mode-map (kbd "C-h") 'isearch-del-char)
  936. (define-key isearch-mode-map (kbd "M-r")
  937. 'isearch-query-replace-regexp)
  938. ;; do not cleanup isearch highlight: use `lazy-highlight-cleanup' to remove
  939. (setq lazy-highlight-cleanup nil)
  940. ;; face for isearch highlighing
  941. (set-face-attribute 'lazy-highlight
  942. nil
  943. :foreground `unspecified
  944. :background `unspecified
  945. :underline t
  946. ;; :weight `bold
  947. )
  948. (add-hook 'outline-mode-hook
  949. (lambda ()
  950. (when (string-match "\\.md\\'" buffer-file-name)
  951. (set (make-local-variable 'outline-regexp) "#+ "))))
  952. (add-hook 'outline-mode-hook
  953. 'outline-show-all)
  954. (add-to-list 'auto-mode-alist (cons "\\.ol\\'" 'outline-mode))
  955. (add-to-list 'auto-mode-alist (cons "\\.md\\'" 'outline-mode))
  956. (when (autoload-eval-lazily 'markdown-mode
  957. '(markdown-mode gfm-mode)
  958. (defvar gfm-mode-map (make-sparse-keymap))
  959. (define-key gfm-mode-map (kbd "C-m") 'electric-indent-just-newline))
  960. (add-to-list 'auto-mode-alist (cons "\\.md\\'" 'gfm-mode))
  961. (set-variable 'markdown-command (or (executable-find "markdown")
  962. (executable-find "markdown.pl")
  963. ""))
  964. (add-hook 'markdown-mode-hook
  965. (lambda ()
  966. (outline-minor-mode 1)
  967. (flyspell-mode)
  968. (set (make-local-variable 'comment-start) ";")))
  969. )
  970. ;; c-mode
  971. ;; http://www.emacswiki.org/emacs/IndentingC
  972. ;; http://en.wikipedia.org/wiki/Indent_style
  973. ;; http://d.hatena.ne.jp/emergent/20070203/1170512717
  974. ;; http://seesaawiki.jp/whiteflare503/d/Emacs%20%a5%a4%a5%f3%a5%c7%a5%f3%a5%c8
  975. (with-eval-after-load 'cc-vars
  976. (defvar c-default-style nil)
  977. (add-to-list 'c-default-style
  978. '(c-mode . "k&r"))
  979. (add-to-list 'c-default-style
  980. '(c++-mode . "k&r")))
  981. (autoload-eval-lazily 'js2-mode nil
  982. ;; currently do not use js2-mode
  983. ;; (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
  984. ;; (add-to-list 'auto-mode-alist '("\\.jsm\\'" . js2-mode))
  985. ;; (defvar js2-mode-map (make-sparse-keymap))
  986. ;; (define-key js2-mode-map (kbd "C-m") (lambda ()
  987. ;; (interactive)
  988. ;; (js2-enter-key)
  989. ;; (indent-for-tab-command)))
  990. ;; (add-hook (kill-local-variable 'before-save-hook)
  991. ;; 'js2-before-save)
  992. ;; (add-hook 'before-save-hook
  993. ;; 'my-indent-buffer
  994. ;; nil
  995. ;; t)
  996. )
  997. (add-to-list 'interpreter-mode-alist
  998. '("node" . js-mode))
  999. (add-hook 'haskell-mode-hook 'turn-on-haskell-indentation)
  1000. (with-eval-after-load 'uniquify
  1001. (setq uniquify-buffer-name-style 'post-forward-angle-brackets)
  1002. (setq uniquify-ignore-buffers-re "*[^*]+*")
  1003. (setq uniquify-min-dir-content 1))
  1004. (with-eval-after-load 'view
  1005. (defvar view-mode-map (make-sparse-keymap))
  1006. (define-key view-mode-map "j" 'scroll-up-line)
  1007. (define-key view-mode-map "k" 'scroll-down-line)
  1008. (define-key view-mode-map "v" 'toggle-read-only)
  1009. (define-key view-mode-map "q" 'bury-buffer)
  1010. ;; (define-key view-mode-map "/" 'nonincremental-re-search-forward)
  1011. ;; (define-key view-mode-map "?" 'nonincremental-re-search-backward)
  1012. ;; (define-key view-mode-map
  1013. ;; "n" 'nonincremental-repeat-search-forward)
  1014. ;; (define-key view-mode-map
  1015. ;; "N" 'nonincremental-repeat-search-backward)
  1016. (define-key view-mode-map "/" 'isearch-forward-regexp)
  1017. (define-key view-mode-map "?" 'isearch-backward-regexp)
  1018. (define-key view-mode-map "n" 'isearch-repeat-forward)
  1019. (define-key view-mode-map "N" 'isearch-repeat-backward)
  1020. (define-key view-mode-map (kbd "C-m") 'my-rgrep-symbol-at-point))
  1021. (global-set-key "\M-r" 'view-mode)
  1022. ;; (setq view-read-only t)
  1023. (with-eval-after-load 'term
  1024. (defvar term-raw-map (make-sparse-keymap))
  1025. (define-key term-raw-map (kbd "C-x")
  1026. (lookup-key (current-global-map)
  1027. (kbd "C-x"))))
  1028. (add-hook 'term-mode-hook
  1029. (lambda ()
  1030. ;; Stop current line highlighting
  1031. (set (make-local-variable (defvar hl-line-range-function))
  1032. (lambda () '(0 . 0)))
  1033. (set (make-local-variable 'scroll-margin)
  1034. 0)))
  1035. (add-hook 'Man-mode-hook
  1036. (lambda ()
  1037. (view-mode 1)
  1038. (setq truncate-lines nil)))
  1039. (set-variable 'Man-notify-method (if window-system
  1040. 'newframe
  1041. 'aggressive))
  1042. (set-variable 'woman-cache-filename (expand-file-name (concat user-emacs-directory
  1043. "woman_cache.el")))
  1044. ;; not work because man.el will be loaded when man called
  1045. (defalias 'man 'woman)
  1046. (add-to-list 'auto-mode-alist
  1047. '("tox\\.ini\\'" . conf-unix-mode))
  1048. (when (autoload-eval-lazily 'toml-mode)
  1049. (add-to-list 'auto-mode-alist
  1050. '("/tox\\.ini\\'" . toml-mode))
  1051. (add-to-list 'auto-mode-alist
  1052. '("/Pipfile\\'" . toml-mode)))
  1053. (when (autoload-eval-lazily 'json-mode)
  1054. (add-to-list 'auto-mode-alist
  1055. '("/Pipfile\\.lock\\'" . json-mode)))
  1056. (add-hook 'go-mode-hook
  1057. (lambda()
  1058. (defvar go-mode-map)
  1059. (add-hook 'before-save-hook' 'gofmt-before-save)
  1060. (define-key go-mode-map (kbd "M-.") 'godef-jump)))
  1061. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1062. ;; buffers
  1063. (defvar bs-configurations)
  1064. (when (autoload-eval-lazily 'bs '(bs-show)
  1065. (add-to-list 'bs-configurations
  1066. '("specials" "^\\*" nil ".*" nil nil))
  1067. (add-to-list 'bs-configurations
  1068. '("files-and-specials" "^\\*" buffer-file-name ".*" nil nil))
  1069. (defvar bs-mode-map)
  1070. (defvar bs-current-configuration)
  1071. (define-key bs-mode-map (kbd "t")
  1072. ;; TODO: fix toggle feature
  1073. (lambda ()
  1074. (interactive)
  1075. (if (string= "specials"
  1076. bs-current-configuration)
  1077. (bs-set-configuration "files")
  1078. (bs-set-configuration "specials"))
  1079. (bs-refresh)
  1080. (bs-message-without-log "%s"
  1081. (bs--current-config-message))))
  1082. ;; (setq bs-configurations (list
  1083. ;; '("processes" nil get-buffer-process ".*" nil nil)
  1084. ;; '("files-and-scratch" "^\\*scratch\\*$" nil nil
  1085. ;; bs-visits-non-file bs-sort-buffer-interns-are-last)))
  1086. )
  1087. (defalias 'list-buffers 'bs-show)
  1088. (set-variable 'bs-default-configuration "files-and-specials")
  1089. (set-variable 'bs-default-sort-name "by nothing")
  1090. (add-hook 'bs-mode-hook
  1091. (lambda ()
  1092. (set (make-local-variable 'scroll-margin) 0))))
  1093. ;;(iswitchb-mode 1)
  1094. (icomplete-mode)
  1095. (defun iswitchb-buffer-display-other-window ()
  1096. "Do iswitchb in other window."
  1097. (interactive)
  1098. (let ((iswitchb-default-method 'display))
  1099. (call-interactively 'iswitchb-buffer)))
  1100. ;; buffer killing
  1101. ;; (defun my-delete-window-killing-buffer () nil)
  1102. (defun my-query-kill-current-buffer ()
  1103. "Interactively kill current buffer."
  1104. (interactive)
  1105. (if (y-or-n-p (concat "kill current buffer? :"))
  1106. (kill-buffer (current-buffer))))
  1107. ;;(global-set-key "\C-xk" 'my-query-kill-current-buffer)
  1108. (substitute-key-definition 'kill-buffer
  1109. 'my-query-kill-current-buffer
  1110. global-map)
  1111. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1112. ;; recentf-mode
  1113. (set-variable 'recentf-save-file (expand-file-name (concat user-emacs-directory
  1114. "recentf")))
  1115. (set-variable 'recentf-max-menu-items 20)
  1116. (set-variable 'recentf-max-saved-items 30)
  1117. (set-variable 'recentf-show-file-shortcuts-flag nil)
  1118. (set-variable 'recentf-auto-cleanup 3)
  1119. ;; (safe-require-or-eval 'sync-recentf)
  1120. ;; (when (safe-require-or-eval 'recentf)
  1121. ;; (add-to-list 'recentf-exclude
  1122. ;; (regexp-quote recentf-save-file))
  1123. ;; (add-to-list 'recentf-exclude
  1124. ;; (regexp-quote (expand-file-name user-emacs-directory)))
  1125. ;; (add-to-list 'recentf-exclude
  1126. ;; "/sync-recentf-marker\\'")
  1127. ;; (define-key ctl-x-map (kbd "C-r") 'recentf-open-files)
  1128. ;; (remove-hook 'find-file-hook
  1129. ;; 'recentf-track-opened-file)
  1130. ;; (defun my-recentf-load-track-save-list ()
  1131. ;; "Load current recentf list from file, track current visiting file, then save
  1132. ;; the list."
  1133. ;; (recentf-load-list)
  1134. ;; (recentf-track-opened-file)
  1135. ;; (recentf-save-list))
  1136. ;; (add-hook 'find-file-hook
  1137. ;; 'my-recentf-load-track-save-list)
  1138. ;; (add-hook 'kill-emacs-hook
  1139. ;; 'recentf-load-list)
  1140. ;; ;;(run-with-idle-timer 5 t 'recentf-save-list)
  1141. ;; ;; (add-hook 'find-file-hook
  1142. ;; ;; (lambda ()
  1143. ;; ;; (recentf-add-file default-directory)))
  1144. ;; (when (autoload-eval-lazily 'recentf-show)
  1145. ;; (define-key ctl-x-map (kbd "C-r") 'recentf-show)
  1146. ;; ;; (add-hook 'recentf-show-before-listing-hook
  1147. ;; ;; 'recentf-load-list)
  1148. ;; )
  1149. ;; (recentf-mode 1)
  1150. ;; (define-key recentf-dialog-mode-map (kbd "<up>") 'previous-line)
  1151. ;; (define-key recentf-dialog-mode-map (kbd "<down>") 'next-line)
  1152. ;; (define-key recentf-dialog-mode-map "p" 'previous-line)
  1153. ;; (define-key recentf-dialog-mode-map "n" 'next-line)
  1154. ;; (add-hook 'recentf-dialog-mode-hook
  1155. ;; (lambda ()
  1156. ;; ;; (recentf-save-list)
  1157. ;; ;; (define-key recentf-dialog-mode-map (kbd "C-x C-f")
  1158. ;; ;; 'my-recentf-cd-and-find-file)
  1159. ;; (cd "~/"))))
  1160. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1161. ;; dired
  1162. (defun my-file-head (filename &optional n)
  1163. "Return list of first N lines of file FILENAME."
  1164. ;; TODO: Fix for janapese text
  1165. ;; TODO: Fix for short text
  1166. (let ((num (or n 10))
  1167. (size 100)
  1168. (beg 0)
  1169. (end 0)
  1170. (result '())
  1171. (read -1))
  1172. (with-temp-buffer
  1173. (erase-buffer)
  1174. (while (or (<= (count-lines (point-min)
  1175. (point-max))
  1176. num)
  1177. (eq read 0))
  1178. (setq end (+ beg size))
  1179. (setq read (nth 1 (insert-file-contents-literally filename
  1180. nil
  1181. beg
  1182. end)))
  1183. (goto-char (point-max))
  1184. (setq beg (+ beg size)))
  1185. (goto-char (point-min))
  1186. (while (< (length result) num)
  1187. (let ((start (point)))
  1188. (forward-line 1)
  1189. (setq result
  1190. `(,@result ,(buffer-substring-no-properties start
  1191. (point))))))
  1192. result
  1193. ;; (buffer-substring-no-properties (point-min)
  1194. ;; (progn
  1195. ;; (forward-line num)
  1196. ;; (point)))
  1197. )))
  1198. ;; (apply 'concat (my-file-head "./shrc" 10)
  1199. (defun my-dired-echo-file-head (arg)
  1200. "Echo head of current file.
  1201. ARG is num to show, or defaults to 7."
  1202. (interactive "P")
  1203. (let ((f (dired-get-filename)))
  1204. (message "%s"
  1205. (apply 'concat
  1206. (my-file-head f
  1207. 7)))))
  1208. (defun my-dired-diff ()
  1209. "Show diff of marked file and file of current line."
  1210. (interactive)
  1211. (let ((files (dired-get-marked-files nil nil nil t)))
  1212. (if (eq (car files)
  1213. t)
  1214. (diff (cadr files) (dired-get-filename))
  1215. (message "One file must be marked!"))))
  1216. (defun dired-get-file-info ()
  1217. "Print information of current line file."
  1218. (interactive)
  1219. (let ((f (shell-quote-argument (dired-get-filename t))))
  1220. (if (file-directory-p f)
  1221. (progn
  1222. (message "Calculating disk usage...")
  1223. (shell-command (concat "du -hsD "
  1224. f)))
  1225. (shell-command (concat "file "
  1226. f)))))
  1227. (defun my-dired-scroll-up ()
  1228. "Scroll up."
  1229. (interactive)
  1230. (my-dired-previous-line (- (window-height) 1)))
  1231. (defun my-dired-scroll-down ()
  1232. "Scroll down."
  1233. (interactive)
  1234. (my-dired-next-line (- (window-height) 1)))
  1235. ;; (defun my-dired-forward-line (arg)
  1236. ;; ""
  1237. ;; (interactive "p"))
  1238. (defun my-dired-previous-line (arg)
  1239. "Move ARG lines up."
  1240. (interactive "p")
  1241. (if (> arg 0)
  1242. (progn
  1243. (if (eq (line-number-at-pos)
  1244. 1)
  1245. (goto-char (point-max))
  1246. (forward-line -1))
  1247. (my-dired-previous-line (if (or (dired-get-filename nil t)
  1248. (dired-get-subdir))
  1249. (- arg 1)
  1250. arg)))
  1251. (dired-move-to-filename)))
  1252. (defun my-dired-next-line (arg)
  1253. "Move ARG lines down."
  1254. (interactive "p")
  1255. (if (> arg 0)
  1256. (progn
  1257. (if (eq (point)
  1258. (point-max))
  1259. (goto-char (point-min))
  1260. (forward-line 1))
  1261. (my-dired-next-line (if (or (dired-get-filename nil t)
  1262. (dired-get-subdir))
  1263. (- arg 1)
  1264. arg)))
  1265. (dired-move-to-filename)))
  1266. (defun my-tramp-remote-find-file (f)
  1267. "Open F."
  1268. (interactive (list (read-file-name "My Find File Tramp: "
  1269. "/scp:"
  1270. nil ;; "/scp:"
  1271. (confirm-nonexistent-file-or-buffer))))
  1272. (find-file f))
  1273. ;;http://bach.istc.kobe-u.ac.jp/lect/tamlab/ubuntu/emacs.html
  1274. (if (eq window-system 'mac)
  1275. (setq dired-listing-switches "-lhF")
  1276. (setq dired-listing-switches "-lhF --time-style=long-iso")
  1277. )
  1278. (setq dired-listing-switches "-lhF")
  1279. ;; when using dired-find-alternate-file
  1280. ;; reuse current dired buffer for the file to open
  1281. ;; (put 'dired-find-alternate-file 'disabled nil)
  1282. (set-variable 'dired-ls-F-marks-symlinks t)
  1283. (set-variable 'ls-lisp-use-insert-directory-program nil) ; always use ls-lisp
  1284. (set-variable 'ls-lisp-dirs-first t)
  1285. (set-variable 'ls-lisp-use-localized-time-format t)
  1286. (set-variable 'ls-lisp-format-time-list
  1287. '("%Y-%m-%d %H:%M"
  1288. "%Y-%m-%d "))
  1289. (set-variable 'dired-dwim-target t)
  1290. (set-variable 'dired-isearch-filenames t)
  1291. (set-variable 'dired-hide-details-hide-symlink-targets nil)
  1292. (set-variable 'dired-hide-details-hide-information-lines nil)
  1293. (set-variable 'dired-deletion-confirmer 'y-or-n-p)
  1294. (set-variable 'dired-recursive-deletes 'always)
  1295. ;; (add-hook 'dired-after-readin-hook
  1296. ;; 'my-replace-nasi-none)
  1297. (with-eval-after-load 'dired
  1298. (safe-require-or-eval 'ls-lisp)
  1299. (defvar dired-mode-map (make-sparse-keymap))
  1300. ;; dired-do-chgrp sometimes cause system hung
  1301. (define-key dired-mode-map "G" 'ignore)
  1302. (define-key dired-mode-map "e" 'wdired-change-to-wdired-mode)
  1303. (define-key dired-mode-map "i" 'dired-get-file-info)
  1304. (define-key dired-mode-map "f" 'find-file)
  1305. (define-key dired-mode-map "!" 'shell-command)
  1306. (define-key dired-mode-map "&" 'async-shell-command)
  1307. (define-key dired-mode-map "X" 'dired-do-async-shell-command)
  1308. (define-key dired-mode-map "=" 'my-dired-diff)
  1309. (define-key dired-mode-map "B" 'gtkbm-add-current-dir)
  1310. (define-key dired-mode-map "b" 'gtkbm)
  1311. (define-key dired-mode-map "h" 'my-dired-echo-file-head)
  1312. (define-key dired-mode-map (kbd "TAB") 'other-window)
  1313. ;; (define-key dired-mode-map "P" 'my-dired-do-pack-or-unpack)
  1314. (define-key dired-mode-map "/" 'dired-isearch-filenames)
  1315. (define-key dired-mode-map (kbd "DEL") 'dired-up-directory)
  1316. (define-key dired-mode-map (kbd "C-h") 'dired-up-directory)
  1317. (substitute-key-definition 'dired-next-line
  1318. 'my-dired-next-line
  1319. dired-mode-map)
  1320. (substitute-key-definition 'dired-previous-line
  1321. 'my-dired-previous-line
  1322. dired-mode-map)
  1323. ;; (define-key dired-mode-map (kbd "C-p") 'my-dired-previous-line)
  1324. ;; (define-key dired-mode-map (kbd "p") 'my-dired-previous-line)
  1325. ;; (define-key dired-mode-map (kbd "C-n") 'my-dired-next-line)
  1326. ;; (define-key dired-mode-map (kbd "n") 'my-dired-next-line)
  1327. (define-key dired-mode-map (kbd "<left>") 'my-dired-scroll-up)
  1328. (define-key dired-mode-map (kbd "<right>") 'my-dired-scroll-down)
  1329. (define-key dired-mode-map (kbd "ESC p") 'my-dired-scroll-up)
  1330. (define-key dired-mode-map (kbd "ESC n") 'my-dired-scroll-down)
  1331. (add-hook 'dired-mode-hook
  1332. (lambda ()
  1333. (when (fboundp 'dired-hide-details-mode)
  1334. (dired-hide-details-mode t)
  1335. (local-set-key "l" 'dired-hide-details-mode))
  1336. (let ((file "._Icon\015"))
  1337. (when nil
  1338. '(file-readable-p file)
  1339. (delete-file file)))))
  1340. (when (autoload-eval-lazily 'pack '(dired-do-pack-or-unpack pack-pack))
  1341. (with-eval-after-load 'dired
  1342. (define-key dired-mode-map "P" 'pack-dired-dwim)))
  1343. (when (autoload-eval-lazily 'dired-list-all-mode)
  1344. (setq dired-listing-switches "-lhF")
  1345. (with-eval-after-load 'dired
  1346. (define-key dired-mode-map "a" 'dired-list-all-mode))))
  1347. (when (autoload-eval-lazily 'dired-filter)
  1348. (add-hook 'dired-mode-hook
  1349. 'dired-filter-mode))
  1350. ;; Currently disabled in favor of dired-from-git-ls-files
  1351. ;; (define-key ctl-x-map "f" 'find-dired)
  1352. ;; It works!
  1353. ;; (pop-to-buffer (dired-noselect '("." "shrc" "emacs.el")))
  1354. (defun my-dired-git-ls-files (args)
  1355. "Dired from git ls-files."
  1356. (interactive "sgit ls-files args: ")
  1357. (pop-to-buffer-same-window
  1358. (dired-noselect `(,default-directory
  1359. ,@(split-string (shell-command-to-string (concat "git ls-files -z " args))
  1360. "\0" t))
  1361. ""))
  1362. )
  1363. (define-key ctl-x-map (kbd "f") 'my-dired-git-ls-files)
  1364. (with-eval-after-load 'dired
  1365. (defvar dired-mode-map (make-sparse-keymap))
  1366. (define-key dired-mode-map "f" 'my-dired-git-ls-files))
  1367. ;; (define-minor-mode my-dired-glob-filter)
  1368. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1369. ;; misc funcs
  1370. (defalias 'qcalc 'quick-calc)
  1371. (defun memo (&optional dir)
  1372. "Open memo.txt in DIR."
  1373. (interactive)
  1374. (pop-to-buffer (find-file-noselect (concat (if dir
  1375. (file-name-as-directory dir)
  1376. "")
  1377. "memo.txt"))))
  1378. (set (defvar my-rgrep-alist nil
  1379. "Alist of rgrep command.
  1380. Each element is in the form like (NAME SEXP COMMAND), where SEXP returns the
  1381. condition to choose COMMAND when evaluated.")
  1382. `(
  1383. ;; ripgrep
  1384. ("rg"
  1385. (executable-find "rg")
  1386. "rg --hidden --no-heading --smart-case ")
  1387. ;; git grep
  1388. ("gitgrep"
  1389. (eq 0
  1390. (shell-command "git rev-parse --git-dir"))
  1391. "git --no-pager -c color.grep=always grep -nH -e ")
  1392. ;; sift
  1393. ("sift"
  1394. (executable-find "sift")
  1395. ("sift --binary-skip --filename --line-number --git --smart-case "))
  1396. ;; the silver searcher
  1397. ("ag"
  1398. (executable-find "ag")
  1399. "ag --nogroup --nopager --filename ")
  1400. ;; ack
  1401. ("ack"
  1402. (executable-find "ack")
  1403. "ack --nogroup --nopager --with-filename ")
  1404. ;; gnu global
  1405. ("global"
  1406. (and (require 'ggtags nil t)
  1407. (executable-find "global")
  1408. (ggtags-current-project-root))
  1409. "global --result grep ")
  1410. ;; grep
  1411. ("grep"
  1412. t
  1413. ,(concat "find . "
  1414. "-path '*/.git' -prune -o "
  1415. "-path '*/.svn' -prune -o "
  1416. "-type f -print0 | "
  1417. "xargs -0 grep -nH -e "))
  1418. )
  1419. )
  1420. (defvar my-rgrep-default nil
  1421. "Default command name for my-rgrep.")
  1422. (defun my-rgrep-grep-command (&optional name alist)
  1423. "Return recursive grep command for current directory or nil.
  1424. If NAME is given, use that without testing.
  1425. Commands are searched from ALIST."
  1426. (if alist
  1427. (if name
  1428. ;; if name is given search that from alist and return the command
  1429. (nth 2 (assoc name
  1430. alist))
  1431. ;; if name is not given try test in 1th elem
  1432. (let ((car (car alist))
  1433. (cdr (cdr alist)))
  1434. (if (eval (nth 1 car))
  1435. ;; if the condition is true return the command
  1436. (nth 2 car)
  1437. ;; try next one
  1438. (and cdr
  1439. (my-rgrep-grep-command name cdr)))))
  1440. ;; if alist is not given set default value
  1441. (my-rgrep-grep-command name my-rgrep-alist)))
  1442. (defun my-rgrep (command-args)
  1443. "My recursive grep. Run COMMAND-ARGS.
  1444. If prefix argument is given, use current symbol as default search target
  1445. and search from projectile root (if projectile is available)."
  1446. (interactive (let ((cmd (my-rgrep-grep-command my-rgrep-default
  1447. nil)))
  1448. (if cmd
  1449. (list (read-shell-command "grep command: "
  1450. (concat cmd
  1451. (if current-prefix-arg
  1452. (thing-at-point 'symbol t)
  1453. ""))
  1454. 'grep-find-history))
  1455. (error "My-Rgrep: Command for rgrep not found")
  1456. )))
  1457. (if (and current-prefix-arg
  1458. (safe-require-or-eval 'projectile)
  1459. (projectile-project-p))
  1460. (projectile-with-default-dir (projectile-project-root)
  1461. (compilation-start command-args
  1462. 'grep-mode))
  1463. (compilation-start command-args
  1464. 'grep-mode)))
  1465. (defun my-rgrep-thing-at-point-projectile-root ()
  1466. "My recursive grep to find thing at point from project root."
  1467. (interactive)
  1468. (let* ((cmd (my-rgrep-grep-command my-rgrep-default
  1469. nil))
  1470. (command-args
  1471. (if cmd
  1472. (concat cmd
  1473. (or (thing-at-point 'symbol t)
  1474. (error "No symbol at point")))
  1475. (error "My-Rgrep: Command for rgrep not found"))))
  1476. (if (safe-require-or-eval 'projectile)
  1477. (projectile-with-default-dir (or (projectile-project-root)
  1478. default-directory)
  1479. (compilation-start command-args
  1480. 'grep-mode))
  1481. (compilation-start command-args
  1482. 'grep-mode))))
  1483. (defmacro define-my-rgrep (name)
  1484. "Define rgrep for NAME."
  1485. `(defun ,(intern (concat "my-rgrep-"
  1486. name)) ()
  1487. ,(format "My recursive grep by %s."
  1488. name)
  1489. (interactive)
  1490. (let ((my-rgrep-default ,name))
  1491. (if (called-interactively-p 'any)
  1492. (call-interactively 'my-rgrep)
  1493. (error "Not intended to be called noninteractively. Use `my-rgrep'"))))
  1494. )
  1495. (define-my-rgrep "ack")
  1496. (define-my-rgrep "ag")
  1497. (define-my-rgrep "rg")
  1498. (define-my-rgrep "sift")
  1499. (define-my-rgrep "gitgrep")
  1500. (define-my-rgrep "grep")
  1501. (define-my-rgrep "global")
  1502. (define-key ctl-x-map "s" 'my-rgrep)
  1503. (define-key ctl-x-map "." 'my-rgrep-thing-at-point-projectile-root)
  1504. (defun my-occur (regexp &optional region)
  1505. "My occur command to search REGEXP."
  1506. (interactive (list (read-string "List lines matching regexp: "
  1507. (thing-at-point 'symbol t))))
  1508. (occur regexp nil region))
  1509. (define-key ctl-x-map (kbd "C-o") 'my-occur)
  1510. (set-variable 'dumb-jump-prefer-searcher 'rg)
  1511. (defalias 'make 'compile)
  1512. (define-key ctl-x-map "c" 'compile)
  1513. ;;;;;;;;;;;;;;;;;;;;;;;
  1514. ;; adoc-simple-mode
  1515. (when (safe-require-or-eval 'adoc-mode)
  1516. (defvar adoc-simple-font-lock-keywords
  1517. nil)
  1518. (define-derived-mode adoc-simple-mode adoc-mode
  1519. "Adoc-Simple"
  1520. "Major mode for editing AsciiDoc text files.
  1521. This mode is a simplified version of `adoc-mode'."
  1522. '(set (make-local-variable 'font-lock-defaults)
  1523. '(adoc-simple-font-lock-keywords
  1524. nil nil nil nil
  1525. (font-lock-multiline . t)
  1526. (font-lock-mark-block-function . adoc-font-lock-mark-block-function))))
  1527. (add-to-list 'auto-mode-alist
  1528. '("\\.adoc\\'" . adoc-simple-mode)))
  1529. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1530. ;; awk-preview
  1531. (defgroup awk-preview nil
  1532. "Awk previewer."
  1533. :tag "Awk Preview"
  1534. :prefix "awk-preview-"
  1535. :group 'tools)
  1536. (defcustom awk-preview-program
  1537. (or (executable-find "gawk")
  1538. (executable-find "awk")
  1539. "awk")
  1540. "Awk program to execute."
  1541. :type 'string
  1542. :group 'awk-preview)
  1543. (defcustom awk-preview-switches
  1544. ;; '("--sandbox")
  1545. nil
  1546. "String of awk options appended when running awk preview."
  1547. :type '(repeat string)
  1548. :group 'awk-preview)
  1549. (defcustom awk-preview-default-program
  1550. "# C-c C-l to update preview, C-c C-c to commit, C-c C-k to abort.
  1551. {
  1552. print NR, $0
  1553. }
  1554. "
  1555. "Default awk command."
  1556. :type 'string
  1557. :group 'awk-preview)
  1558. (defvar awk-preview--point-beg
  1559. nil
  1560. "Point of beginning.")
  1561. (make-variable-buffer-local 'awk-preview--point-beg)
  1562. (defvar awk-preview--point-end
  1563. nil
  1564. "Point of end.")
  1565. (make-variable-buffer-local 'awk-preview--point-end)
  1566. (defvar awk-preview--preview-point-beg
  1567. nil
  1568. "Point of beginning.
  1569. Used by preview buffer and always same as awk-preview--point-beg.")
  1570. (make-variable-buffer-local 'awk-preview--preview-point-beg)
  1571. (defvar awk-preview--preview-point-end
  1572. nil
  1573. "Point of beginning.
  1574. Used by preview buffer and may defferent from awk-preview--point-end.")
  1575. (make-variable-buffer-local 'awk-preview--preview-point-end)
  1576. (defvar awk-preview--program-filename
  1577. nil
  1578. "Awk preview program file name.")
  1579. (make-variable-buffer-local 'awk-preview--program-filename)
  1580. (defvar awk-preview--source-buffer
  1581. nil
  1582. "Awk source buffer.")
  1583. (make-variable-buffer-local 'awk-preview--source-buffer)
  1584. (defvar awk-preview--preview-buffer
  1585. nil
  1586. "Awk preview buffer.")
  1587. (make-variable-buffer-local 'awk-preview--preview-buffer)
  1588. (defvar awk-preview--program-buffer
  1589. nil
  1590. "Awk program buffer.")
  1591. (make-variable-buffer-local 'awk-preview--program-buffer)
  1592. (defvar awk-preview--window-configuration
  1593. nil
  1594. "Awk preview window configuration.")
  1595. (defun awk-preview--invoke-awk (buf beg end progfile output &optional delete)
  1596. "Execute PROGFILE awk process with BEG and END input and output to OUTPUT buffer.
  1597. When OUTPUT is t the result will be output to BUF.
  1598. Delete the text between BEG and END when DELETE is non-nil."
  1599. (with-current-buffer buf
  1600. (let ((status (apply 'call-process-region
  1601. beg
  1602. end
  1603. awk-preview-program
  1604. delete
  1605. output
  1606. nil
  1607. `(,@awk-preview-switches "-f" ,progfile))))
  1608. (unless (eq status
  1609. 0)
  1610. (error "awk-preview: Awk program exited abnormally."))
  1611. output)))
  1612. (defvar awk-preview-program-buffer-name
  1613. "*AWK Preview Program<%s>*"
  1614. "Buffer name of awk preview program.")
  1615. (defvar awk-preview-preview-buffer-name
  1616. "*AWK Preview<%s>*"
  1617. "Buffer name of awk preview.")
  1618. (defun awk-preview--create-program-buffer (source preview)
  1619. "Create and show awk program buffer for SOURCE and PREVIEW buffer.
  1620. Return that buffer."
  1621. (let ((source-name (buffer-name source)))
  1622. (with-current-buffer (generate-new-buffer (format awk-preview-program-buffer-name
  1623. source-name))
  1624. (erase-buffer)
  1625. (insert awk-preview-default-program)
  1626. (awk-mode)
  1627. (awk-preview-program-mode 1)
  1628. (setq awk-preview--source-buffer source)
  1629. (setq awk-preview--preview-buffer preview)
  1630. (setq awk-preview--program-buffer (current-buffer))
  1631. (setq awk-preview--program-filename (make-temp-file "awk-preview-"
  1632. nil
  1633. ".awk"))
  1634. (current-buffer))))
  1635. (defun awk-preview-program-buffer-kill-hook ()
  1636. "Cleanup for awk-preview program buffer."
  1637. (when awk-preview--program-filename
  1638. (delete-file awk-preview--program-filename)))
  1639. (add-hook 'kill-buffer-hook
  1640. 'awk-preview-program-buffer-kill-hook)
  1641. (defun awk-preview--create-preview-buffer (source)
  1642. "Create preview buffer of SOURCE buffer and return it."
  1643. (with-current-buffer source
  1644. (let ((buffer-file-name nil)
  1645. (beg awk-preview--point-beg)
  1646. (end awk-preview--point-end))
  1647. (with-current-buffer (clone-buffer (format awk-preview-preview-buffer-name
  1648. (buffer-name)))
  1649. (awk-preview-program-mode 1)
  1650. (setq awk-preview--preview-point-beg beg)
  1651. (setq awk-preview--preview-point-end end)
  1652. (setq awk-preview--source-buffer source)
  1653. (setq awk-preview--preview-buffer (current-buffer))
  1654. (goto-char end)
  1655. (setq buffer-read-only t)
  1656. (current-buffer)))))
  1657. (defun awk-preview (beg end)
  1658. "Run awk and preview result."
  1659. (interactive "r")
  1660. (setq awk-preview--point-beg beg)
  1661. (setq awk-preview--point-end end)
  1662. (setq awk-preview--source-buffer (current-buffer))
  1663. (setq awk-preview--preview-buffer
  1664. (awk-preview--create-preview-buffer (current-buffer)))
  1665. (setq awk-preview--program-buffer
  1666. (awk-preview--create-program-buffer (current-buffer)
  1667. awk-preview--preview-buffer))
  1668. ;; At creation of preview buffer, program buffer is not available so set this
  1669. ;; here
  1670. (let ((b awk-preview--program-buffer))
  1671. (with-current-buffer awk-preview--preview-buffer
  1672. (setq awk-preview--program-buffer b)))
  1673. (setq awk-preview--window-configuration
  1674. (current-window-configuration))
  1675. (set-window-buffer (get-buffer-window awk-preview--source-buffer)
  1676. awk-preview--preview-buffer)
  1677. (pop-to-buffer awk-preview--program-buffer)
  1678. (switch-to-buffer awk-preview--program-buffer)
  1679. (awk-preview-update-preview)
  1680. )
  1681. (defun awk-preview-update-preview ()
  1682. "Update awk-preview."
  1683. (interactive)
  1684. (with-current-buffer awk-preview--program-buffer
  1685. (write-region (point-min)
  1686. (point-max)
  1687. awk-preview--program-filename))
  1688. (let ((output (with-current-buffer (get-buffer-create " *awk-preview output*")
  1689. (erase-buffer)
  1690. (current-buffer)))
  1691. (progfile (with-current-buffer awk-preview--program-buffer
  1692. awk-preview--program-filename)))
  1693. (with-current-buffer awk-preview--source-buffer
  1694. (awk-preview--invoke-awk (current-buffer)
  1695. awk-preview--point-beg
  1696. awk-preview--point-end
  1697. progfile
  1698. output)
  1699. (with-current-buffer awk-preview--preview-buffer
  1700. (let ((inhibit-read-only t))
  1701. (goto-char awk-preview--preview-point-end)
  1702. (delete-region awk-preview--preview-point-beg (point))
  1703. (insert-buffer-substring output)
  1704. (setq awk-preview--preview-point-end (point))))
  1705. )))
  1706. (defun awk-preview-commit ()
  1707. "Exit awk-preview and update buffer."
  1708. (interactive)
  1709. (awk-preview--cleanup))
  1710. (defun awk-preview-abort ()
  1711. "Discard result and exit awk-preview."
  1712. (interactive)
  1713. (awk-preview--cleanup))
  1714. (defun awk-preview--cleanup()
  1715. "Cleanup awk preview buffers and variables.")
  1716. (defvar awk-preview-program-mode-map
  1717. (let ((map (make-sparse-keymap)))
  1718. (define-key map (kbd "C-c C-l") 'awk-preview-update-preview)
  1719. (define-key map (kbd "C-c C-k") 'awk-preview-abort)
  1720. (define-key map (kbd "C-c C-c") 'awk-preview-commit)
  1721. map)
  1722. "Keymap for `awk-preview-program-mode'.")
  1723. (define-minor-mode awk-preview-program-mode
  1724. "Minor mode for awk-preview program buffer."
  1725. :lighter " AWKPrev"
  1726. :keymap awk-preview-program-mode-map)
  1727. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1728. ;; editorconfig-auto-apply
  1729. (define-minor-mode editorconfig-auto-apply-mode
  1730. "When saving .editorconfig file update buffer configs."
  1731. :global t
  1732. :lighter ""
  1733. (if editorconfig-auto-apply-mode
  1734. (add-hook 'after-save-hook
  1735. 'editorconfig-auto-apply-mode--run)
  1736. (remove-hook 'after-save-hook
  1737. 'editorconfig-auto-apply-mode--run)))
  1738. (defun editorconfig-auto-apply-mode--run ()
  1739. "When saving .editorconfig file walk all buffers and update configs."
  1740. (when (eq major-mode
  1741. 'editorconfig-conf-mode)
  1742. (let ((dir (file-name-directory buffer-file-name)))
  1743. (cl-dolist (buf (buffer-list))
  1744. (when (and (buffer-file-name buf)
  1745. (file-in-directory-p (buffer-file-name buf)
  1746. dir))
  1747. (with-current-buffer buf
  1748. (editorconfig-mode-apply)))))))
  1749. (editorconfig-auto-apply-mode 1)
  1750. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1751. ;; recently
  1752. (defgroup recently nil
  1753. "Recently visited files"
  1754. :tag "Recently"
  1755. :prefix "recently-"
  1756. :group 'tools)
  1757. (defcustom recently-file
  1758. (concat user-emacs-directory
  1759. "recently.el")
  1760. "Recently file."
  1761. :type 'string
  1762. :group 'recently)
  1763. (defcustom recently-max
  1764. 100
  1765. "Recently list max length."
  1766. :type 'int
  1767. :group 'recently)
  1768. (defcustom recently-excludes
  1769. '()
  1770. "List of regexps for filenames excluded from the recent list."
  1771. :type '(repeat string)
  1772. :group 'recently)
  1773. (add-to-list 'recently-excludes
  1774. (eval-when-compile (rx "/COMMIT_EDITMSG" eot)))
  1775. (defvar recently-list
  1776. '()
  1777. "Recently list.")
  1778. (defvar recently-file-mtime
  1779. nil
  1780. "Modified time of file when last read file.")
  1781. (defun recently-write ()
  1782. "Write to file."
  1783. (with-temp-buffer
  1784. (prin1 recently-list
  1785. (current-buffer))
  1786. (write-region (point-min)
  1787. (point-max)
  1788. recently-file)))
  1789. (defun recently-read ()
  1790. "Read file."
  1791. (when (file-readable-p recently-file)
  1792. (with-temp-buffer
  1793. (insert-file-contents recently-file)
  1794. (goto-char (point-min))
  1795. (setq recently-list
  1796. (read (current-buffer))))
  1797. (setq recently-file-mtime
  1798. (nth 5
  1799. (file-attributes recently-file)))))
  1800. (defun recently-reload ()
  1801. "Reload file."
  1802. (when (and (file-readable-p recently-file)
  1803. (not (equal recently-file-mtime
  1804. (nth 5
  1805. (file-attributes recently-file)))))
  1806. (recently-read)
  1807. (cl-assert (equal recently-file-mtime
  1808. (nth 5
  1809. (file-attributes recently-file))))))
  1810. (defun recently-add (path)
  1811. "Add PATH to list."
  1812. (cl-assert (string= path
  1813. (expand-file-name path)))
  1814. (when (cl-loop for re in recently-excludes
  1815. if (string-match re path) return nil
  1816. finally return t)
  1817. (recently-reload)
  1818. (let* ((l (copy-list recently-list))
  1819. (l (delete path
  1820. l))
  1821. (l (cl-loop for e in l
  1822. unless (file-in-directory-p path e)
  1823. collect e))
  1824. (l (cons path
  1825. l))
  1826. (l (recently--truncate l
  1827. recently-max)))
  1828. (unless (equal recently-list
  1829. l)
  1830. (setq recently-list l)
  1831. (recently-write)))))
  1832. (defun recently--truncate (list len)
  1833. "Truncate LIST to LEN."
  1834. (if (> (length list)
  1835. len)
  1836. (cl-subseq list
  1837. 0
  1838. len)
  1839. list))
  1840. (defun recently-find-file-hook ()
  1841. "Add current file."
  1842. (when buffer-file-name
  1843. (recently-add buffer-file-name)))
  1844. (defun recently-dired-mode-hook ()
  1845. "Add current directory."
  1846. (recently-add (expand-file-name default-directory)))
  1847. (add-hook 'find-file-hook
  1848. 'recently-find-file-hook)
  1849. (add-hook 'dired-mode-hook
  1850. 'recently-dired-mode-hook)
  1851. ;; recently-show
  1852. (defvar recently-show-window-height 10
  1853. "Max height of window of `recently-show'")
  1854. (defvar recently-show-mode-map
  1855. (let ((map (make-sparse-keymap)))
  1856. (suppress-keymap map)
  1857. (define-key map "n" 'next-line)
  1858. (define-key map "p" 'previous-line)
  1859. (define-key map (kbd "C-m") 'recently-show-find-file)
  1860. (define-key map (kbd "SPC") 'recently-show-find-file)
  1861. (define-key map "v" 'recently-show-view-file)
  1862. (define-key map "@" 'recently-show-dired)
  1863. (define-key map "q" 'recently-show-close)
  1864. (define-key map (kbd "C-g") 'recently-show-close)
  1865. (define-key map "?" 'describe-mode)
  1866. (define-key map "/" 'isearch-forward)
  1867. map))
  1868. (defvar recently-show-before-listing-hook nil
  1869. "Hook run before creating buffer of `recently-show'.")
  1870. (defvar recently-show-window-configuration nil
  1871. "Used for internal")
  1872. (defvar recently-show-abbreviate t
  1873. "Non-nil means use `abbreviate-file-name' when listing recently opened files.")
  1874. (define-derived-mode recently-show-mode special-mode "recently-show"
  1875. "Major mode for `recently-show'."
  1876. ;; (set (make-local-variable 'scroll-margin)
  1877. ;; 0)
  1878. )
  1879. ;;;###autoload
  1880. (defun recently-show (&optional files buffer-name)
  1881. "Show simplified list of recently opened files.
  1882. If optional argument FILES is non-nil, it is a list of recently-opened
  1883. files to choose from. It defaults to the whole recent list.
  1884. If optional argument BUFFER-NAME is non-nil, it is a buffer name to
  1885. use for the buffer. It defaults to \"*recetf-show*\"."
  1886. (interactive)
  1887. (let ((bf (recently-show--create-buffer-tabulated files buffer-name)))
  1888. (if bf
  1889. (progn
  1890. ;; (recently-save-list)
  1891. (setq recently-show-window-configuration (current-window-configuration))
  1892. ;;(pop-to-buffer bf t t)
  1893. (display-buffer bf)
  1894. ;; (set-window-text-height (selected-window)
  1895. ;; recently-show-window-height)
  1896. (shrink-window-if-larger-than-buffer (selected-window)))
  1897. (message "No recent file!"))))
  1898. (defun recently-show--create-buffer-tabulated (&optional files buffer-name)
  1899. "Create buffer listing recently files FILES."
  1900. (let ((bname (or buffer-name
  1901. "*recently-show-tabulated*"))
  1902. (list (or files
  1903. (progn
  1904. (recently-reload)
  1905. recently-list))))
  1906. (when list
  1907. (when (get-buffer bname)
  1908. (kill-buffer bname))
  1909. (with-current-buffer (get-buffer-create bname)
  1910. (setq tabulated-list-format
  1911. `[("Name" 30 t)
  1912. ("Full Path" 0 t)])
  1913. ;; (setq tabulated-list-sort-key (cons "Name" nil))
  1914. (setq tabulated-list-entries
  1915. (mapcar (lambda (f)
  1916. (list f
  1917. (vector (file-name-nondirectory f) f)))
  1918. ;; list
  1919. recently-list
  1920. ))
  1921. (recently-show-tabulated-mode)
  1922. (current-buffer)))))
  1923. (define-derived-mode recently-show-tabulated-mode tabulated-list-mode "Recently Show"
  1924. "Major mode for browsing recently opened files and directories."
  1925. (setq tabulated-list-padding 2)
  1926. ;; TODO: Implement revert
  1927. ;; (add-hook 'tabulated-list-revert-hook 'recently-reload nil t)
  1928. ;; TODO: Implement open
  1929. (tabulated-list-init-header)
  1930. (tabulated-list-print nil nil))
  1931. (defun recently-show-create-buffer (&optional files buffer-name)
  1932. "Create buffer listing recently files."
  1933. (let ((bname (or buffer-name
  1934. "*recently-show*"))
  1935. (list (or files
  1936. (progn
  1937. (recently-reload)
  1938. recently-list))))
  1939. (when list
  1940. (and (get-buffer bname)
  1941. (kill-buffer bname))
  1942. (let ((bf (get-buffer-create bname)))
  1943. (with-current-buffer bf
  1944. (recently-show-mode)
  1945. (let ((inhibit-read-only t))
  1946. (mapc (lambda (f)
  1947. (insert (if recently-show-abbreviate
  1948. (abbreviate-file-name f)
  1949. f)
  1950. "\n"))
  1951. list))
  1952. (goto-char (point-min))
  1953. ;; (setq buffer-read-only t)
  1954. )
  1955. bf))))
  1956. (defun recently-show-close ()
  1957. "Close recently-show window."
  1958. (interactive)
  1959. (kill-buffer (current-buffer))
  1960. (set-window-configuration recently-show-window-configuration))
  1961. (defun recently-show-find-file ()
  1962. "Fine file of current line."
  1963. (interactive)
  1964. (let ((f (recently-show-get-filename)))
  1965. (recently-show-close)
  1966. (find-file f)))
  1967. (defun recently-show-view-file ()
  1968. "view file of current line."
  1969. (interactive)
  1970. (let ((f (recently-show-get-filename)))
  1971. (recently-show-close)
  1972. (view-file f)))
  1973. (defun recently-show-get-filename ()
  1974. "Get filename of current line."
  1975. (buffer-substring-no-properties (point-at-bol)
  1976. (point-at-eol)))
  1977. (defun recently-show-dired()
  1978. "Open dired buffer of directory containing file of current line."
  1979. (interactive)
  1980. (let ((f (recently-show-get-filename)))
  1981. (recently-show-close)
  1982. (dired (if (file-directory-p f)
  1983. f
  1984. (or (file-name-directory f)
  1985. ".")))))
  1986. (define-key ctl-x-map (kbd "C-r") 'recently-show)
  1987. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1988. ;; git walktree
  1989. (defgroup git-walktree nil
  1990. "Git Walktree."
  1991. :tag "GitWalktree"
  1992. :prefix "git-walktree-"
  1993. :group 'tools)
  1994. (defvar git-walktree-current-committish nil
  1995. "Committish name of currently browsing.")
  1996. (make-variable-buffer-local 'git-walktree-current-committish)
  1997. (defvar git-walktree-current-path nil
  1998. "Path name currently visiting without leading and trailing slash.
  1999. This path is always relative to repository root.")
  2000. (make-variable-buffer-local 'git-walktree-current-path)
  2001. (defvar git-walktree-buffer-file-name nil
  2002. "Psudo filename of current buffer.")
  2003. (make-variable-buffer-local 'git-walktree-buffer-file-name)
  2004. (defvar git-walktree-object-full-sha1 nil
  2005. "Object name in full sha1 format of current buffer.")
  2006. (make-variable-buffer-local 'git-walktree-object-full-sha1)
  2007. (defvar git-walktree-repository-root nil
  2008. "Repository root path of current buffer.")
  2009. (make-variable-buffer-local 'git-walktree-repository-root)
  2010. (put 'git-walktree-repository-root
  2011. 'permanent-local
  2012. t)
  2013. (defun git-walktree--committish-fordisplay (committish)
  2014. "Convert COMMITTISH and return is a suitable format for displaying."
  2015. (if (and committish
  2016. (string-match-p "\\`[0-9a-f]+\\'"
  2017. committish)
  2018. (>= (length committish) 32))
  2019. (git-walktree--git-plumbing "rev-parse"
  2020. "--short"
  2021. committish)
  2022. committish))
  2023. (defun git-walktree--create-buffer (committish name type)
  2024. "Create and return buffer for COMMITTISH:NAME.
  2025. TYPE is target object type."
  2026. (let* ((root (git-walktree--git-plumbing "rev-parse"
  2027. "--show-toplevel"))
  2028. (committish-display (git-walktree--committish-fordisplay committish))
  2029. (name (format "%s:%s"
  2030. (or committish-display "")
  2031. name)))
  2032. (if (and git-walktree-reuse-tree-buffer
  2033. (string= type "tree"))
  2034. (with-current-buffer (or git-walktree-tree-buffer-for-reuse
  2035. (setq git-walktree-tree-buffer-for-reuse
  2036. (generate-new-buffer "gitwalktreebuf")))
  2037. (setq git-walktree-repository-root root)
  2038. (rename-buffer name t)
  2039. (current-buffer))
  2040. (with-current-buffer (get-buffer-create name)
  2041. (if git-walktree-repository-root
  2042. (if (string= root
  2043. git-walktree-repository-root)
  2044. (current-buffer)
  2045. ;; If the buffer is for another repository, create new buffer
  2046. (with-current-buffer (generate-new-buffer name)
  2047. (setq git-walktree-repository-root root)
  2048. (current-buffer)))
  2049. ;; New buffer
  2050. (setq git-walktree-repository-root root)
  2051. (current-buffer))))))
  2052. (defun git-walktree--replace-into-buffer (target)
  2053. "Replace TARGET buffer contents with that of current buffer.
  2054. It also copy text overlays."
  2055. (let ((src (current-buffer)))
  2056. (with-current-buffer target
  2057. (replace-buffer-contents src)))
  2058. ;; Copy color overlays
  2059. (let ((overlays (overlays-in (point-min) (point-max))))
  2060. (dolist (o overlays)
  2061. (let ((beg (overlay-start o))
  2062. (end (overlay-end o)))
  2063. (move-overlay (copy-overlay o)
  2064. beg
  2065. end
  2066. target)))))
  2067. (require 'ansi-color)
  2068. (defun git-walktree--open-treeish (committish path treeish)
  2069. "Open git tree buffer of COMMITISH:PATH.
  2070. TREEISH should be a tree-ish object full-sha1 of COMMITISH:PATH."
  2071. (cl-assert path)
  2072. (cl-assert treeish)
  2073. (let* (point-tree-start
  2074. (type (git-walktree--git-plumbing "cat-file"
  2075. "-t"
  2076. treeish))
  2077. (buf (git-walktree--create-buffer committish path type))
  2078. )
  2079. (cl-assert (member type
  2080. '("commit" "tree")))
  2081. (with-current-buffer buf
  2082. (unless (and (string= treeish
  2083. git-walktree-object-full-sha1)
  2084. (or (eq committish
  2085. git-walktree-current-committish)
  2086. (string= committish
  2087. git-walktree-current-committish)))
  2088. (buffer-disable-undo)
  2089. ;; For running git command go back to repository root
  2090. (cd git-walktree-repository-root)
  2091. (save-excursion
  2092. (let ((inhibit-read-only t))
  2093. ;; Remove existing overlays generated by ansi-color-apply-on-region
  2094. (remove-overlays)
  2095. (with-temp-buffer
  2096. (if committish
  2097. (progn (git-walktree--call-process nil
  2098. "show"
  2099. ;; TODO: Make this args configurable
  2100. ;; "--no-patch"
  2101. "--color=always"
  2102. "--pretty=short"
  2103. "--decorate"
  2104. "--stat"
  2105. committish)
  2106. (ansi-color-apply-on-region (point-min)
  2107. (point))
  2108. (insert "\n")
  2109. (insert (format "Contents of '%s:%s':\n"
  2110. (git-walktree--committish-fordisplay committish)
  2111. path)))
  2112. (insert (format "Contents of treeish object '%s:\n"
  2113. treeish)))
  2114. (setq point-tree-start (point))
  2115. (git-walktree--call-process nil
  2116. "ls-tree"
  2117. ;; "-r"
  2118. "--abbrev"
  2119. treeish)
  2120. (git-walktree--replace-into-buffer buf))
  2121. ))
  2122. (git-walktree-mode)
  2123. (set-buffer-modified-p nil)
  2124. (setq git-walktree-current-committish committish)
  2125. (setq git-walktree-current-path path)
  2126. (setq git-walktree-object-full-sha1 treeish)
  2127. (let ((dir (expand-file-name path git-walktree-repository-root)))
  2128. (when (and git-walktree-try-cd
  2129. (file-directory-p dir))
  2130. (cd dir)))
  2131. (when (= (point) (point-min))
  2132. (goto-char point-tree-start)
  2133. (git-walktree-mode--move-to-file)
  2134. )
  2135. ))
  2136. buf))
  2137. (defun git-walktree--call-process (&optional infile &rest args)
  2138. "Call git command with input from INFILE and args ARGS.
  2139. Result will be inserted into current buffer."
  2140. (let ((status (apply 'call-process
  2141. git-walktree-git-executable
  2142. infile
  2143. t
  2144. nil
  2145. args)))
  2146. (unless (eq 0
  2147. status)
  2148. (error "Failed to call git process %S %S"
  2149. infile
  2150. args))))
  2151. ?w
  2152. (defun git-walktree--open-blob (committish path blob)
  2153. "Open blob object of COMMITISH:PATH.
  2154. BLOB should be a object full sha1 of COMMITISH:PATH."
  2155. (cl-assert committish)
  2156. (cl-assert path)
  2157. (cl-assert blob)
  2158. (let* ((type (git-walktree--git-plumbing "cat-file"
  2159. "-t"
  2160. blob))
  2161. (buf (git-walktree--create-buffer committish path type)))
  2162. (cl-assert (string= type "blob"))
  2163. (with-current-buffer buf
  2164. (unless (string= blob
  2165. git-walktree-object-full-sha1)
  2166. ;; For running git command go back to repository root
  2167. (cd git-walktree-repository-root)
  2168. (let ((inhibit-read-only t))
  2169. (with-temp-buffer
  2170. (git-walktree--call-process nil
  2171. "cat-file"
  2172. "-p"
  2173. blob)
  2174. (git-walktree--replace-into-buffer buf)))
  2175. (setq git-walktree-buffer-file-name
  2176. (concat git-walktree-repository-root "/git@" committish ":" path))
  2177. (setq buffer-file-name
  2178. (concat git-walktree-repository-root "/" path))
  2179. (normal-mode t)
  2180. ;; For asking filename when C-xC-s
  2181. (setq buffer-file-name nil)
  2182. (set-buffer-modified-p t)
  2183. (setq git-walktree-current-committish committish)
  2184. (setq git-walktree-current-path path)
  2185. (setq git-walktree-object-full-sha1 blob)
  2186. (let ((dir (expand-file-name (or (file-name-directory path)
  2187. ".")
  2188. git-walktree-repository-root)))
  2189. (when (and git-walktree-try-cd
  2190. (file-directory-p dir))
  2191. (cd dir)))
  2192. (view-mode 1)
  2193. ))
  2194. buf))
  2195. (defun git-walktree--open-noselect-safe-path (committish &optional path)
  2196. "Open git object of COMMITTISH:PATH.
  2197. If PATH not found in COMMITTISH tree, go up path and try again until found.
  2198. When PATH is omitted or nil, it is calculated from current file or directory."
  2199. (cl-assert committish)
  2200. (let ((type (git-walktree--git-plumbing "cat-file"
  2201. "-t"
  2202. committish)))
  2203. (cl-assert (string= type "commit")))
  2204. (setq path
  2205. (or path
  2206. (git-walktree--path-in-repository (or buffer-file-name
  2207. default-directory))))
  2208. ;; PATH must not start with and end with slashes
  2209. (cl-assert (not (string-match-p "\\`/" path)))
  2210. (cl-assert (not (string-match-p "/\\'" path)))
  2211. (let ((obj (git-walktree--resolve-object committish path)))
  2212. (while (not obj)
  2213. (setq path
  2214. (git-walktree--parent-directory path))
  2215. (setq obj
  2216. (git-walktree--resolve-object committish path)))
  2217. (git-walktree--open-noselect committish
  2218. path
  2219. obj)))
  2220. ;; TODO: Store view history
  2221. (defun git-walktree--open-noselect (committish path object)
  2222. "Open buffer to view git object of COMMITTISH:PATH.
  2223. When PATH was given and non-nil open that, otherwise open root tree.
  2224. When OBJECT was given and non-nil, assume that is the object full sha1 of
  2225. COMMITTISH:PATH without checking it."
  2226. (cl-assert committish)
  2227. (let ((type (git-walktree--git-plumbing "cat-file"
  2228. "-t"
  2229. committish)))
  2230. (cl-assert (string= type "commit")))
  2231. (setq path (or path
  2232. "."))
  2233. ;; PATH must not start with and end with slashes
  2234. (cl-assert (not (string-match-p "\\`/" path)))
  2235. (cl-assert (not (string-match-p "/\\'" path)))
  2236. (setq object (or object
  2237. (git-walktree--resolve-object committish path)))
  2238. (setq object (git-walktree--git-plumbing "rev-parse"
  2239. object))
  2240. (cl-assert object)
  2241. (let ((type (git-walktree--git-plumbing "cat-file"
  2242. "-t"
  2243. object)))
  2244. (pcase type
  2245. ((or "commit" "tree")
  2246. (git-walktree--open-treeish committish path object))
  2247. ("blob"
  2248. (git-walktree--open-blob committish path object))
  2249. (_
  2250. (error "Type cannot handle: %s" type)))))
  2251. (defun git-walktree--resolve-object (committish path)
  2252. "Return object full sha1 name of COMMITISIH:PATH.
  2253. If path is equal to \".\" return COMMITTISH's root tree object.
  2254. PATH will be always treated as relative to repository root."
  2255. (cl-assert committish)
  2256. (cl-assert path)
  2257. (cl-assert (not (string-match-p "\\`/" path)))
  2258. (cl-assert (not (string-match-p "/\\'" path)))
  2259. (if (string= path ".")
  2260. (git-walktree--git-plumbing "show"
  2261. "--no-patch"
  2262. "--pretty=format:%T"
  2263. committish)
  2264. (let ((info (git-walktree--parse-lstree-line (git-walktree--git-plumbing "ls-tree"
  2265. "--full-tree"
  2266. committish
  2267. path))))
  2268. (plist-get info :object))))
  2269. (defun git-walktree-open (committish &optional path)
  2270. "Open git tree buffer of COMMITTISH.
  2271. When PATH was given and non-nil open that, otherwise try to open current path.
  2272. If target path is not found in COMMITISH tree, go up path and try again until found."
  2273. ;; TODO: Add fallback method for cases where magit is not available
  2274. (interactive (list (magit-read-branch-or-commit "Revision: ")))
  2275. (switch-to-buffer (git-walktree--open-noselect-safe-path committish path)))
  2276. (defalias 'git-walktree 'git-walktree-open)
  2277. (defun git-walktree--path-in-repository (path)
  2278. "Convert PATH into relative path to repository root.
  2279. Result will not have leading and trailing slashes."
  2280. (with-temp-buffer
  2281. (cd (if (file-directory-p path)
  2282. path
  2283. (file-name-directory path)))
  2284. (let ((root (git-walktree--git-plumbing "rev-parse"
  2285. "--show-toplevel")))
  2286. (file-relative-name (directory-file-name path)
  2287. root))))
  2288. (defcustom git-walktree-git-executable "git"
  2289. "Git executable."
  2290. :type 'string
  2291. :group 'git-walktree)
  2292. (defcustom git-walktree-try-cd t
  2293. "Try to cd if directory exists in current working directory if non-nil.
  2294. Otherwise use repository root for gitwalktree buffer's `default-directory'."
  2295. :type 'boolean
  2296. :group 'git-walktree)
  2297. (defcustom git-walktree-reuse-tree-buffer t
  2298. "Non-nil to reuse buffer for treeish object."
  2299. :type 'boolean
  2300. :group 'git-walktree)
  2301. (defvar git-walktree-tree-buffer-for-reuse nil
  2302. "Buffer to use when `git-walktree-reuse-tree-buffer' is non-nil.")
  2303. (defun git-walktree--git-plumbing (&rest args)
  2304. "Run git plubming command with ARGS.
  2305. Returns first line of output without newline."
  2306. (with-temp-buffer
  2307. (let ((status (apply 'call-process
  2308. git-walktree-git-executable
  2309. nil
  2310. t
  2311. nil
  2312. args)))
  2313. (unless (eq 0
  2314. status)
  2315. (error "Faild to run git %S:\n%s"
  2316. args
  2317. (buffer-substring-no-properties (point-min)
  2318. (point-max))))
  2319. (buffer-substring-no-properties (point-min)
  2320. (progn
  2321. (goto-char (point-min))
  2322. (point-at-eol))))))
  2323. (defconst git-walktree-ls-tree-line-regexp
  2324. "^\\([0-9]\\{6\\}\\) \\(\\w+\\) \\([0-9a-f]+\\)\t\\(.*\\)$"
  2325. "Regexp for one line of output of git ls-tree.")
  2326. (defconst git-walktree-ls-tree-line-tree-regexp
  2327. "^\\([0-9]\\{6\\}\\) \\(tree\\) \\([0-9a-f]+\\)\t\\(.*\\)$"
  2328. "Regexp for tree line of output of git ls-tree.")
  2329. (defconst git-walktree-ls-tree-line-commit-regexp
  2330. "^\\([0-9]\\{6\\}\\) \\(commit\\) \\([0-9a-f]+\\)\t\\(.*\\)$"
  2331. "Regexp for commit line of output of git ls-tree.")
  2332. (defun git-walktree--parse-lstree-line (str)
  2333. "Extract object info from STR.
  2334. STR should be a string like following without newline.:
  2335. 100644 blob 6fd4d58202d0b46547c6fe43de0f8c878456f966 .editorconfig
  2336. Returns property list like (:mode MODE :type TYPE :object OBJECT :file FILE)."
  2337. (let (result mode type object file)
  2338. (save-match-data
  2339. (with-temp-buffer
  2340. (insert str)
  2341. (goto-char (point-min))
  2342. (and (re-search-forward git-walktree-ls-tree-line-regexp
  2343. nil
  2344. t)
  2345. (list :mode (match-string 1)
  2346. :type (match-string 2)
  2347. :object (match-string 3)
  2348. :file (match-string 4)))))))
  2349. (defun git-walktree-mode-open-this ()
  2350. "Open git object of current line."
  2351. (interactive)
  2352. (let ((info (git-walktree--parse-lstree-line (buffer-substring-no-properties (point-at-bol)
  2353. (point-at-eol)))))
  2354. (if info
  2355. (switch-to-buffer
  2356. (if (string= (plist-get info
  2357. :type)
  2358. "commit")
  2359. ;; For submodule cd to that directory and intialize
  2360. ;; TODO: Provide way to go back to known "parent" repository
  2361. (with-temp-buffer
  2362. (cd (plist-get info :file))
  2363. (git-walktree--open-noselect (plist-get info
  2364. :object)
  2365. nil
  2366. (plist-get info
  2367. :object)))
  2368. (git-walktree--open-noselect git-walktree-current-committish
  2369. (git-walktree--join-path (plist-get info
  2370. :file))
  2371. (plist-get info
  2372. :object))))
  2373. (message "No object on current line."))))
  2374. (defun git-walktree--join-path (name &optional base)
  2375. "Make path from NAME and BASE.
  2376. If base is omitted or nil use value of `git-walktree-current-path'."
  2377. (setq base (or base
  2378. git-walktree-current-path))
  2379. (cl-assert base)
  2380. (if (string= base ".")
  2381. name
  2382. (concat base "/" name)))
  2383. (defun git-walktree--parent-directory (path)
  2384. "Return parent directory of PATH without trailing slash.
  2385. For root directory return \".\".
  2386. If PATH is equal to \".\", return nil."
  2387. (if (string-match-p "/" path)
  2388. (directory-file-name (file-name-directory path))
  2389. (if (string= "." path)
  2390. nil
  2391. ".")))
  2392. (defun git-walktree-up (&optional committish path)
  2393. "Open parent directory of COMMITTISH and PATH.
  2394. If not given, value of current buffer will be used."
  2395. (interactive)
  2396. (setq committish
  2397. (or committish git-walktree-current-committish))
  2398. (setq path
  2399. (or path git-walktree-current-path))
  2400. (let ((parent (git-walktree--parent-directory path)))
  2401. (if parent
  2402. (switch-to-buffer (git-walktree--open-noselect committish
  2403. parent
  2404. nil))
  2405. (message "Cannot find parent directory for current tree."))))
  2406. (defun git-walktree-mode--move-to-file ()
  2407. "Move point to file field of ls-tree output in current line.
  2408. This function do nothing when current line is not ls-tree output."
  2409. (interactive)
  2410. (save-match-data
  2411. (when (save-excursion
  2412. (goto-char (point-at-bol))
  2413. (re-search-forward git-walktree-ls-tree-line-regexp
  2414. (point-at-eol) t))
  2415. (goto-char (match-beginning 4)))))
  2416. (defun git-walktree-mode-next-line (&optional arg try-vscroll)
  2417. "Move cursor vertically down ARG lines and move to file field if found."
  2418. (interactive "^p\np")
  2419. (or arg (setq arg 1))
  2420. (line-move arg nil nil try-vscroll)
  2421. (git-walktree-mode--move-to-file)
  2422. )
  2423. (defun git-walktree-mode-previous-line (&optional arg try-vscroll)
  2424. "Move cursor vertically up ARG lines and move to file field if found."
  2425. (interactive "^p\np")
  2426. (or arg (setq arg 1))
  2427. (line-move (- arg) nil nil try-vscroll)
  2428. (git-walktree-mode--move-to-file)
  2429. )
  2430. (defgroup git-walktree-faces nil
  2431. "Faces used by git-walktree."
  2432. :group 'git-walktree
  2433. :group 'faces)
  2434. (defface git-walktree-tree-face
  2435. ;; Same as dired-directory
  2436. '((t (:inherit font-lock-function-name-face)))
  2437. "Face used for tree objects."
  2438. :group 'git-walktree-faces)
  2439. (defface git-walktree-commit-face
  2440. ;; Same as dired-symlink face
  2441. '((t (:inherit font-lock-keyword-face)))
  2442. "Face used for commit objects."
  2443. :group 'git-walktree-faces)
  2444. (defvar git-walktree-known-child-revisions (make-hash-table :test 'equal)
  2445. "Hash of already known pair of commitid -> list of child commitid.
  2446. Both values should be object full sha1 names.")
  2447. (defun git-walktree--put-child (parent child)
  2448. "Register PARENT and CHILD relationship.
  2449. PARENT should be a full sha1 object name."
  2450. ;; Any way to check if PARENT is a full SHA-1 object name?
  2451. (let ((current (gethash parent git-walktree-known-child-revisions)))
  2452. (unless (member child current)
  2453. (puthash parent
  2454. (cons child
  2455. current)
  2456. git-walktree-known-child-revisions))))
  2457. ;; TODO: Add aggressive search mode
  2458. ;; https://stackoverflow.com/a/9870218
  2459. ;; git log --reverse --pretty=format:%H -n 1 --ancestry-path <PARENT>..HEAD
  2460. (defun git-walktree--get-children (parent)
  2461. "Get known children list of PARENT commit.
  2462. PARENT should be a full sha1 object name."
  2463. (gethash parent git-walktree-known-child-revisions))
  2464. (defun git-walktree--choose-committish (prompt-format collection)
  2465. "Emit PROMPT-FORMAT and ask user to which committish of COLLECTION to use.
  2466. When collection has just one element, return the first element without asking."
  2467. (cl-assert collection)
  2468. (if (< (length collection) 2)
  2469. (car collection)
  2470. (completing-read (format prompt-format
  2471. (mapconcat 'git-walktree--committish-fordisplay
  2472. collection
  2473. " "))
  2474. collection
  2475. nil
  2476. t)))
  2477. (defun git-walktree-parent-revision ()
  2478. "Open parent revision of current path.
  2479. If current path was not found in the parent revision try to go up path."
  2480. (interactive)
  2481. (cl-assert git-walktree-current-committish)
  2482. (let* ((commit-full-sha1 (git-walktree--git-plumbing "rev-parse"
  2483. git-walktree-current-committish))
  2484. (parents (git-walktree--parent-full-sha1 commit-full-sha1)))
  2485. (dolist (parent parents)
  2486. (git-walktree--put-child parent
  2487. commit-full-sha1))
  2488. (if (< (length parents)
  2489. 1)
  2490. (message "This revision has no parent revision")
  2491. (let* ((parent (git-walktree--choose-committish "This revision has multiple parents. Which to open? (%s) "
  2492. parents))
  2493. (path git-walktree-current-path))
  2494. (cl-assert path)
  2495. (switch-to-buffer (git-walktree--open-noselect-safe-path parent
  2496. path))))))
  2497. (defun git-walktree--parent-full-sha1 (committish)
  2498. "Return list of parent commits of COMMITTISH in sha1 string."
  2499. (let ((type (git-walktree--git-plumbing "cat-file"
  2500. "-t"
  2501. committish)))
  2502. (cl-assert (string= type "commit")))
  2503. (let ((parents (git-walktree--git-plumbing "show"
  2504. "--no-patch"
  2505. "--pretty=format:%P"
  2506. committish)))
  2507. (split-string parents)))
  2508. (defun git-walktree-known-child-revision ()
  2509. "Open known revision of current path."
  2510. (interactive)
  2511. (let* ((commit-full-sha1 (git-walktree--git-plumbing "rev-parse"
  2512. git-walktree-current-committish))
  2513. (children (git-walktree--get-children commit-full-sha1)))
  2514. (if (< (length children)
  2515. 1)
  2516. (message "There are no known child revision")
  2517. (let* ((child (git-walktree--choose-committish "There are multiple known childrens. Which to open? (%s)"
  2518. children))
  2519. (path git-walktree-current-path))
  2520. (cl-assert path)
  2521. (switch-to-buffer (git-walktree--open-noselect-safe-path child
  2522. path))))))
  2523. (defvar git-walktree-mode-map
  2524. (let ((map (make-sparse-keymap)))
  2525. (define-key map "n" 'git-walktree-mode-next-line)
  2526. (define-key map "p" 'git-walktree-mode-previous-line)
  2527. (define-key map (kbd "C-n") 'git-walktree-mode-next-line)
  2528. (define-key map (kbd "C-p") 'git-walktree-mode-previous-line)
  2529. ;; TODO: Review keybind
  2530. (define-key map "P" 'git-walktree-parent-revision)
  2531. (define-key map "N" 'git-walktree-known-child-revision)
  2532. (define-key map "^" 'git-walktree-up)
  2533. ;; TODO: implement
  2534. (define-key map (kbd "DEL") 'git-walktree-back)
  2535. (define-key map (kbd "C-m") 'git-walktree-mode-open-this)
  2536. map))
  2537. (defvar git-walktree-mode-font-lock-keywords
  2538. `(
  2539. (,git-walktree-ls-tree-line-regexp . (
  2540. (1 'shadow)
  2541. (3 'shadow)
  2542. ))
  2543. (,git-walktree-ls-tree-line-tree-regexp . (
  2544. (2 'git-walktree-tree-face)
  2545. (4 'git-walktree-tree-face)
  2546. ))
  2547. (,git-walktree-ls-tree-line-commit-regexp . (
  2548. (2 'git-walktree-commit-face)
  2549. (4 'git-walktree-commit-face)
  2550. ))
  2551. )
  2552. "Syntax highlighting for git-walktree mode.")
  2553. (define-derived-mode git-walktree-mode special-mode "GitWalktree"
  2554. "Major-mode for `git-walktree-open'."
  2555. (set (make-local-variable 'font-lock-defaults)
  2556. '(git-walktree-mode-font-lock-keywords
  2557. nil nil nil nil
  2558. ))
  2559. )
  2560. (require 'magit nil t)
  2561. ;; (git-revision--git-plumbing "cat-file" "-t" "HEAD")
  2562. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2563. ;; git-worktree
  2564. (defun git-worktree-get-current-list ()
  2565. "Get current worktree list."
  2566. (with-temp-buffer
  2567. (let ((trees nil)
  2568. (status (call-process "git"
  2569. nil
  2570. t
  2571. nil
  2572. "worktree" "list" "--porcelain")))
  2573. (cl-assert (eq status 0))
  2574. (goto-char (point-min))
  2575. (save-match-data
  2576. (while (not (eq (point) (point-max)))
  2577. (let ((worktree nil)
  2578. (head nil)
  2579. (branch nil))
  2580. (while (re-search-forward "^\\([^ ]\+\\) \\(.*\\)$" (point-at-eol) t)
  2581. (pcase (match-string 1)
  2582. ("worktree" (setq worktree (match-string 2)))
  2583. ("HEAD" (setq head (match-string 2)))
  2584. ("branch" (setq branch (match-string 2))))
  2585. (forward-line 1)
  2586. (goto-char (point-at-bol)))
  2587. (setq trees `(,@trees
  2588. (:worktree ,worktree :head ,head :branch ,branch)))
  2589. (forward-line 1)
  2590. (goto-char (point-at-bol)))
  2591. ))
  2592. trees)))
  2593. ;; Local Variables:
  2594. ;; flycheck-disabled-checkers: (emacs-lisp-checkdoc)
  2595. ;; flycheck-checker: emacs-lisp
  2596. ;; End:
  2597. ;;; emancs.el ends here