No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.
 
 
 
 
 
 

2862 líneas
96 KiB

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