Nevar pievienot vairāk kā 25 tēmas Tēmai ir jāsākas ar burtu vai ciparu, tā var saturēt domu zīmes ('-') un var būt līdz 35 simboliem gara.
 
 
 
 
 
 

3129 rindas
108 KiB

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