您最多选择25个主题 主题必须以字母或数字开头,可以包含连字符 (-),并且长度不得超过35个字符
 
 
 
 
 
 

3089 行
103 KiB

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