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

2660 line
88 KiB

  1. ;;; emacs.el --- 10sr emacs initialization
  2. ;; Time-stamp: <2018-10-15 19:36:35 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 should be fixed, but for now
  692. ;; disable this mode here.
  693. (global-magit-file-mode -1))
  694. (when (boundp 'git-rebase-filename-regexp)
  695. (add-to-list 'auto-mode-alist
  696. `(,git-rebase-filename-regexp . text-mode)))
  697. (when (safe-require-or-eval 'aggressive-indent)
  698. (defvar aggressive-indent-excluded-modes)
  699. (setq aggressive-indent-excluded-modes
  700. `(diff-mode
  701. toml-mode
  702. ,@aggressive-indent-excluded-modes))
  703. (global-aggressive-indent-mode 1))
  704. (when (autoload-eval-lazily 'ggtags)
  705. (add-hook 'c-mode-common-hook
  706. (lambda ()
  707. (when (derived-mode-p 'c-mode 'c++-mode 'java-mode)
  708. (ggtags-mode 1))))
  709. (add-hook 'python-mode-hook
  710. (lambda ()
  711. (ggtags-mode 1))))
  712. (when (autoload-eval-lazily 'imenu-list)
  713. ;; (set-variable 'imenu-list-auto-resize t)
  714. (set-variable 'imenu-list-focus-after-activation t)
  715. (define-key ctl-x-map "l" 'imenu-list-smart-toggle))
  716. (add-hook 'emacs-lisp-mode-hook
  717. (lambda ()
  718. (setq imenu-generic-expression
  719. `(("Sections" ";;;\+\n;; \\(.*\\)\n" 1)
  720. ,@imenu-generic-expression))))
  721. (with-eval-after-load 'compile
  722. (defvar compilation-filter-start)
  723. (defvar compilation-error-regexp-alist)
  724. (require 'ansi-color)
  725. (add-hook 'compilation-filter-hook
  726. (lambda ()
  727. (let ((inhibit-read-only t))
  728. (ansi-color-apply-on-region compilation-filter-start
  729. (point)))))
  730. (add-to-list 'compilation-error-regexp-alist
  731. ;; ansible-lint
  732. '("^\\([^ \n]+\\):\\([0-9]+\\)$" 1 2)))
  733. ;; Workaround to avoid ensime error
  734. (defvar ensime-mode-key-prefix nil)
  735. ;; http://qiita.com/sune2/items/b73037f9e85962f5afb7
  736. (when (safe-require-or-eval 'company)
  737. (global-company-mode)
  738. (set-variable 'company-idle-delay 0.5)
  739. (set-variable 'company-minimum-prefix-length 2)
  740. (set-variable 'company-selection-wrap-around t))
  741. ;; https://github.com/lunaryorn/flycheck
  742. (when (safe-require-or-eval 'flycheck)
  743. (call-after-init 'global-flycheck-mode))
  744. (when (autoload-eval-lazily 'ilookup)
  745. (define-key ctl-x-map "d" 'ilookup-open-word))
  746. (set-variable 'ac-ignore-case nil)
  747. (when (autoload-eval-lazily 'term-run '(term-run-shell-command term-run))
  748. (define-key ctl-x-map "t" 'term-run-shell-command))
  749. (add-to-list 'safe-local-variable-values
  750. '(encoding utf-8))
  751. (setq enable-local-variables :safe)
  752. ;; Detect file type from shebang and set major-mode.
  753. (add-to-list 'interpreter-mode-alist
  754. '("python3" . python-mode))
  755. (add-to-list 'interpreter-mode-alist
  756. '("python2" . python-mode))
  757. (with-eval-after-load 'python
  758. (defvar python-mode-map (make-sparse-keymap))
  759. (define-key python-mode-map (kbd "C-m") 'newline-and-indent))
  760. (when (autoload-eval-lazily 'pipenv)
  761. (add-hook 'python-mode-hook
  762. (lambda ()
  763. (pipenv-mode 1)
  764. (pipenv-projectile-after-switch-default)))
  765. )
  766. (set-variable 'flycheck-python-pycompile-executable "python3")
  767. ;; http://fukuyama.co/foreign-regexp
  768. '(and (safe-require-or-eval 'foreign-regexp)
  769. (progn
  770. (setq foreign-regexp/regexp-type 'perl)
  771. '(setq reb-re-syntax 'foreign-regexp)
  772. ))
  773. (autoload-eval-lazily 'sql '(sql-mode)
  774. (require 'sql-indent nil t))
  775. (when (autoload-eval-lazily 'git-command)
  776. (define-key ctl-x-map "g" 'git-command))
  777. (when (safe-require-or-eval 'git-commit)
  778. (global-git-commit-mode 1))
  779. (with-eval-after-load 'git-commit
  780. (add-hook 'git-commit-setup-hook
  781. 'turn-off-auto-fill t))
  782. (autoload-eval-lazily 'sl)
  783. (with-eval-after-load 'rst
  784. (defvar rst-mode-map)
  785. (define-key rst-mode-map (kbd "C-m") 'newline-and-indent))
  786. (with-eval-after-load 'jdee
  787. (add-hook 'jdee-mode-hook
  788. (lambda ()
  789. (make-local-variable 'global-mode-string)
  790. (add-to-list 'global-mode-string
  791. mode-line-position))))
  792. ;; Cannot enable error thrown. Why???
  793. ;; https://github.com/m0smith/malabar-mode#Installation
  794. ;; (when (autoload-eval-lazily 'malabar-mode)
  795. ;; (add-to-list 'load-path
  796. ;; (expand-file-name (concat user-emacs-directory "/cedet")))
  797. ;; (safe-require-or-eval 'cedet-devel-load)
  798. ;; (call-after-init 'activate-malabar-mode))
  799. (with-eval-after-load 'make-mode
  800. (defvar makefile-mode-map (make-sparse-keymap))
  801. (define-key makefile-mode-map (kbd "C-m") 'newline-and-indent)
  802. ;; this functions is set in write-file-functions, i cannot find any
  803. ;; good way to remove this.
  804. (fset 'makefile-warn-suspicious-lines 'ignore))
  805. (with-eval-after-load 'verilog-mode
  806. (defvar verilog-mode-map (make-sparse-keymap))
  807. (define-key verilog-mode-map ";" 'self-insert-command))
  808. (setq diff-switches "-u")
  809. (with-eval-after-load 'diff-mode
  810. ;; (when (and (eq major-mode
  811. ;; 'diff-mode)
  812. ;; (not buffer-file-name))
  813. ;; ;; do not pass when major-mode is derived mode of diff-mode
  814. ;; (view-mode 1))
  815. (set-face-attribute 'diff-header nil
  816. :foreground nil
  817. :background nil
  818. :weight 'bold)
  819. (set-face-attribute 'diff-file-header nil
  820. :foreground nil
  821. :background nil
  822. :weight 'bold)
  823. (set-face-foreground 'diff-index "blue")
  824. (set-face-attribute 'diff-hunk-header nil
  825. :foreground "cyan"
  826. :weight 'normal)
  827. (set-face-attribute 'diff-context nil
  828. ;; :foreground "white"
  829. :foreground nil
  830. :weight 'normal)
  831. (set-face-foreground 'diff-removed "red")
  832. (set-face-foreground 'diff-added "green")
  833. (set-face-background 'diff-removed nil)
  834. (set-face-background 'diff-added nil)
  835. (set-face-attribute 'diff-changed nil
  836. :foreground "magenta"
  837. :weight 'normal)
  838. (set-face-attribute 'diff-refine-changed nil
  839. :foreground nil
  840. :background nil
  841. :weight 'bold
  842. :inverse-video t)
  843. ;; Annoying !
  844. ;;(diff-auto-refine-mode)
  845. )
  846. ;; (ffap-bindings)
  847. (set-variable 'browse-url-browser-function
  848. 'eww-browse-url)
  849. (set-variable 'sh-here-document-word "__EOC__")
  850. (when (autoload-eval-lazily 'adoc-mode
  851. nil
  852. (defvar adoc-mode-map (make-sparse-keymap))
  853. (define-key adoc-mode-map (kbd "C-m") 'newline))
  854. (setq auto-mode-alist
  855. `(("\\.adoc\\'" . adoc-mode)
  856. ("\\.asciidoc\\'" . adoc-mode)
  857. ,@auto-mode-alist)))
  858. (with-eval-after-load 'markup-faces
  859. ;; Is this too match ?
  860. (set-face-foreground 'markup-meta-face
  861. "color-245")
  862. (set-face-foreground 'markup-meta-hide-face
  863. "color-245")
  864. )
  865. ;; TODO: check if this is required
  866. (when (autoload-eval-lazily 'groovy-mode nil
  867. (defvar groovy-mode-map (make-sparse-keymap))
  868. (define-key groovy-mode-map "(" 'self-insert-command)
  869. (define-key groovy-mode-map ")" 'self-insert-command)
  870. (define-key groovy-mode-map (kbd "C-m") 'newline-and-indent)
  871. )
  872. (add-to-list 'auto-mode-alist
  873. '("build\\.gradle\\'" . groovy-mode)))
  874. (with-eval-after-load 'yaml-mode
  875. (defvar yaml-mode-map (make-sparse-keymap))
  876. (define-key yaml-mode-map (kbd "C-m") 'newline))
  877. (with-eval-after-load 'html-mode
  878. (defvar html-mode-map (make-sparse-keymap))
  879. (define-key html-mode-map (kbd "C-m") 'reindent-then-newline-and-indent))
  880. (with-eval-after-load 'text-mode
  881. (define-key text-mode-map (kbd "C-m") 'newline))
  882. (autoload-eval-lazily 'info nil
  883. (defvar Info-additional-directory-list)
  884. (dolist (dir (directory-files (concat user-emacs-directory
  885. "info")
  886. t
  887. "^[^.].*"))
  888. (when (file-directory-p dir)
  889. (add-to-list 'Info-additional-directory-list
  890. dir)))
  891. (let ((dir (expand-file-name "~/.brew/share/info")))
  892. (when (file-directory-p dir)
  893. (add-to-list 'Info-additional-directory-list
  894. dir))))
  895. (with-eval-after-load 'apropos
  896. (defvar apropos-mode-map (make-sparse-keymap))
  897. (define-key apropos-mode-map "n" 'next-line)
  898. (define-key apropos-mode-map "p" 'previous-line))
  899. ;; `isearch' library does not call `provide' so cannot use with-eval-after-load
  900. ;; (define-key isearch-mode-map
  901. ;; (kbd "C-j") 'isearch-other-control-char)
  902. ;; (define-key isearch-mode-map
  903. ;; (kbd "C-k") 'isearch-other-control-char)
  904. ;; (define-key isearch-mode-map
  905. ;; (kbd "C-h") 'isearch-other-control-char)
  906. (define-key isearch-mode-map (kbd "C-h") 'isearch-del-char)
  907. (define-key isearch-mode-map (kbd "M-r")
  908. 'isearch-query-replace-regexp)
  909. ;; do not cleanup isearch highlight: use `lazy-highlight-cleanup' to remove
  910. (setq lazy-highlight-cleanup nil)
  911. ;; face for isearch highlighing
  912. (set-face-attribute 'lazy-highlight
  913. nil
  914. :foreground `unspecified
  915. :background `unspecified
  916. :underline t
  917. ;; :weight `bold
  918. )
  919. (add-hook 'outline-mode-hook
  920. (lambda ()
  921. (when (string-match "\\.md\\'" buffer-file-name)
  922. (set (make-local-variable 'outline-regexp) "#+ "))))
  923. (add-to-list 'auto-mode-alist (cons "\\.ol\\'" 'outline-mode))
  924. (add-to-list 'auto-mode-alist (cons "\\.md\\'" 'outline-mode))
  925. (when (autoload-eval-lazily 'markdown-mode
  926. '(markdown-mode gfm-mode)
  927. (defvar gfm-mode-map (make-sparse-keymap))
  928. (define-key gfm-mode-map (kbd "C-m") 'electric-indent-just-newline))
  929. (add-to-list 'auto-mode-alist (cons "\\.md\\'" 'gfm-mode))
  930. (set-variable 'markdown-command (or (executable-find "markdown")
  931. (executable-find "markdown.pl")
  932. ""))
  933. (add-hook 'markdown-mode-hook
  934. (lambda ()
  935. (outline-minor-mode 1)
  936. (flyspell-mode)
  937. (set (make-local-variable 'comment-start) ";")))
  938. )
  939. ;; c-mode
  940. ;; http://www.emacswiki.org/emacs/IndentingC
  941. ;; http://en.wikipedia.org/wiki/Indent_style
  942. ;; http://d.hatena.ne.jp/emergent/20070203/1170512717
  943. ;; http://seesaawiki.jp/whiteflare503/d/Emacs%20%a5%a4%a5%f3%a5%c7%a5%f3%a5%c8
  944. (with-eval-after-load 'cc-vars
  945. (defvar c-default-style nil)
  946. (add-to-list 'c-default-style
  947. '(c-mode . "k&r"))
  948. (add-to-list 'c-default-style
  949. '(c++-mode . "k&r")))
  950. (autoload-eval-lazily 'js2-mode nil
  951. ;; currently do not use js2-mode
  952. ;; (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
  953. ;; (add-to-list 'auto-mode-alist '("\\.jsm\\'" . js2-mode))
  954. ;; (defvar js2-mode-map (make-sparse-keymap))
  955. ;; (define-key js2-mode-map (kbd "C-m") (lambda ()
  956. ;; (interactive)
  957. ;; (js2-enter-key)
  958. ;; (indent-for-tab-command)))
  959. ;; (add-hook (kill-local-variable 'before-save-hook)
  960. ;; 'js2-before-save)
  961. ;; (add-hook 'before-save-hook
  962. ;; 'my-indent-buffer
  963. ;; nil
  964. ;; t)
  965. )
  966. (add-to-list 'interpreter-mode-alist
  967. '("node" . js-mode))
  968. (add-hook 'haskell-mode-hook 'turn-on-haskell-indentation)
  969. (with-eval-after-load 'uniquify
  970. (setq uniquify-buffer-name-style 'post-forward-angle-brackets)
  971. (setq uniquify-ignore-buffers-re "*[^*]+*")
  972. (setq uniquify-min-dir-content 1))
  973. (with-eval-after-load 'view
  974. (defvar view-mode-map (make-sparse-keymap))
  975. (define-key view-mode-map "j" 'scroll-up-line)
  976. (define-key view-mode-map "k" 'scroll-down-line)
  977. (define-key view-mode-map "v" 'toggle-read-only)
  978. (define-key view-mode-map "q" 'bury-buffer)
  979. ;; (define-key view-mode-map "/" 'nonincremental-re-search-forward)
  980. ;; (define-key view-mode-map "?" 'nonincremental-re-search-backward)
  981. ;; (define-key view-mode-map
  982. ;; "n" 'nonincremental-repeat-search-forward)
  983. ;; (define-key view-mode-map
  984. ;; "N" 'nonincremental-repeat-search-backward)
  985. (define-key view-mode-map "/" 'isearch-forward-regexp)
  986. (define-key view-mode-map "?" 'isearch-backward-regexp)
  987. (define-key view-mode-map "n" 'isearch-repeat-forward)
  988. (define-key view-mode-map "N" 'isearch-repeat-backward)
  989. (define-key view-mode-map (kbd "C-m") 'my-rgrep-symbol-at-point))
  990. (global-set-key "\M-r" 'view-mode)
  991. ;; (setq view-read-only t)
  992. (with-eval-after-load 'term
  993. (defvar term-raw-map (make-sparse-keymap))
  994. (define-key term-raw-map (kbd "C-x")
  995. (lookup-key (current-global-map)
  996. (kbd "C-x"))))
  997. (add-hook 'term-mode-hook
  998. (lambda ()
  999. ;; Stop current line highlighting
  1000. (set (make-local-variable (defvar hl-line-range-function))
  1001. (lambda () '(0 . 0)))
  1002. (set (make-local-variable 'scroll-margin)
  1003. 0)))
  1004. (add-hook 'Man-mode-hook
  1005. (lambda ()
  1006. (view-mode 1)
  1007. (setq truncate-lines nil)))
  1008. (set-variable 'Man-notify-method (if window-system
  1009. 'newframe
  1010. 'aggressive))
  1011. (set-variable 'woman-cache-filename (expand-file-name (concat user-emacs-directory
  1012. "woman_cache.el")))
  1013. ;; not work because man.el will be loaded when man called
  1014. (defalias 'man 'woman)
  1015. (add-to-list 'auto-mode-alist
  1016. '("tox\\.ini\\'" . conf-unix-mode))
  1017. (when (autoload-eval-lazily 'toml-mode)
  1018. (add-to-list 'auto-mode-alist
  1019. '("/tox\\.ini\\'" . toml-mode))
  1020. (add-to-list 'auto-mode-alist
  1021. '("/Pipfile\\'" . toml-mode)))
  1022. (when (autoload-eval-lazily 'json-mode)
  1023. (add-to-list 'auto-mode-alist
  1024. '("/Pipfile\\.lock\\'" . json-mode)))
  1025. (add-hook 'go-mode-hook
  1026. (lambda()
  1027. (defvar go-mode-map)
  1028. (add-hook 'before-save-hook' 'gofmt-before-save)
  1029. (define-key go-mode-map (kbd "M-.") 'godef-jump)))
  1030. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1031. ;; buffers
  1032. (defvar bs-configurations)
  1033. (when (autoload-eval-lazily 'bs '(bs-show)
  1034. (add-to-list 'bs-configurations
  1035. '("specials" "^\\*" nil ".*" nil nil))
  1036. (add-to-list 'bs-configurations
  1037. '("files-and-specials" "^\\*" buffer-file-name ".*" nil nil))
  1038. (defvar bs-mode-map)
  1039. (defvar bs-current-configuration)
  1040. (define-key bs-mode-map (kbd "t")
  1041. ;; TODO: fix toggle feature
  1042. (lambda ()
  1043. (interactive)
  1044. (if (string= "specials"
  1045. bs-current-configuration)
  1046. (bs-set-configuration "files")
  1047. (bs-set-configuration "specials"))
  1048. (bs-refresh)
  1049. (bs-message-without-log "%s"
  1050. (bs--current-config-message))))
  1051. ;; (setq bs-configurations (list
  1052. ;; '("processes" nil get-buffer-process ".*" nil nil)
  1053. ;; '("files-and-scratch" "^\\*scratch\\*$" nil nil
  1054. ;; bs-visits-non-file bs-sort-buffer-interns-are-last)))
  1055. )
  1056. (defalias 'list-buffers 'bs-show)
  1057. (set-variable 'bs-default-configuration "files-and-specials")
  1058. (set-variable 'bs-default-sort-name "by nothing")
  1059. (add-hook 'bs-mode-hook
  1060. (lambda ()
  1061. (set (make-local-variable 'scroll-margin) 0))))
  1062. ;;(iswitchb-mode 1)
  1063. (icomplete-mode)
  1064. (defun iswitchb-buffer-display-other-window ()
  1065. "Do iswitchb in other window."
  1066. (interactive)
  1067. (let ((iswitchb-default-method 'display))
  1068. (call-interactively 'iswitchb-buffer)))
  1069. ;; buffer killing
  1070. ;; (defun my-delete-window-killing-buffer () nil)
  1071. (defun my-query-kill-current-buffer ()
  1072. "Interactively kill current buffer."
  1073. (interactive)
  1074. (if (y-or-n-p (concat "kill current buffer? :"))
  1075. (kill-buffer (current-buffer))))
  1076. ;;(global-set-key "\C-xk" 'my-query-kill-current-buffer)
  1077. (substitute-key-definition 'kill-buffer
  1078. 'my-query-kill-current-buffer
  1079. global-map)
  1080. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1081. ;; recentf-mode
  1082. (set-variable 'recentf-save-file (expand-file-name (concat user-emacs-directory
  1083. "recentf")))
  1084. (set-variable 'recentf-max-menu-items 20)
  1085. (set-variable 'recentf-max-saved-items 30)
  1086. (set-variable 'recentf-show-file-shortcuts-flag nil)
  1087. (set-variable 'recentf-auto-cleanup 3)
  1088. ;; (safe-require-or-eval 'sync-recentf)
  1089. ;; (when (safe-require-or-eval 'recentf)
  1090. ;; (add-to-list 'recentf-exclude
  1091. ;; (regexp-quote recentf-save-file))
  1092. ;; (add-to-list 'recentf-exclude
  1093. ;; (regexp-quote (expand-file-name user-emacs-directory)))
  1094. ;; (add-to-list 'recentf-exclude
  1095. ;; "/sync-recentf-marker\\'")
  1096. ;; (define-key ctl-x-map (kbd "C-r") 'recentf-open-files)
  1097. ;; (remove-hook 'find-file-hook
  1098. ;; 'recentf-track-opened-file)
  1099. ;; (defun my-recentf-load-track-save-list ()
  1100. ;; "Load current recentf list from file, track current visiting file, then save
  1101. ;; the list."
  1102. ;; (recentf-load-list)
  1103. ;; (recentf-track-opened-file)
  1104. ;; (recentf-save-list))
  1105. ;; (add-hook 'find-file-hook
  1106. ;; 'my-recentf-load-track-save-list)
  1107. ;; (add-hook 'kill-emacs-hook
  1108. ;; 'recentf-load-list)
  1109. ;; ;;(run-with-idle-timer 5 t 'recentf-save-list)
  1110. ;; ;; (add-hook 'find-file-hook
  1111. ;; ;; (lambda ()
  1112. ;; ;; (recentf-add-file default-directory)))
  1113. ;; (when (autoload-eval-lazily 'recentf-show)
  1114. ;; (define-key ctl-x-map (kbd "C-r") 'recentf-show)
  1115. ;; ;; (add-hook 'recentf-show-before-listing-hook
  1116. ;; ;; 'recentf-load-list)
  1117. ;; )
  1118. ;; (recentf-mode 1)
  1119. ;; (define-key recentf-dialog-mode-map (kbd "<up>") 'previous-line)
  1120. ;; (define-key recentf-dialog-mode-map (kbd "<down>") 'next-line)
  1121. ;; (define-key recentf-dialog-mode-map "p" 'previous-line)
  1122. ;; (define-key recentf-dialog-mode-map "n" 'next-line)
  1123. ;; (add-hook 'recentf-dialog-mode-hook
  1124. ;; (lambda ()
  1125. ;; ;; (recentf-save-list)
  1126. ;; ;; (define-key recentf-dialog-mode-map (kbd "C-x C-f")
  1127. ;; ;; 'my-recentf-cd-and-find-file)
  1128. ;; (cd "~/"))))
  1129. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1130. ;; dired
  1131. (defun my-file-head (filename &optional n)
  1132. "Return list of first N lines of file FILENAME."
  1133. ;; TODO: Fix for janapese text
  1134. ;; TODO: Fix for short text
  1135. (let ((num (or n 10))
  1136. (size 100)
  1137. (beg 0)
  1138. (end 0)
  1139. (result '())
  1140. (read -1))
  1141. (with-temp-buffer
  1142. (erase-buffer)
  1143. (while (or (<= (count-lines (point-min)
  1144. (point-max))
  1145. num)
  1146. (eq read 0))
  1147. (setq end (+ beg size))
  1148. (setq read (nth 1 (insert-file-contents-literally filename
  1149. nil
  1150. beg
  1151. end)))
  1152. (goto-char (point-max))
  1153. (setq beg (+ beg size)))
  1154. (goto-char (point-min))
  1155. (while (< (length result) num)
  1156. (let ((start (point)))
  1157. (forward-line 1)
  1158. (setq result
  1159. `(,@result ,(buffer-substring-no-properties start
  1160. (point))))))
  1161. result
  1162. ;; (buffer-substring-no-properties (point-min)
  1163. ;; (progn
  1164. ;; (forward-line num)
  1165. ;; (point)))
  1166. )))
  1167. ;; (apply 'concat (my-file-head "./shrc" 10)
  1168. (defun my-dired-echo-file-head (arg)
  1169. "Echo head of current file.
  1170. ARG is num to show, or defaults to 7."
  1171. (interactive "P")
  1172. (let ((f (dired-get-filename)))
  1173. (message "%s"
  1174. (apply 'concat
  1175. (my-file-head f
  1176. 7)))))
  1177. (defun my-dired-diff ()
  1178. "Show diff of marked file and file of current line."
  1179. (interactive)
  1180. (let ((files (dired-get-marked-files nil nil nil t)))
  1181. (if (eq (car files)
  1182. t)
  1183. (diff (cadr files) (dired-get-filename))
  1184. (message "One file must be marked!"))))
  1185. (defun dired-get-file-info ()
  1186. "Print information of current line file."
  1187. (interactive)
  1188. (let ((f (shell-quote-argument (dired-get-filename t))))
  1189. (if (file-directory-p f)
  1190. (progn
  1191. (message "Calculating disk usage...")
  1192. (shell-command (concat "du -hsD "
  1193. f)))
  1194. (shell-command (concat "file "
  1195. f)))))
  1196. (defun my-dired-scroll-up ()
  1197. "Scroll up."
  1198. (interactive)
  1199. (my-dired-previous-line (- (window-height) 1)))
  1200. (defun my-dired-scroll-down ()
  1201. "Scroll down."
  1202. (interactive)
  1203. (my-dired-next-line (- (window-height) 1)))
  1204. ;; (defun my-dired-forward-line (arg)
  1205. ;; ""
  1206. ;; (interactive "p"))
  1207. (defun my-dired-previous-line (arg)
  1208. "Move ARG lines up."
  1209. (interactive "p")
  1210. (if (> arg 0)
  1211. (progn
  1212. (if (eq (line-number-at-pos)
  1213. 1)
  1214. (goto-char (point-max))
  1215. (forward-line -1))
  1216. (my-dired-previous-line (if (or (dired-get-filename nil t)
  1217. (dired-get-subdir))
  1218. (- arg 1)
  1219. arg)))
  1220. (dired-move-to-filename)))
  1221. (defun my-dired-next-line (arg)
  1222. "Move ARG lines down."
  1223. (interactive "p")
  1224. (if (> arg 0)
  1225. (progn
  1226. (if (eq (point)
  1227. (point-max))
  1228. (goto-char (point-min))
  1229. (forward-line 1))
  1230. (my-dired-next-line (if (or (dired-get-filename nil t)
  1231. (dired-get-subdir))
  1232. (- arg 1)
  1233. arg)))
  1234. (dired-move-to-filename)))
  1235. (defun my-tramp-remote-find-file (f)
  1236. "Open F."
  1237. (interactive (list (read-file-name "My Find File Tramp: "
  1238. "/scp:"
  1239. nil ;; "/scp:"
  1240. (confirm-nonexistent-file-or-buffer))))
  1241. (find-file f))
  1242. ;;http://bach.istc.kobe-u.ac.jp/lect/tamlab/ubuntu/emacs.html
  1243. (if (eq window-system 'mac)
  1244. (setq dired-listing-switches "-lhF")
  1245. (setq dired-listing-switches "-lhF --time-style=long-iso")
  1246. )
  1247. (setq dired-listing-switches "-lhF")
  1248. ;; when using dired-find-alternate-file
  1249. ;; reuse current dired buffer for the file to open
  1250. ;; (put 'dired-find-alternate-file 'disabled nil)
  1251. (set-variable 'dired-ls-F-marks-symlinks t)
  1252. (set-variable 'ls-lisp-use-insert-directory-program nil) ; always use ls-lisp
  1253. (set-variable 'ls-lisp-dirs-first t)
  1254. (set-variable 'ls-lisp-use-localized-time-format t)
  1255. (set-variable 'ls-lisp-format-time-list
  1256. '("%Y-%m-%d %H:%M"
  1257. "%Y-%m-%d "))
  1258. (set-variable 'dired-dwim-target t)
  1259. (set-variable 'dired-isearch-filenames t)
  1260. (set-variable 'dired-hide-details-hide-symlink-targets nil)
  1261. (set-variable 'dired-hide-details-hide-information-lines nil)
  1262. (set-variable 'dired-deletion-confirmer 'y-or-n-p)
  1263. (set-variable 'dired-recursive-deletes 'always)
  1264. ;; (add-hook 'dired-after-readin-hook
  1265. ;; 'my-replace-nasi-none)
  1266. (with-eval-after-load 'dired
  1267. (safe-require-or-eval 'ls-lisp)
  1268. (defvar dired-mode-map (make-sparse-keymap))
  1269. ;; dired-do-chgrp sometimes cause system hung
  1270. (define-key dired-mode-map "G" 'ignore)
  1271. (define-key dired-mode-map "w" 'wdired-change-to-wdired-mode)
  1272. (define-key dired-mode-map "i" 'dired-get-file-info)
  1273. (define-key dired-mode-map "f" 'find-file)
  1274. (define-key dired-mode-map "!" 'shell-command)
  1275. (define-key dired-mode-map "&" 'async-shell-command)
  1276. (define-key dired-mode-map "X" 'dired-do-async-shell-command)
  1277. (define-key dired-mode-map "=" 'my-dired-diff)
  1278. (define-key dired-mode-map "B" 'gtkbm-add-current-dir)
  1279. (define-key dired-mode-map "b" 'gtkbm)
  1280. (define-key dired-mode-map "h" 'my-dired-echo-file-head)
  1281. (define-key dired-mode-map (kbd "TAB") 'other-window)
  1282. ;; (define-key dired-mode-map "P" 'my-dired-do-pack-or-unpack)
  1283. (define-key dired-mode-map "/" 'dired-isearch-filenames)
  1284. (define-key dired-mode-map (kbd "DEL") 'dired-up-directory)
  1285. (define-key dired-mode-map (kbd "C-h") 'dired-up-directory)
  1286. (substitute-key-definition 'dired-next-line
  1287. 'my-dired-next-line
  1288. dired-mode-map)
  1289. (substitute-key-definition 'dired-previous-line
  1290. 'my-dired-previous-line
  1291. dired-mode-map)
  1292. ;; (define-key dired-mode-map (kbd "C-p") 'my-dired-previous-line)
  1293. ;; (define-key dired-mode-map (kbd "p") 'my-dired-previous-line)
  1294. ;; (define-key dired-mode-map (kbd "C-n") 'my-dired-next-line)
  1295. ;; (define-key dired-mode-map (kbd "n") 'my-dired-next-line)
  1296. (define-key dired-mode-map (kbd "<left>") 'my-dired-scroll-up)
  1297. (define-key dired-mode-map (kbd "<right>") 'my-dired-scroll-down)
  1298. (define-key dired-mode-map (kbd "ESC p") 'my-dired-scroll-up)
  1299. (define-key dired-mode-map (kbd "ESC n") 'my-dired-scroll-down)
  1300. (add-hook 'dired-mode-hook
  1301. (lambda ()
  1302. (when (fboundp 'dired-hide-details-mode)
  1303. (dired-hide-details-mode t)
  1304. (local-set-key "l" 'dired-hide-details-mode))
  1305. (let ((file "._Icon\015"))
  1306. (when nil
  1307. '(file-readable-p file)
  1308. (delete-file file)))))
  1309. (when (autoload-eval-lazily 'pack '(dired-do-pack-or-unpack pack-pack))
  1310. (with-eval-after-load 'dired
  1311. (define-key dired-mode-map "P" 'pack-dired-dwim)))
  1312. (when (autoload-eval-lazily 'dired-list-all-mode)
  1313. (setq dired-listing-switches "-lhF")
  1314. (with-eval-after-load 'dired
  1315. (define-key dired-mode-map "a" 'dired-list-all-mode))))
  1316. (when (autoload-eval-lazily 'dired-filter)
  1317. (add-hook 'dired-mode-hook
  1318. 'dired-filter-mode))
  1319. ;; Currently disabled in favor of dired-from-git-ls-files
  1320. ;; (define-key ctl-x-map "f" 'find-dired)
  1321. ;; It works!
  1322. ;; (pop-to-buffer (dired-noselect '("." "shrc" "emacs.el")))
  1323. (defun my-dired-git-ls-files (args)
  1324. "Dired from git ls-files."
  1325. (interactive "sgit ls-files args: ")
  1326. (pop-to-buffer-same-window
  1327. (dired-noselect `(,default-directory
  1328. ,@(split-string (shell-command-to-string (concat "git ls-files -z " args))
  1329. "\0" t))
  1330. ""))
  1331. )
  1332. (define-key ctl-x-map (kbd "f") 'my-dired-git-ls-files)
  1333. (with-eval-after-load 'dired
  1334. (defvar dired-mode-map (make-sparse-keymap))
  1335. (define-key dired-mode-map "f" 'my-dired-git-ls-files))
  1336. ;; (define-minor-mode my-dired-glob-filter)
  1337. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1338. ;; misc funcs
  1339. (defalias 'qcalc 'quick-calc)
  1340. (defun memo (&optional dir)
  1341. "Open memo.txt in DIR."
  1342. (interactive)
  1343. (pop-to-buffer (find-file-noselect (concat (if dir
  1344. (file-name-as-directory dir)
  1345. "")
  1346. "memo.txt"))))
  1347. (set (defvar my-rgrep-alist nil
  1348. "Alist of rgrep command.
  1349. Each element is in the form like (NAME SEXP COMMAND), where SEXP returns the
  1350. condition to choose COMMAND when evaluated.")
  1351. `(
  1352. ;; ripgrep
  1353. ("rg"
  1354. (executable-find "rg")
  1355. "rg --hidden --no-heading --smart-case ")
  1356. ;; git grep
  1357. ("gitgrep"
  1358. (eq 0
  1359. (shell-command "git rev-parse --git-dir"))
  1360. "git --no-pager -c color.grep=always grep -nH -e ")
  1361. ;; sift
  1362. ("sift"
  1363. (executable-find "sift")
  1364. ("sift --binary-skip --filename --line-number --git --smart-case "))
  1365. ;; the silver searcher
  1366. ("ag"
  1367. (executable-find "ag")
  1368. "ag --nogroup --nopager --filename ")
  1369. ;; ack
  1370. ("ack"
  1371. (executable-find "ack")
  1372. "ack --nogroup --nopager --with-filename ")
  1373. ;; gnu global
  1374. ("global"
  1375. (and (require 'ggtags nil t)
  1376. (executable-find "global")
  1377. (ggtags-current-project-root))
  1378. "global --result grep ")
  1379. ;; grep
  1380. ("grep"
  1381. t
  1382. ,(concat "find . "
  1383. "-path '*/.git' -prune -o "
  1384. "-path '*/.svn' -prune -o "
  1385. "-type f -print0 | "
  1386. "xargs -0 grep -nH -e "))
  1387. )
  1388. )
  1389. (defvar my-rgrep-default nil
  1390. "Default command name for my-rgrep.")
  1391. (defun my-rgrep-grep-command (&optional name alist)
  1392. "Return recursive grep command for current directory or nil.
  1393. If NAME is given, use that without testing.
  1394. Commands are searched from ALIST."
  1395. (if alist
  1396. (if name
  1397. ;; if name is given search that from alist and return the command
  1398. (nth 2 (assoc name
  1399. alist))
  1400. ;; if name is not given try test in 1th elem
  1401. (let ((car (car alist))
  1402. (cdr (cdr alist)))
  1403. (if (eval (nth 1 car))
  1404. ;; if the condition is true return the command
  1405. (nth 2 car)
  1406. ;; try next one
  1407. (and cdr
  1408. (my-rgrep-grep-command name cdr)))))
  1409. ;; if alist is not given set default value
  1410. (my-rgrep-grep-command name my-rgrep-alist)))
  1411. (defun my-rgrep (command-args)
  1412. "My recursive grep. Run COMMAND-ARGS.
  1413. If prefix argument is given, use current symbol as default search target
  1414. and search from projectile root (if projectile is available)."
  1415. (interactive (let ((cmd (my-rgrep-grep-command my-rgrep-default
  1416. nil)))
  1417. (if cmd
  1418. (list (read-shell-command "grep command: "
  1419. (concat cmd
  1420. (if current-prefix-arg
  1421. (thing-at-point 'symbol t)
  1422. ""))
  1423. 'grep-find-history))
  1424. (error "My-Rgrep: Command for rgrep not found")
  1425. )))
  1426. (if (and current-prefix-arg
  1427. (safe-require-or-eval 'projectile)
  1428. (projectile-project-p))
  1429. (projectile-with-default-dir (projectile-project-root)
  1430. (compilation-start command-args
  1431. 'grep-mode))
  1432. (compilation-start command-args
  1433. 'grep-mode)))
  1434. (defun my-rgrep-thing-at-point-projectile-root ()
  1435. "My recursive grep to find thing at point from project root."
  1436. (interactive)
  1437. (let* ((cmd (my-rgrep-grep-command my-rgrep-default
  1438. nil))
  1439. (command-args
  1440. (if cmd
  1441. (concat cmd
  1442. (or (thing-at-point 'symbol t)
  1443. (error "No symbol at point")))
  1444. (error "My-Rgrep: Command for rgrep not found"))))
  1445. (if (safe-require-or-eval 'projectile)
  1446. (projectile-with-default-dir (or (projectile-project-root)
  1447. default-directory)
  1448. (compilation-start command-args
  1449. 'grep-mode))
  1450. (compilation-start command-args
  1451. 'grep-mode))))
  1452. (defmacro define-my-rgrep (name)
  1453. "Define rgrep for NAME."
  1454. `(defun ,(intern (concat "my-rgrep-"
  1455. name)) ()
  1456. ,(format "My recursive grep by %s."
  1457. name)
  1458. (interactive)
  1459. (let ((my-rgrep-default ,name))
  1460. (if (called-interactively-p 'any)
  1461. (call-interactively 'my-rgrep)
  1462. (error "Not intended to be called noninteractively. Use `my-rgrep'"))))
  1463. )
  1464. (define-my-rgrep "ack")
  1465. (define-my-rgrep "ag")
  1466. (define-my-rgrep "rg")
  1467. (define-my-rgrep "sift")
  1468. (define-my-rgrep "gitgrep")
  1469. (define-my-rgrep "grep")
  1470. (define-my-rgrep "global")
  1471. (define-key ctl-x-map "s" 'my-rgrep)
  1472. (define-key ctl-x-map "." 'my-rgrep-thing-at-point-projectile-root)
  1473. (set-variable 'dumb-jump-prefer-searcher 'rg)
  1474. (defalias 'make 'compile)
  1475. (define-key ctl-x-map "c" 'compile)
  1476. ;;;;;;;;;;;;;;;;;;;;;;;
  1477. ;; adoc-simple-mode
  1478. (when (safe-require-or-eval 'adoc-mode)
  1479. (defvar adoc-simple-font-lock-keywords
  1480. nil)
  1481. (define-derived-mode adoc-simple-mode adoc-mode
  1482. "Adoc-Simple"
  1483. "Major mode for editing AsciiDoc text files.
  1484. This mode is a simplified version of `adoc-mode'."
  1485. '(set (make-local-variable 'font-lock-defaults)
  1486. '(adoc-simple-font-lock-keywords
  1487. nil nil nil nil
  1488. (font-lock-multiline . t)
  1489. (font-lock-mark-block-function . adoc-font-lock-mark-block-function))))
  1490. (add-to-list 'auto-mode-alist
  1491. '("\\.adoc\\'" . adoc-simple-mode)))
  1492. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1493. ;; awk-preview
  1494. (defgroup awk-preview nil
  1495. "Awk previewer."
  1496. :tag "Awk Preview"
  1497. :prefix "awk-preview-"
  1498. :group 'tools)
  1499. (defcustom awk-preview-program
  1500. (or (executable-find "gawk")
  1501. (executable-find "awk")
  1502. "awk")
  1503. "Awk program to execute."
  1504. :type 'string
  1505. :group 'awk-preview)
  1506. (defcustom awk-preview-switches
  1507. ;; '("--sandbox")
  1508. nil
  1509. "String of awk options appended when running awk preview."
  1510. :type '(repeat string)
  1511. :group 'awk-preview)
  1512. (defcustom awk-preview-default-program
  1513. "# C-c C-l to update preview, C-c C-c to commit, C-c C-k to abort.
  1514. {
  1515. print NR, $0
  1516. }
  1517. "
  1518. "Default awk command."
  1519. :type 'string
  1520. :group 'awk-preview)
  1521. (defvar awk-preview--point-beg
  1522. nil
  1523. "Point of beginning.")
  1524. (make-variable-buffer-local 'awk-preview--point-beg)
  1525. (defvar awk-preview--point-end
  1526. nil
  1527. "Point of end.")
  1528. (make-variable-buffer-local 'awk-preview--point-end)
  1529. (defvar awk-preview--preview-point-beg
  1530. nil
  1531. "Point of beginning.
  1532. Used by preview buffer and always same as awk-preview--point-beg.")
  1533. (make-variable-buffer-local 'awk-preview--preview-point-beg)
  1534. (defvar awk-preview--preview-point-end
  1535. nil
  1536. "Point of beginning.
  1537. Used by preview buffer and may defferent from awk-preview--point-end.")
  1538. (make-variable-buffer-local 'awk-preview--preview-point-end)
  1539. (defvar awk-preview--program-filename
  1540. nil
  1541. "Awk preview program file name.")
  1542. (make-variable-buffer-local 'awk-preview--program-filename)
  1543. (defvar awk-preview--source-buffer
  1544. nil
  1545. "Awk source buffer.")
  1546. (make-variable-buffer-local 'awk-preview--source-buffer)
  1547. (defvar awk-preview--preview-buffer
  1548. nil
  1549. "Awk preview buffer.")
  1550. (make-variable-buffer-local 'awk-preview--preview-buffer)
  1551. (defvar awk-preview--program-buffer
  1552. nil
  1553. "Awk program buffer.")
  1554. (make-variable-buffer-local 'awk-preview--program-buffer)
  1555. (defvar awk-preview--window-configuration
  1556. nil
  1557. "Awk preview window configuration.")
  1558. (defun awk-preview--invoke-awk (buf beg end progfile output &optional delete)
  1559. "Execute PROGFILE awk process with BEG and END input and output to OUTPUT buffer.
  1560. When OUTPUT is t the result will be output to BUF.
  1561. Delete the text between BEG and END when DELETE is non-nil."
  1562. (with-current-buffer buf
  1563. (let ((status (apply 'call-process-region
  1564. beg
  1565. end
  1566. awk-preview-program
  1567. delete
  1568. output
  1569. nil
  1570. `(,@awk-preview-switches "-f" ,progfile))))
  1571. (unless (eq status
  1572. 0)
  1573. (error "awk-preview: Awk program exited abnormally."))
  1574. output)))
  1575. (defvar awk-preview-program-buffer-name
  1576. "*AWK Preview Program<%s>*"
  1577. "Buffer name of awk preview program.")
  1578. (defvar awk-preview-preview-buffer-name
  1579. "*AWK Preview<%s>*"
  1580. "Buffer name of awk preview.")
  1581. (defun awk-preview--create-program-buffer (source preview)
  1582. "Create and show awk program buffer for SOURCE and PREVIEW buffer.
  1583. Return that buffer."
  1584. (let ((source-name (buffer-name source)))
  1585. (with-current-buffer (generate-new-buffer (format awk-preview-program-buffer-name
  1586. source-name))
  1587. (erase-buffer)
  1588. (insert awk-preview-default-program)
  1589. (awk-mode)
  1590. (awk-preview-program-mode 1)
  1591. (setq awk-preview--source-buffer source)
  1592. (setq awk-preview--preview-buffer preview)
  1593. (setq awk-preview--program-buffer (current-buffer))
  1594. (setq awk-preview--program-filename (make-temp-file "awk-preview-"
  1595. nil
  1596. ".awk"))
  1597. (current-buffer))))
  1598. (defun awk-preview-program-buffer-kill-hook ()
  1599. "Cleanup for awk-preview program buffer."
  1600. (when awk-preview--program-filename
  1601. (delete-file awk-preview--program-filename)))
  1602. (add-hook 'kill-buffer-hook
  1603. 'awk-preview-program-buffer-kill-hook)
  1604. (defun awk-preview--create-preview-buffer (source)
  1605. "Create preview buffer of SOURCE buffer and return it."
  1606. (with-current-buffer source
  1607. (let ((buffer-file-name nil)
  1608. (beg awk-preview--point-beg)
  1609. (end awk-preview--point-end))
  1610. (with-current-buffer (clone-buffer (format awk-preview-preview-buffer-name
  1611. (buffer-name)))
  1612. (awk-preview-program-mode 1)
  1613. (setq awk-preview--preview-point-beg beg)
  1614. (setq awk-preview--preview-point-end end)
  1615. (setq awk-preview--source-buffer source)
  1616. (setq awk-preview--preview-buffer (current-buffer))
  1617. (goto-char end)
  1618. (setq buffer-read-only t)
  1619. (current-buffer)))))
  1620. (defun awk-preview (beg end)
  1621. "Run awk and preview result."
  1622. (interactive "r")
  1623. (setq awk-preview--point-beg beg)
  1624. (setq awk-preview--point-end end)
  1625. (setq awk-preview--source-buffer (current-buffer))
  1626. (setq awk-preview--preview-buffer
  1627. (awk-preview--create-preview-buffer (current-buffer)))
  1628. (setq awk-preview--program-buffer
  1629. (awk-preview--create-program-buffer (current-buffer)
  1630. awk-preview--preview-buffer))
  1631. ;; At creation of preview buffer, program buffer is not available so set this
  1632. ;; here
  1633. (let ((b awk-preview--program-buffer))
  1634. (with-current-buffer awk-preview--preview-buffer
  1635. (setq awk-preview--program-buffer b)))
  1636. (setq awk-preview--window-configuration
  1637. (current-window-configuration))
  1638. (set-window-buffer (get-buffer-window awk-preview--source-buffer)
  1639. awk-preview--preview-buffer)
  1640. (pop-to-buffer awk-preview--program-buffer)
  1641. (switch-to-buffer awk-preview--program-buffer)
  1642. (awk-preview-update-preview)
  1643. )
  1644. (defun awk-preview-update-preview ()
  1645. "Update awk-preview."
  1646. (interactive)
  1647. (with-current-buffer awk-preview--program-buffer
  1648. (write-region (point-min)
  1649. (point-max)
  1650. awk-preview--program-filename))
  1651. (let ((output (with-current-buffer (get-buffer-create " *awk-preview output*")
  1652. (erase-buffer)
  1653. (current-buffer)))
  1654. (progfile (with-current-buffer awk-preview--program-buffer
  1655. awk-preview--program-filename)))
  1656. (with-current-buffer awk-preview--source-buffer
  1657. (awk-preview--invoke-awk (current-buffer)
  1658. awk-preview--point-beg
  1659. awk-preview--point-end
  1660. progfile
  1661. output)
  1662. (with-current-buffer awk-preview--preview-buffer
  1663. (let ((inhibit-read-only t))
  1664. (goto-char awk-preview--preview-point-end)
  1665. (delete-region awk-preview--preview-point-beg (point))
  1666. (insert-buffer-substring output)
  1667. (setq awk-preview--preview-point-end (point))))
  1668. )))
  1669. (defun awk-preview-commit ()
  1670. "Exit awk-preview and update buffer."
  1671. (interactive))
  1672. (defun awk-preview-abort ()
  1673. "Discard result and exit awk-preview."
  1674. (interactive))
  1675. (defun awk-preview--cleanup()
  1676. "Cleanup awk preview buffers and variables.")
  1677. (defvar awk-preview-program-mode-map
  1678. (let ((map (make-sparse-keymap)))
  1679. (define-key map (kbd "C-c C-l") 'awk-preview-update-preview)
  1680. (define-key map (kbd "C-c C-k") 'awk-preview-abort)
  1681. (define-key map (kbd "C-c C-c") 'awk-preview-commit)
  1682. map)
  1683. "Keymap for `awk-preview-program-mode'.")
  1684. (define-minor-mode awk-preview-program-mode
  1685. "Minor mode for awk-preview program buffer."
  1686. :lighter " AWKPrev"
  1687. :keymap awk-preview-program-mode-map)
  1688. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1689. ;; editorconfig-auto-apply
  1690. (define-minor-mode editorconfig-auto-apply-mode
  1691. "When saving .editorconfig file update buffer configs."
  1692. :global t
  1693. :lighter ""
  1694. (if editorconfig-auto-apply-mode
  1695. (add-hook 'after-save-hook
  1696. 'editorconfig-auto-apply-mode--when-save)
  1697. (remove-hook 'after-save-hook
  1698. 'editorconfig-auto-apply-mode--when-save)))
  1699. (defun editorconfig-auto-apply-mode--when-save ()
  1700. "When saving .editorconfig file walk all buffers and update configs."
  1701. (when (eq major-mode
  1702. 'editorconfig-conf-mode)
  1703. (let ((dir (file-name-directory buffer-file-name)))
  1704. (cl-dolist (buf (buffer-list))
  1705. (when (and (buffer-file-name buf)
  1706. (file-in-directory-p (buffer-file-name buf)
  1707. dir))
  1708. (with-current-buffer buf
  1709. (editorconfig-mode-apply)))))))
  1710. (editorconfig-auto-apply-mode 1)
  1711. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1712. ;; recently
  1713. (defgroup recently nil
  1714. "Recently visited files"
  1715. :tag "Recently"
  1716. :prefix "recently-"
  1717. :group 'tools)
  1718. (defcustom recently-file
  1719. (concat user-emacs-directory
  1720. "recently.el")
  1721. "Recently file."
  1722. :type 'string
  1723. :group 'recently)
  1724. (defcustom recently-max
  1725. 100
  1726. "Recently list max length."
  1727. :type 'int
  1728. :group 'recently)
  1729. (defcustom recently-excludes
  1730. '()
  1731. "List of regexps for filenames excluded from the recent list."
  1732. :type '(repeat string)
  1733. :group 'recently)
  1734. (add-to-list 'recently-excludes
  1735. (eval-when-compile (rx "/COMMIT_EDITMSG" eot)))
  1736. (defvar recently-list
  1737. '()
  1738. "Recently list.")
  1739. (defvar recently-file-mtime
  1740. nil
  1741. "Modified time of file when last read file.")
  1742. (defun recently-write ()
  1743. "Write to file."
  1744. (with-temp-buffer
  1745. (prin1 recently-list
  1746. (current-buffer))
  1747. (write-region (point-min)
  1748. (point-max)
  1749. recently-file)))
  1750. (defun recently-read ()
  1751. "Read file."
  1752. (when (file-readable-p recently-file)
  1753. (with-temp-buffer
  1754. (insert-file-contents recently-file)
  1755. (goto-char (point-min))
  1756. (setq recently-list
  1757. (read (current-buffer))))
  1758. (setq recently-file-mtime
  1759. (nth 5
  1760. (file-attributes recently-file)))))
  1761. (defun recently-reload ()
  1762. "Reload file."
  1763. (when (and (file-readable-p recently-file)
  1764. (not (equal recently-file-mtime
  1765. (nth 5
  1766. (file-attributes recently-file)))))
  1767. (recently-read)
  1768. (cl-assert (equal recently-file-mtime
  1769. (nth 5
  1770. (file-attributes recently-file))))))
  1771. (defun recently-add (path)
  1772. "Add PATH to list."
  1773. (cl-assert (string= path
  1774. (expand-file-name path)))
  1775. (when (cl-loop for re in recently-excludes
  1776. if (string-match re path) return nil
  1777. finally return t)
  1778. (recently-reload)
  1779. (let* ((l (copy-list recently-list))
  1780. (l (delete path
  1781. l))
  1782. (l (cl-loop for e in l
  1783. unless (file-in-directory-p path e)
  1784. collect e))
  1785. (l (cons path
  1786. l))
  1787. (l (recently--truncate l
  1788. recently-max)))
  1789. (unless (equal recently-list
  1790. l)
  1791. (setq recently-list l)
  1792. (recently-write)))))
  1793. (defun recently--truncate (list len)
  1794. "Truncate LIST to LEN."
  1795. (if (> (length list)
  1796. len)
  1797. (cl-subseq list
  1798. 0
  1799. len)
  1800. list))
  1801. (defun recently-find-file-hook ()
  1802. "Add current file."
  1803. (when buffer-file-name
  1804. (recently-add buffer-file-name)))
  1805. (defun recently-dired-mode-hook ()
  1806. "Add current directory."
  1807. (recently-add (expand-file-name default-directory)))
  1808. (add-hook 'find-file-hook
  1809. 'recently-find-file-hook)
  1810. (add-hook 'dired-mode-hook
  1811. 'recently-dired-mode-hook)
  1812. ;; recently-show
  1813. (defvar recently-show-window-height 10
  1814. "Max height of window of `recently-show'")
  1815. (defvar recently-show-mode-map
  1816. (let ((map (make-sparse-keymap)))
  1817. (suppress-keymap map)
  1818. (define-key map "n" 'next-line)
  1819. (define-key map "p" 'previous-line)
  1820. (define-key map (kbd "C-m") 'recently-show-find-file)
  1821. (define-key map (kbd "SPC") 'recently-show-find-file)
  1822. (define-key map "v" 'recently-show-view-file)
  1823. (define-key map "@" 'recently-show-dired)
  1824. (define-key map "q" 'recently-show-close)
  1825. (define-key map (kbd "C-g") 'recently-show-close)
  1826. (define-key map "?" 'describe-mode)
  1827. (define-key map "/" 'isearch-forward)
  1828. map))
  1829. (defvar recently-show-before-listing-hook nil
  1830. "Hook run before creating buffer of `recently-show'.")
  1831. (defvar recently-show-window-configuration nil
  1832. "Used for internal")
  1833. (defvar recently-show-abbreviate t
  1834. "Non-nil means use `abbreviate-file-name' when listing recently opened files.")
  1835. (define-derived-mode recently-show-mode special-mode "recently-show"
  1836. "Major mode for `recently-show'."
  1837. ;; (set (make-local-variable 'scroll-margin)
  1838. ;; 0)
  1839. )
  1840. ;;;###autoload
  1841. (defun recently-show (&optional files buffer-name)
  1842. "Show simplified list of recently opened files.
  1843. If optional argument FILES is non-nil, it is a list of recently-opened
  1844. files to choose from. It defaults to the whole recent list.
  1845. If optional argument BUFFER-NAME is non-nil, it is a buffer name to
  1846. use for the buffer. It defaults to \"*recetf-show*\"."
  1847. (interactive)
  1848. (let ((bf (recently-show-create-buffer files buffer-name)))
  1849. (if bf
  1850. (progn
  1851. ;; (recently-save-list)
  1852. (setq recently-show-window-configuration (current-window-configuration))
  1853. ;;(pop-to-buffer bf t t)
  1854. (display-buffer bf)
  1855. ;; (set-window-text-height (selected-window)
  1856. ;; recently-show-window-height)
  1857. (shrink-window-if-larger-than-buffer (selected-window)))
  1858. (message "No recent file!"))))
  1859. (defun recently-show-create-buffer (&optional files buffer-name)
  1860. "Create buffer listing recently files."
  1861. (let ((bname (or buffer-name
  1862. "*recently-show*"))
  1863. (list (or files
  1864. (progn
  1865. (recently-reload)
  1866. recently-list))))
  1867. (when list
  1868. (and (get-buffer bname)
  1869. (kill-buffer bname))
  1870. (let ((bf (get-buffer-create bname)))
  1871. (with-current-buffer bf
  1872. (recently-show-mode)
  1873. (let ((inhibit-read-only t))
  1874. (mapc (lambda (f)
  1875. (insert (if recently-show-abbreviate
  1876. (abbreviate-file-name f)
  1877. f)
  1878. "\n"))
  1879. list))
  1880. (goto-char (point-min))
  1881. ;; (setq buffer-read-only t)
  1882. )
  1883. bf))))
  1884. (defun recently-show-close ()
  1885. "Close recently-show window."
  1886. (interactive)
  1887. (kill-buffer (current-buffer))
  1888. (set-window-configuration recently-show-window-configuration))
  1889. (defun recently-show-find-file ()
  1890. "Fine file of current line."
  1891. (interactive)
  1892. (let ((f (recently-show-get-filename)))
  1893. (recently-show-close)
  1894. (find-file f)))
  1895. (defun recently-show-view-file ()
  1896. "view file of current line."
  1897. (interactive)
  1898. (let ((f (recently-show-get-filename)))
  1899. (recently-show-close)
  1900. (view-file f)))
  1901. (defun recently-show-get-filename ()
  1902. "Get filename of current line."
  1903. (buffer-substring-no-properties (point-at-bol)
  1904. (point-at-eol)))
  1905. (defun recently-show-dired()
  1906. "Open dired buffer of directory containing file of current line."
  1907. (interactive)
  1908. (let ((f (recently-show-get-filename)))
  1909. (recently-show-close)
  1910. (dired (if (file-directory-p f)
  1911. f
  1912. (or (file-name-directory f)
  1913. ".")))))
  1914. (define-key ctl-x-map (kbd "C-r") 'recently-show)
  1915. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1916. ;; git walktree
  1917. (defgroup git-walktree nil
  1918. "Git Walktree."
  1919. :tag "GitWalktree"
  1920. :prefix "git-walktree-"
  1921. :group 'tools)
  1922. (defvar git-walktree-current-commitish nil
  1923. "Commitish name of currently browsing.")
  1924. (make-variable-buffer-local 'git-walktree-current-commitish)
  1925. (defvar git-walktree-current-path nil
  1926. "Path name currently visiting without leading slash.")
  1927. (make-variable-buffer-local 'git-walktree-current-path)
  1928. (defvar git-walktree-buffer-file-name nil
  1929. "Psudo filename of current buffer.")
  1930. (make-variable-buffer-local 'git-walktree-buffer-file-name)
  1931. (defvar git-walktree-object-id nil
  1932. "Object id of current buffer.")
  1933. (make-variable-buffer-local 'git-walktree-object-id)
  1934. (defvar git-walktree-repository-root nil
  1935. "Repository root path of current buffer.")
  1936. (make-variable-buffer-local 'git-walktree-repository-root)
  1937. (defun git-walktree--create-buffer (commitish name)
  1938. ;; TODO: check repository
  1939. "Create and return buffer for NAME."
  1940. (let* ((root (git-walktree--git-plumbing "rev-parse"
  1941. "--show-toplevel"))
  1942. (commitish-display (if (and commitish
  1943. ;; TODO: Add git-walktree--commitish-fordisplay
  1944. (string-match-p "\\`[0-9a-f]+\\'"
  1945. commitish)
  1946. (>= (length commitish) 32))
  1947. (git-walktree--git-plumbing "rev-parse"
  1948. "--short"
  1949. commitish)
  1950. commitish))
  1951. (name (format "%s:%s"
  1952. (or commitish "")
  1953. name)))
  1954. (with-current-buffer (get-buffer-create name)
  1955. (if git-walktree-repository-root
  1956. (if (string= root
  1957. git-walktree-repository-root)
  1958. (current-buffer)
  1959. ;; If the buffer is for another repository, create new buffer
  1960. (with-current-buffer (generate-new-buffer name)
  1961. (setq git-walktree-repository-root root)
  1962. (current-buffer)))
  1963. ;; New buffer
  1964. (setq git-walktree-repository-root root)
  1965. (current-buffer)))))
  1966. (defun git-walktree--replace-into (target)
  1967. "Replace TARGET buffer contents with that of current buffer."
  1968. (let ((buf (current-buffer)))
  1969. (with-current-buffer target
  1970. (replace-buffer-contents buf))))
  1971. (require 'ansi-color)
  1972. (defun git-walktree--open-treeish (commitish path treeish)
  1973. "Open git tree buffer of TREEISH."
  1974. (cl-assert path)
  1975. (let (point-tree-start
  1976. (buf (git-walktree--create-buffer commitish path))
  1977. (type (git-walktree--git-plumbing "cat-file"
  1978. "-t"
  1979. treeish))
  1980. )
  1981. (cl-assert (member type
  1982. '("commit" "tree")))
  1983. (with-current-buffer buf
  1984. (buffer-disable-undo)
  1985. ;; For running git command go back to repository root
  1986. (cd git-walktree-repository-root)
  1987. (save-excursion
  1988. (let ((inhibit-read-only t))
  1989. (with-temp-buffer
  1990. (if commitish
  1991. (progn (git-walktree--call-process nil
  1992. "show"
  1993. "--no-patch"
  1994. "--color"
  1995. "--pretty=short"
  1996. commitish)
  1997. (ansi-color-apply-on-region (point-min)
  1998. (point))
  1999. (insert "\n")
  2000. (insert (format "Contents of '%s:%s':\n"
  2001. commitish
  2002. path)))
  2003. (insert (format "Contents of treeish object '%s:\n"
  2004. treeish)))
  2005. (setq point-tree-start (point))
  2006. (git-walktree--call-process nil
  2007. "ls-tree"
  2008. ;; "-r"
  2009. "--abbrev"
  2010. treeish)
  2011. (git-walktree--replace-into buf))))
  2012. (git-walktree-mode)
  2013. (set-buffer-modified-p nil)
  2014. (setq git-walktree-current-commitish commitish)
  2015. (setq git-walktree-current-path path)
  2016. (setq git-walktree-object-id treeish)
  2017. (let ((dir (expand-file-name path git-walktree-repository-root)))
  2018. (when (and git-walktree-try-cd
  2019. (file-directory-p dir))
  2020. (cd dir)))
  2021. ;; FIXME: Somehow point go back to point-min when reopen the buffer
  2022. (when (= (point) (point-min))
  2023. (goto-char point-tree-start)
  2024. )
  2025. )
  2026. buf))
  2027. (defun git-walktree--call-process (&optional infile &rest args)
  2028. "Call git command with input from INFILE and args ARGS.
  2029. Result will be inserted into current buffer."
  2030. (let ((status (apply 'call-process
  2031. git-walktree-git-executable
  2032. infile
  2033. t
  2034. nil
  2035. args)))
  2036. (unless (eq 0
  2037. status)
  2038. (error "Failed to call git process %S %S"
  2039. infile
  2040. args))))
  2041. ?w
  2042. (defun git-walktree--open-blob (commitish path blob)
  2043. "Open BLOB object."
  2044. (let ((type (git-walktree--git-plumbing "cat-file"
  2045. "-t"
  2046. blob))
  2047. (buf (git-walktree--create-buffer commitish path)))
  2048. (cl-assert (string= type "blob"))
  2049. (with-current-buffer buf
  2050. ;; For running git command go back to repository root
  2051. (cd git-walktree-repository-root)
  2052. (let ((inhibit-read-only t))
  2053. (with-temp-buffer
  2054. (git-walktree--call-process nil
  2055. "cat-file"
  2056. "-p"
  2057. blob)
  2058. (git-walktree--replace-into buf)))
  2059. (setq git-walktree-buffer-file-name
  2060. (concat (git-walktree--git-plumbing "rev-parse"
  2061. "--show-toplevel")
  2062. "/git@"
  2063. commitish
  2064. ":"
  2065. path))
  2066. (setq buffer-file-name
  2067. git-walktree-buffer-file-name)
  2068. (normal-mode t)
  2069. ;; For asking filename when C-xC-s
  2070. (setq buffer-file-name nil)
  2071. (set-buffer-modified-p t)
  2072. (setq git-walktree-current-commitish commitish)
  2073. (setq git-walktree-current-path path)
  2074. (setq git-walktree-object-id blob)
  2075. (let ((dir (expand-file-name (or (file-name-directory path)
  2076. ".")
  2077. git-walktree-repository-root)))
  2078. (when (and git-walktree-try-cd
  2079. (file-directory-p dir))
  2080. (cd dir)))
  2081. (view-mode 1)
  2082. )
  2083. buf))
  2084. (defun git-walktree--open-noselect (commitish path object)
  2085. "Open git tree buffer of COMMITISH.
  2086. When PATH was given and non-nil open that, otherwise open root tree.
  2087. When OBJECT was given and non-nil, assume that is the object of COMMITISH:PATH
  2088. without checking it."
  2089. (let ((type (git-walktree--git-plumbing "cat-file"
  2090. "-t"
  2091. commitish)))
  2092. (cl-assert (string= type "commit")))
  2093. (setq path (or path
  2094. "."))
  2095. ;; PATH must not start with and end with slashes
  2096. (cl-assert (not (string-match "\\`/" path)))
  2097. (cl-assert (not (string-match "/\\'" path)))
  2098. (if (string= path ".")
  2099. (setq object (or object
  2100. commitish))
  2101. (setq object (or object
  2102. (git-walktree--resolve-object commitish path))))
  2103. (cl-assert object)
  2104. (let ((type (git-walktree--git-plumbing "cat-file"
  2105. "-t"
  2106. object)))
  2107. (pcase type
  2108. ((or "commit" "tree")
  2109. (git-walktree--open-treeish commitish path object))
  2110. ("blob"
  2111. (git-walktree--open-blob commitish path object))
  2112. (_
  2113. (error "Type cannot handle: %s" type)))))
  2114. (defun git-walktree--resolve-object (commitish path)
  2115. "Return object id of COMMITISIH:PATH."
  2116. ;; TODO: use --full-tree
  2117. (with-temp-buffer
  2118. (cd (git-walktree--git-plumbing "rev-parse" "--show-toplevel"))
  2119. (let ((info (git-walktree--parse-lstree-line (git-walktree--git-plumbing "ls-tree"
  2120. commitish
  2121. path))))
  2122. (plist-get info :object))))
  2123. (defun git-walktree-open (commitish &optional path object)
  2124. "Open git tree buffer of COMMITISH.
  2125. When PATH was given and non-nil open that, otherwise open root tree.
  2126. When OBJECT was given and non-nil, assume that is the object of COMMITISH:PATH without
  2127. checking it."
  2128. (interactive (list (magit-read-branch-or-commit "Revision: ")))
  2129. ;; (setq path (or path
  2130. ;; (git-walktree--path-in-repository (directory-file-name default-directory))))
  2131. (switch-to-buffer (git-walktree--open-noselect commitish path object)))
  2132. (defalias 'git-walktree 'git-walktree-open)
  2133. (defun git-walktree--path-in-repository (dir)
  2134. "Convert DIR into relative path to repository root."
  2135. (with-temp-buffer
  2136. (cd dir)
  2137. (let ((root (git-walktree--git-plumbing "rev-parse"
  2138. "--show-toplevel")))
  2139. (file-relative-name dir root))))
  2140. (file-relative-name "/abc/def/ghi" "/abc/def/ghi")
  2141. (defcustom git-walktree-git-executable "git"
  2142. "Git executable."
  2143. :type 'string
  2144. :group 'git-walktree)
  2145. (defcustom git-walktree-try-cd t
  2146. "Try to cd if directory exists in current working directory if non-nil.
  2147. Otherwise buffer's `default-directory' is always repository root."
  2148. :type 'boolean
  2149. :group 'git-walktree)
  2150. (defun git-walktree--git-plumbing (&rest args)
  2151. "Run git plubming command with ARGS.
  2152. Returns first line of output without newline."
  2153. (with-temp-buffer
  2154. (let ((status (apply 'call-process
  2155. git-walktree-git-executable
  2156. nil
  2157. t
  2158. nil
  2159. args)))
  2160. (unless (eq 0
  2161. status)
  2162. (error "Faild to run git %S:\n%s"
  2163. args
  2164. (buffer-substring-no-properties (point-min)
  2165. (point-max))))
  2166. (buffer-substring-no-properties (point-min)
  2167. (progn
  2168. (goto-char (point-min))
  2169. (point-at-eol))))))
  2170. (defconst git-walktree-ls-tree-line-regexp
  2171. "^\\([0-9]\\{6\\}\\) \\(\\w+\\) \\([0-9a-f]+\\)\t\\(.*\\)$"
  2172. "Regexp for one line of output of git ls-tree.")
  2173. (defconst git-walktree-ls-tree-line-tree-regexp
  2174. "^\\([0-9]\\{6\\}\\) \\(tree\\) \\([0-9a-f]+\\)\t\\(.*\\)$"
  2175. "Regexp for tree line of output of git ls-tree.")
  2176. (defun git-walktree--parse-lstree-line (str)
  2177. "Extract object info from STR.
  2178. STR should be a string like following without newline.:
  2179. 100644 blob 6fd4d58202d0b46547c6fe43de0f8c878456f966 .editorconfig
  2180. Returns property list like (:mode MODE :type TYPE :object OBJECT :file FILE)."
  2181. (let (result mode type object file)
  2182. (save-match-data
  2183. (with-temp-buffer
  2184. (insert str)
  2185. (goto-char (point-min))
  2186. (and (re-search-forward git-walktree-ls-tree-line-regexp
  2187. nil
  2188. t)
  2189. (list :mode (match-string 1)
  2190. :type (match-string 2)
  2191. :object (match-string 3)
  2192. :file (match-string 4)))))))
  2193. (defun git-walktree-mode-open-this ()
  2194. ;; TODO: Support commit object
  2195. "Open current object."
  2196. (interactive)
  2197. (let ((info (git-walktree--parse-lstree-line (buffer-substring-no-properties (point-at-bol)
  2198. (point-at-eol)))))
  2199. (if info
  2200. (switch-to-buffer
  2201. (if (string= (plist-get info
  2202. :type)
  2203. "commit")
  2204. (with-temp-buffer
  2205. (cd (plist-get info :file))
  2206. (git-walktree--open-noselect (plist-get info
  2207. :object)
  2208. nil
  2209. (plist-get info
  2210. :object)))
  2211. (git-walktree--open-noselect git-walktree-current-commitish
  2212. (git-walktree--join-path (plist-get info
  2213. :file))
  2214. (plist-get info
  2215. :object))))
  2216. (message "No object on current line."))))
  2217. (defun git-walktree--join-path (name &optional base)
  2218. "Make path from NAME and BASE.
  2219. If base is omitted or nil use value of `git-walktree-current-path'."
  2220. (setq base (or base
  2221. git-walktree-current-path))
  2222. (cl-assert base)
  2223. (if (string= base ".")
  2224. name
  2225. (concat base "/" name)))
  2226. (defun git-walktree--parent-directory (path)
  2227. "Return parent directory of PATH without trailing slash.
  2228. For root directory return \".\".
  2229. If PATH is equal to \".\", return nil."
  2230. (if (string-match-p "/" path)
  2231. (directory-file-name (file-name-directory path))
  2232. (if (string= "." path)
  2233. nil
  2234. ".")))
  2235. (defun git-walktree-up (&optional commitish path)
  2236. "Open parent directory of COMMITISH and PATH.
  2237. If not given, value of current buffer will be used."
  2238. (interactive)
  2239. (setq commitish
  2240. (or commitish git-walktree-current-commitish))
  2241. (setq path
  2242. (or path git-walktree-current-path))
  2243. (let ((parent (git-walktree--parent-directory path)))
  2244. (if parent
  2245. (switch-to-buffer (git-walktree--open-noselect commitish
  2246. parent
  2247. nil))
  2248. (message "Cannot find parent directory for current tree."))))
  2249. (defgroup git-walktree-faces nil
  2250. "Faces used by git-walktree."
  2251. :group 'git-walktree
  2252. :group 'faces)
  2253. (defface git-walktree-tree-face
  2254. '((t (:inherit font-lock-function-name-face)))
  2255. "Face used for tree objects."
  2256. :group 'git-walktree-faces)
  2257. (defvar git-walktree-tree-face 'git-walktree-tree-face
  2258. "Face used for tree objects.")
  2259. (defvar git-walktree-mode-map
  2260. (let ((map (make-sparse-keymap)))
  2261. ;; TODO: Add git-walktree-parent-revision
  2262. ;; TODO: Add git-walktree-next-line
  2263. (define-key map "n" 'next-line)
  2264. (define-key map "p" 'previous-line)
  2265. (define-key map "^" 'git-walktree-up)
  2266. (define-key map (kbd "C-m") 'git-walktree-mode-open-this)
  2267. map))
  2268. (defvar git-walktree-mode-font-lock-keywords
  2269. `(
  2270. (,git-walktree-ls-tree-line-regexp . (
  2271. (1 'shadow)
  2272. (3 'shadow)
  2273. ))
  2274. (,git-walktree-ls-tree-line-tree-regexp . (
  2275. (2 'git-walktree-tree-face)
  2276. (4 'git-walktree-tree-face)
  2277. ))
  2278. )
  2279. "Syntax highlighting for git-walktree mode.")
  2280. (define-derived-mode git-walktree-mode special-mode "GitWalktree"
  2281. "Major-mode for `git-walktree-open'."
  2282. (set (make-local-variable 'font-lock-defaults)
  2283. '(git-walktree-mode-font-lock-keywords
  2284. nil nil nil nil
  2285. ))
  2286. )
  2287. (require 'magit nil t)
  2288. ;; (git-revision--git-plumbing "cat-file" "-t" "HEAD")
  2289. ;; Local Variables:
  2290. ;; flycheck-disabled-checkers: (emacs-lisp-checkdoc)
  2291. ;; flycheck-checker: emacs-lisp
  2292. ;; End:
  2293. ;;; emancs.el ends here