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

2810 lines
94 KiB

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