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.
 
 
 
 
 
 

2844 lines
97 KiB

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