Nelze vybrat více než 25 témat Téma musí začínat písmenem nebo číslem, může obsahovat pomlčky („-“) a může být dlouhé až 35 znaků.
 
 
 
 
 
 

2868 řádky
97 KiB

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