Não pode escolher mais do que 25 tópicos Os tópicos devem começar com uma letra ou um número, podem incluir traços ('-') e podem ter até 35 caracteres.
 
 
 
 
 
 

2871 linhas
97 KiB

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