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.
 
 
 
 
 
 

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