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

1777 lines
78 KiB

  1. ;;; smart-mode-line.el --- A color coded smart mode-line.
  2. ;; Copyright (C) 2012 Artur Malabarba <emacs@endlessparentheses.com>
  3. ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
  4. ;; URL: http://github.com/Malabarba/smart-mode-line
  5. ;; Version: 2.13
  6. ;; Package-Requires: ((emacs "24.3") (rich-minority "0.1.1"))
  7. ;; Keywords: mode-line faces themes
  8. ;; Prefix: sml
  9. ;; Separator: /
  10. ;;; Commentary:
  11. ;;
  12. ;; Smart Mode Line is a sexy mode-line for Emacs. It aims to be easy to
  13. ;; read from small to large monitors by using *colors*, a *prefix feature*, and
  14. ;; *smart truncation*.
  15. ;;
  16. ;; New in v2.5
  17. ;; ===========
  18. ;; - Emacs 24.4 compatible.
  19. ;; - Integration with [Projectile](https://github.com/bbatsov/projectile)!
  20. ;; - Display `current-directory' in Shell and eshell.
  21. ;; - New value for `sml/theme': `automatic' (highly recommended).
  22. ;; - `sml/apply-theme' is interactive and has completion.
  23. ;; - Smart-mode-line themes are now regular themes.
  24. ;;
  25. ;; Installation
  26. ;; ===
  27. ;; **smart-mode-line** is available on Melpa, and that's the recommended
  28. ;; way of installing it. If you do that, you can simply activate it with:
  29. ;;
  30. ;; (sml/setup)
  31. ;;
  32. ;; To set the color theme, do one of the following BEFORE `sml/setup`:
  33. ;;
  34. ;; (setq sml/theme 'dark)
  35. ;; (setq sml/theme 'light)
  36. ;; (setq sml/theme 'respectful)
  37. ;;
  38. ;; Features
  39. ;; ===
  40. ;; Its main features include:
  41. ;;
  42. ;; 1. **Color coded**:
  43. ;; Highlights the most important information for you
  44. ;; (buffer name, modified state, line number). Don't
  45. ;; like the colors? See item *5.*!
  46. ;;
  47. ;; 2. **Fixed width** (if you want):
  48. ;; Lets you set a maxium width for the path name and mode names, and
  49. ;; truncates them intelligently (truncates the directory, not the
  50. ;; buffer name). Also let's you **right indent** strings in the
  51. ;; mode-line (see `sml/mode-width').
  52. ;;
  53. ;; 3. **Directory as Prefixes**:
  54. ;; Prefix feature saves a LOT of space. e.g. *"~/.emacs.d/"*
  55. ;; is translated to *":ED:"* in the path (open a file inside
  56. ;; this folder to see it in action). Long path names you
  57. ;; are commonly working on are displayed as short
  58. ;; abbreviations. Set your own prefixes to make best use
  59. ;; of it (by configuring `sml/replacer-regexp-list'). Mousing
  60. ;; over the abbreviated path will show you the full
  61. ;; path. See below for examples.
  62. ;;
  63. ;; 4. **Hide or Highlight minor-modes**:
  64. ;; The [rich-minority](https://github.com/Malabarba/rich-minority)
  65. ;; package saves even more space. Select which minor modes you don't
  66. ;; want to see listed by adding them to the variable
  67. ;; `rm-excluded-modes', or even highlight the modes that are more
  68. ;; important with the variable `rm-text-properties'. This will filter
  69. ;; out the modes you don't care about and unclutter the modes list
  70. ;; (mousing over the modes list still shows the full list).
  71. ;;
  72. ;; 4. **Hide minor-modes**:
  73. ;; Hidden-modes feature saves even more space. Select
  74. ;; which minor modes you don't want to see listed by
  75. ;; customizing the `rm-blacklist' variable. This will
  76. ;; filter out the modes you don't care about and unclutter
  77. ;; the modes list (mousing over the modes list still shows
  78. ;; the full list).
  79. ;;
  80. ;; 5. **Very easy to configure**:
  81. ;; All colors and variables are customizable. You can change the
  82. ;; whole theme with `sml/apply-theme', or just customize anything
  83. ;; manually with `sml/customize' and `sml/customize-faces'. There are
  84. ;; *DOZENS* of variables to customize your mode-line, just pop over
  85. ;; there and have a look!
  86. ;;
  87. ;; 6. **Compatible with absolutely anything**:
  88. ;; I'm serious. Versions 2.0 and above should be compatible with
  89. ;; **any** other packages that display information in the mode-line
  90. ;; (evil, nyan-mode, elscreen, display-battery-mode, etc). If you
  91. ;; find *ANYTHING* that does not appear as it should, file a bug report
  92. ;; and I'll get to it.
  93. ;;
  94. ;; Important Variables:
  95. ;; ===
  96. ;; All variables can be edited by running `sml/customize', and the
  97. ;; documentations are mostly self explanatory, I list here only the
  98. ;; most important ones.
  99. ;;
  100. ;; 1. `sml/theme'
  101. ;; Choose what theme you want to use for the mode-line colors. For now
  102. ;; there are 3 different themes: `dark', `light', and `respectful'.
  103. ;;
  104. ;; 1. `sml/shorten-directory' and `sml/shorten-modes'
  105. ;; Setting both of these to `t' guarantees a fixed width mode-line
  106. ;; (directory name and minor-modes list will be truncated to fit). To
  107. ;; actually define the width, see below.
  108. ;;
  109. ;; 2. `sml/name-width' and `sml/mode-width'
  110. ;; Customize these according to the width of your Emacs frame. I set
  111. ;; them to `40' and `full' respectively, and the mode-line fits
  112. ;; perfectly when the frame is split in two even on my laptop's small
  113. ;; 17" monitor. `full' means everything after the minor-modes will be
  114. ;; right-indented.
  115. ;;
  116. ;; 3. `sml/replacer-regexp-list'
  117. ;; This variable is a list of (REGEXP REPLACEMENT) that is used
  118. ;; to parse the path. The replacements are applied
  119. ;; sequentially. This allows you to greatly abbreviate the path
  120. ;; that's shown in the mode-line. If this abbreviation is of
  121. ;; the form *":SOMETHING:"*, it is considered a prefix and get's
  122. ;; a different color (you can change what's considered a prefix
  123. ;; by customizing `sml/prefix-regexp').
  124. ;; For example, if you do a lot of work on a folder called
  125. ;; *"~/Dropbox/Projects/In-Development/"* almost half the
  126. ;; mode-line would be occupied just by the folder name, which
  127. ;; is much less important than the buffer name. But, you can't
  128. ;; just hide the folder name, since editing a file in
  129. ;; *"~/Dropbox/Projects/In-Development/Source"* is VERY different
  130. ;; from editting a file in *"~/Dropbox/Projects/Source"*. By
  131. ;; setting up a prefix for your commonly used folders, you get
  132. ;; all that information without wasting all that space. In this
  133. ;; example you could set the replacement to *":ProjDev:"* or just
  134. ;; *":InDev:"*, so the path shown in the mode-line will be
  135. ;; *":ProjDev:Source/"* (saves a lot of space without hiding
  136. ;; information).
  137. ;;
  138. ;; Here go some more useful examples:
  139. ;;
  140. ;; (add-to-list 'sml/replacer-regexp-list '("^~/Dropbox/Projects/In-Development/" ":ProjDev:") t)
  141. ;; (add-to-list 'sml/replacer-regexp-list '("^~/Documents/Work/" ":Work:") t)
  142. ;;
  143. ;; ;; Added in the right order, they even work sequentially:
  144. ;; (add-to-list 'sml/replacer-regexp-list '("^~/Dropbox/" ":DB:") t)
  145. ;; (add-to-list 'sml/replacer-regexp-list '("^:DB:Documents" ":DDocs:") t)
  146. ;; (add-to-list 'sml/replacer-regexp-list '("^~/Git-Projects/" ":Git:") t)
  147. ;; (add-to-list 'sml/replacer-regexp-list '("^:Git:\\(.*\\)/src/main/java/" ":G/\\1/SMJ:") t)
  148. ;;; License:
  149. ;;
  150. ;; This file is NOT part of GNU Emacs.
  151. ;;
  152. ;; This program is free software; you can redistribute it and/or
  153. ;; modify it under the terms of the GNU General Public License
  154. ;; as published by the Free Software Foundation; either version 2
  155. ;; of the License, or (at your option) any later version.
  156. ;;
  157. ;; This program is distributed in the hope that it will be useful,
  158. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  159. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  160. ;; GNU General Public License for more details.
  161. ;;
  162. ;;; Change Log:
  163. ;; 2.6 - 2014/08/15 - Allow for sml/name-width to have different mininum and maximum values.
  164. ;; 2.6 - 2014/08/15 - Delegated minor-mode filtering to rich-minority package.
  165. ;; 2.5.3 - 2014/06/18 - Fix custom-theme-load-path for manual installations.
  166. ;; 2.5.2 - 2014/06/16 - sml/no-confirm-load-theme variable to skip theme confirmation.
  167. ;; 2.5.1 - 2014/06/16 - sml/apply-theme no-confirm in daemon mode.
  168. ;; 2.5 - 2014/05/15 - sml/theme: New possible values: 'automatic (highly recommended) or nil.
  169. ;; 2.5 - 2014/05/14 - sml/mode-width: New possible value: 'right.
  170. ;; 2.5 - 2014/05/14 - Themes engine completely redone.
  171. ;; 2.5 - 2014/05/14 - sml/apply-theme is interactive.
  172. ;; 2.4.5 - 2014/04/24 - Changed default value of sml/mode-width back to 'full.
  173. ;; 2.4.3 - 2014/03/25 - sml/mode-line-buffer-identification fix for ggtags.
  174. ;; 2.4.2 - 2014/03/13 - Perspective support simplified to sml/apply-theme.
  175. ;; 2.4.2 - 2014/03/13 - Projectile integration only applies after the user replacements (to change, see sml/use-projectile-p).
  176. ;; 2.4.1 - 2014/03/11 - Small fix to dired-mode with uniquify.
  177. ;; 2.4 - 2014/03/10 - Projectile integration! To disable it, set sml/use-projectile-p.
  178. ;; 2.4 - 2014/03/10 - Change the order of line/column numbers with sml/order-of-line-and-column.
  179. ;; 2.4 - 2014/03/10 - Take over dired's buffer-identification. We will undo this if dired ever does anything special with this variable.
  180. ;; 2.4 - 2014/03/10 - Show current-directory in Shell and eshell.
  181. ;; 2.4 - 2014/03/10 - Tested against 24.4.
  182. ;; 2.4 - 2014/03/10 - Ditch total number of lines count.
  183. ;; 2.3.13 - 2014/03/05 - sml/apply-theme forces our foreground/background colors.
  184. ;; 2.3.12 - 2014/03/05 - Use sml/show-remote to hide/show the "@" symbol. .
  185. ;; 2.3.12 - 2014/03/05 - Support showing tramp state (remote buffer).
  186. ;; 2.3.12 - 2014/02/27 - sml/apply-theme avoids nesting.
  187. ;; 2.3.11 - 2014/02/15 - Silent sml/apply-theme.
  188. ;; 2.3.10 - 2014/02/15 - Fix sml/setup ignoring sml/theme.
  189. ;; 2.3.9 - 2014/02/10 - sml/hidden-modes allows regexps.
  190. ;; 2.3.8 - 2014/02/07 - Buffer identification width auto-updates when sml/name-width changes.
  191. ;; 2.3.8 - 2014/02/07 - sml/apply-theme customizes helm-candidate-number.
  192. ;; 2.3.7 - 2014/01/21 - Adapt sml/generate-buffer-identification.
  193. ;; 2.3.6 - 2013/12/16 - sml/replacer follows symlinks.
  194. ;; 2.3.6 - 2013/12/16 - Fix filling and name on the very first update of non-file buffers.
  195. ;; 2.3.5 - 2013/12/14 - sml/generate-position-help runs less often now.
  196. ;; 2.3.4 - 2013/12/14 - Remove lag-inducing advice.
  197. ;; 2.3.3 - 2013/12/09 - Fix sml/get-directory for files attached to mails - Thanks tsdh.
  198. ;; 2.3.2 - 2013/12/07 - Fix for themes which set :inverse-video t in the mode-line.
  199. ;; 2.3.1 - 2013/12/04 - sml/show-frame-identification now always defaults to nil.
  200. ;; 2.3.1 - 2013/12/04 - Fix for sml/show-client not working.
  201. ;; 2.3 - 2013/12/04 - sml/show-frame-identification only t for terminals.
  202. ;; 2.3 - 2013/12/03 - Mark boolean's as safe-local-variables.
  203. ;; 2.2.3 - 2013/12/03 - Fix possible recursion in sml/apply-theme.
  204. ;; 2.2.2 - 2013/11/27 - Fix sml/apply-theme to consider saved faces.
  205. ;; 2.2.1 - 2013/11/27 - Fix doc for sml/show-frame-identification.
  206. ;; 2.2 - 2013/11/26 - Better minor list and some fixes.
  207. ;; 2.0.5 - 2013/11/24 - sml/revert no longer available.
  208. ;; 2.0.4 - 2013/11/24 - Improved faces a little.
  209. ;; 2.0.3.4 - 2013/11/15 - Workaround to prevent core dump.
  210. ;; 2.0.3.3 - 2013/11/13 - Small fix on sml/generate-buffer-identification for man pages.
  211. ;; 2.0.3.2 - 2013/11/12 - sml/filter-mode-line-list now uses remove nil.
  212. ;; 2.0.3.1 - 2013/11/08 - Quick fix sml/get-directory.
  213. ;; 2.0.3 - 2013/11/07 - sml/show-frame-identification.
  214. ;; 2.0.3 - 2013/11/07 - Improvements to sml/parse-mode-line-elements.
  215. ;; 2.0.3 - 2013/11/07 - sml/compile-position-construct.
  216. ;; 2.0.3 - 2013/11/07 - Line-number removed from sml/generate-position-help.
  217. ;; 2.0.3 - 2013/11/07 - Position optimization with sml/position-construct.
  218. ;; 2.0.3 - 2013/11/07 - Performance optimization thanks to sml/buffer-identification.
  219. ;; 2.0.2 - 2013/11/05 - better sml/replacer-regexp-list.
  220. ;; 2.0.2 - 2013/11/05 - sml/mule-info also hides input system.
  221. ;; 2.0.2 - 2013/11/05 - show-encoding is now alias for sml/mule-info.
  222. ;; 2.0.2 - 2013/11/05 - Removed anchors.
  223. ;; 2.0.1 - 2013/11/04 - Slight fix on sml/apply-theme
  224. ;; 2.0 - 2013/11/04 - Remove unnecessary functions.
  225. ;; 2.0 - 2013/11/04 - Many other internal improvements.
  226. ;; 2.0 - 2013/11/02 - Remove sml/mode-line-format
  227. ;; 2.0 - 2013/11/02 - Reduce huge spaces in mode-line-format
  228. ;; 2.0 - 2013/11/02 - Redesign the format to use mode-line-mule-info.
  229. ;; 2.0 - 2013/11/02 - Redesign the format to use mode-line-client.
  230. ;; 2.0 - 2013/11/02 - Redesign the format to use mode-line-modified.
  231. ;; 2.0 - 2013/11/02 - Redesign the format to use mode-line-remote.
  232. ;; 2.0 - 2013/11/02 - Manually edits mode-line-front-space.
  233. ;; 2.0 - 2013/11/02 - Manually edits mode-line-frame-identification.
  234. ;; 2.0 - 2013/11/02 - Manually edits mode-line-buffer-identification.
  235. ;; 2.0 - 2013/11/02 - Manually edits mode-line-end-spaces.
  236. ;; 2.0 - 2013/11/02 - Redesign the format to use mode-line-modes.
  237. ;; 2.0 - 2013/11/01 - Redesign the format to use mode-line-position.
  238. ;; 1.30.1 - 2013/10/21 - eval-when-compile cl
  239. ;; 1.30 - 2013/10/13 - Click mode list to toggle minor-mode hiding.
  240. ;; 1.29.2 - 2013/10/02 - Different default position-percentage face.
  241. ;; 1.29.1 - 2013/08/22 - Fix hang introduced with last update.
  242. ;; 1.29 - 2013/08/11 - Fixed lag with remote files.
  243. ;; 1.28.1 - 2013/08/11 - Fix for the erc fix.
  244. ;; 1.28 - 2013/08/11 - Fixing erc notifications.
  245. ;; 1.27 - 2013/08/10 - Changed default value of sml/mode-width to a number. 'full didn't work for everyone.
  246. ;; 1.27 - 2013/08/10 - Doc bug.
  247. ;; 1.26 - 2013/07/18 - Fix for % in the process string.
  248. ;; 1.25 - 2013/07/16 - sml/override-theme also tries to set good colors for the text (not just the background).
  249. ;; 1.24 - 2013/07/16 - sml/mule-info face changed to be less important.
  250. ;; 1.23.2 - 2013/07/15 - Changed doc of sml/replacer-regexp-list.
  251. ;; 1.23.1 - 2013/07/15 - moved perspective variable to eval-after-load.
  252. ;; 1.23 - 2013/07/15 - added an icon to mew-format.
  253. ;; 1.23 - 2013/07/15 - obsolete sml/show-time.
  254. ;; 1.23 - 2013/07/15 - fixed a bug which required emacs restart for changes to take effect.
  255. ;; 1.22 - 2013/07/15 - sml/vc-mode-show-backend implemented.
  256. ;; 1.22 - 2013/07/15 - move mew-support variable.
  257. ;; 1.22 - 2013/07/15 - Changed default value of sml/replacer-regexp-list.
  258. ;; 1.21 - 2013/07/14 - Encoding description.
  259. ;; 1.21 - 2013/07/14 - Reestructured some of the present functions.
  260. ;; 1.21 - 2013/07/14 - New position indicator.
  261. ;; 1.20 - 2013/07/14 - vc-mode support.
  262. ;; 1.19 - 2013/07/14 - Reorganized groups.
  263. ;; 1.18 - 2013/07/12 - mew variables only get created if mew is loaded.
  264. ;; 1.18 - 2013/07/12 - Reformulated the simplified mode-line.
  265. ;; 1.18 - 2013/07/12 - Added number of lines to mouse tooltip of position.
  266. ;; 1.17 - 2013/07/10 - Fallback 'modified' string.
  267. ;; 1.16 - 2013/07/08 - Changed implementation of battery display.
  268. ;; 1.16 - 2013/07/08 - Fixed battery-display.
  269. ;; 1.15 - 2013/07/06 - Implemented sml-modeline support.
  270. ;; 1.14 - 2013/06/25 - Slightly reduced the default value of extra-filler.
  271. ;; 1.13 - 2013/06/10 - removed 'cl requirement.
  272. ;; 1.13 - 2013/06/10 - Advice to mew-biff-clear.
  273. ;; 1.12 - 2013/06/06 - Gigantic typo fix. Sorry about that.
  274. ;; 1.11 - 2013/06/05 - Added biff support.
  275. ;; 1.10 - 2013/05/24 - Fix for buffer name with '%'.
  276. ;; 1.9 - 2013/05/13 - Now uses file name instead of buffer-name by default, controled by `sml/show-file-name'.
  277. ;; 1.9 - 2013/05/13 - When showing buffer name, can strip the <N> part by setting `sml/show-trailing-N'.
  278. ;; 1.8.3 - 2013/04/21 - Fixed first line of docs.
  279. ;; 1.8.2 - 2013/04/18 - added empty anchors throughout the mode-line.
  280. ;; 1.8.2 - 2013/04/18 - evil-mode support.
  281. ;; 1.8.1 - 2013/04/17 - sml/bug-report function.
  282. ;; 1.8.1 - 2013/04/17 - sml/override-theme variable.
  283. ;; 1.8.1 - 2013/04/17 - Changed install instruction to override theme settings.
  284. ;; 1.8 - 2013/04/14 - sml/mode-width can now be 'full.
  285. ;; 1.7.1 - 2012/11/17 - Perspective support.
  286. ;; 1.7 - 2012/11/14 - Fixed some modes not showing in the minor mode list - Thanks Constantin.
  287. ;; 1.7 - 2012/11/14 - Fixed infinite loop. - Thanks Constantin.
  288. ;; 1.7 - 2012/11/14 - Fixed for dired-mode.
  289. ;; 1.7 - 2012/11/14 - Added parent customize groups.
  290. ;; 1.6.2 - 2012/07/13 - Fixed mode shortenning.
  291. ;; 1.6.1 - 2012/07/12 - NEW FEATURE: Modes list now fully supports clicking.
  292. ;; 1.6.1 - 2012/07/12 - NEW FEATURE: `sml/version' constant.
  293. ;; 1.6.1 - 2012/07/12 - `sml/hidden-modes' is now a list of strings (not regexps).
  294. ;; 1.6 - 2012/07/09 - NEW FEATURE: Customizable faces for the prefix, see `sml/prefix-face-list'.
  295. ;; 1.5.4 - 2012/06/28 - Optimized regexp-replacer.
  296. ;; 1.5.3 - 2012/06/20 - Remove prefix and folder for non-files. Color the :Git prefix.
  297. ;; 1.5.2 - 2012/06/14 - Saner default widths and mode-name fix for Term.
  298. ;; 1.5.1 - 2012/06/12 - Fixed battery font for corner cases.
  299. ;; 1.5 - 2012/06/11 - Added support for display-battery-mode. See the description for more.
  300. ;;; Code:
  301. (require 'cl-lib)
  302. (require 'custom)
  303. (require 'cus-face)
  304. (require 'rich-minority)
  305. (defconst sml/version "2.13" "Version of the smart-mode-line.el package.")
  306. (defun sml/bug-report ()
  307. "Opens github issues page in a web browser. Please send me any bugs you find, and please include your Emacs and sml versions."
  308. (interactive)
  309. (browse-url "https://github.com/Malabarba/smart-mode-line/issues/new")
  310. (message "Your sml/version is: %s, and your emacs version is: %s.\nPlease include this in your report!" sml/version emacs-version))
  311. (defun sml/customize ()
  312. "Open the customization group for the `smart-mode-line' package."
  313. (interactive)
  314. (customize-group 'smart-mode-line t))
  315. (defun sml/customize-faces ()
  316. "Open the customization group for faces used by the `smart-mode-line' package."
  317. (interactive)
  318. (customize-group 'smart-mode-line-faces t))
  319. (defgroup smart-mode-line '()
  320. "Customization group for the `smart-mode-line' package."
  321. :group 'convenience
  322. :prefix 'sml)
  323. (defgroup smart-mode-line-position '()
  324. "Showing the point position in the smart mode line."
  325. :group 'smart-mode-line
  326. :prefix 'sml)
  327. (defgroup smart-mode-line-path-and-prefix '()
  328. "Showing the path, buffer-name, and prefix in the smart mode line."
  329. :group 'smart-mode-line
  330. :prefix 'sml)
  331. (defgroup smart-mode-line-mode-list '()
  332. "Showing major/minor modes in the smart mode line."
  333. :group 'smart-mode-line
  334. :prefix 'sml)
  335. (defgroup smart-mode-line-others '()
  336. "Showing other data in the smart mode line."
  337. :group 'smart-mode-line
  338. :prefix 'sml)
  339. (defgroup smart-mode-line-faces '()
  340. "Font (face) colors for the `smart-mode-line.el' package.
  341. You can fully customize any of the fonts to match the color you
  342. want. You can also set properties like bold with ':weight bold'.
  343. Note that, by default, smart-mode-line overrides your theme's
  344. settings for the background and foreground color of the modeline
  345. face. We need to override, otherwise some elements become
  346. unreadable on lighter themes. If you'd rather configure these
  347. unreadable colors yourself and keep your theme's settings, just
  348. set `sml/override-theme' to nil."
  349. :prefix 'sml
  350. :group 'smart-mode-line
  351. :group 'faces)
  352. ;;; Actual Code
  353. (defvar erc-track-position-in-mode-line)
  354. (defvar sml/simplified nil
  355. "Temporary dynamic variable. Used for filling.")
  356. (defvar sml/active-background-color)
  357. (defvar sml/-debug nil
  358. "Whether debugging information should be printed.")
  359. (defmacro sml/-debug (fmt &rest r)
  360. "If variable `sml/-debug' is non-nil, describe FMT.
  361. If FMT is a string, this is essentially the same as `message'.
  362. If FMT is anything else, this is essentially:
  363. (message \"%s is: %s\" 'FMT FMT)"
  364. (when (and (boundp 'sml/-debug) sml/-debug)
  365. (if (stringp fmt)
  366. `(apply #'message (concat "[sml/debug] " ,fmt) ,r)
  367. `(message "[sml/debug] %s is: %s" ',fmt ,fmt))))
  368. (defvar sml/shortener-func 'sml/do-shorten-directory
  369. "Function used to shorten the directory name.
  370. Value is a funcallable symbol that takes two arguments: the
  371. string to be shortened and the maximum size. This is set
  372. automatically when `sml/shorten-directory' is changed via the
  373. customization menu or via the `sml/toggle-shorten-directory'
  374. function (which are the only ways you should change it).")
  375. (defun sml/set-shortener-func (sym val)
  376. "Configure `sml/shortener-func' according to `sml/shorten-directory'.
  377. Set SYM to VAL."
  378. (set-default sym val)
  379. (if val (setq sml/shortener-func 'sml/do-shorten-directory)
  380. (setq sml/shortener-func 'sml/not-shorten-directory)))
  381. (define-obsolete-variable-alias 'sml/time-format 'display-time-format)
  382. (define-obsolete-variable-alias 'sml/show-time 'display-time-mode)
  383. (define-obsolete-variable-alias 'sml/override-theme 'sml/theme)
  384. (defcustom sml/theme 'automatic
  385. "Defines which theme `smart-mode-line' should use.
  386. This is usually one of the symbols:
  387. 'automatic, 'respectful, 'dark, 'light or nil;
  388. but it can be something else if there are other smart-mode-line
  389. themes defined.
  390. Setting this to 'light and 'dark will apply some predefined
  391. colors to the mode-line, which are designed to be easy to read.
  392. Setting this to nil will apply almost no colors. Use this if your
  393. global color theme already customizes sml faces (flatui-theme is
  394. an example).
  395. Setting this to 'automatic will let sml decide between 'light or
  396. 'dark or nil, to best match the global theme that is active when
  397. `sml/setup' is called.
  398. Setting it to 'respectful will try to use the colors defined by
  399. your current Emacs theme (emphasis on the \"try\"). Use this if
  400. you color theme does NOT customize sml faces, AND if you're not
  401. happy with 'light or 'dark.
  402. This option will make the mode-line colors more consistent with
  403. buffer colors (when compared to 'light or 'dark, which have fixed
  404. colors) , but it's a bit of a shot in the dark. The result will
  405. vary for each color theme, and you may get colors that don't read
  406. well.
  407. But don't forget, ALL COLORS ARE CUSTOMIZABLE!
  408. `sml/customize-faces'
  409. Any color you change manually won't get affected by this
  410. variable.
  411. Setting this variable via `setq' only has effect BEFORE calling
  412. `sml/setup'. If smart-mode-line is already loaded, use
  413. `sml/apply-theme' instead (or the customization interface)."
  414. :type '(choice (const :tag "Automatically choose between 'light, 'dark, or nil during setup. (Default and Recommended)" automatic)
  415. (const :tag "Don't use a theme." nil)
  416. (const :tag "Use a dark color-theme." dark)
  417. (const :tag "Use a light color-theme." light)
  418. (const :tag "Respect the color-theme's colors." respectful)
  419. (symbol :tag "Other smart-mode-line theme you installed."))
  420. :set 'sml/apply-theme
  421. :initialize 'custom-initialize-default
  422. :group 'smart-mode-line-faces :group 'smart-mode-line)
  423. (defcustom sml/position-percentage-format "%p"
  424. "Format used to display position in the buffer.
  425. Set it to nil to hide the number."
  426. :type 'string
  427. :group 'smart-mode-line-position
  428. :package-version '(smart-mode-line . "2.0"))
  429. (put 'sml/position-percentage-format 'risky-local-variable t)
  430. (defcustom sml/line-number-format "%3l"
  431. "Format used to display line number.
  432. Empty it or disable `line-number-mode' to hide the number."
  433. :type 'string
  434. :group 'smart-mode-line-position
  435. :set 'sml/compile-position-construct
  436. :initialize 'custom-initialize-default)
  437. (put 'sml/line-number-format 'risky-local-variable t)
  438. (defcustom sml/size-indication-format "%I "
  439. "Format to display buffer size when `size-indication-mode' is on."
  440. :type 'string
  441. :group 'smart-mode-line-position
  442. :package-version '(smart-mode-line . "2.0")
  443. :set 'sml/compile-position-construct
  444. :initialize 'custom-initialize-default)
  445. (put 'sml/size-indication-format 'risky-local-variable t)
  446. (defcustom sml/col-number-format "%2c"
  447. "Format used to display column number.
  448. Empty it or disable `column-number-mode' to hide the number."
  449. :type 'string
  450. :group 'smart-mode-line-position
  451. :set 'sml/compile-position-construct
  452. :initialize 'custom-initialize-default)
  453. (put 'sml/col-number-format 'risky-local-variable t)
  454. (defcustom sml/numbers-separator ":"
  455. "Separator between line and column number.
  456. Since we use different faces for line and column number, you can
  457. just set this to \"\" to save an extra char of space."
  458. :type 'string
  459. :group 'smart-mode-line-position)
  460. (defcustom sml/show-remote t
  461. "Whether to display an \"@\" for remote buffers.
  462. If the buffer is local, an \"-\" is displayed instead.
  463. If this variable is nil, nothing is displayed."
  464. :type 'boolean
  465. :group 'smart-mode-line-others)
  466. (put 'sml/show-remote 'safe-local-variable 'booleanp)
  467. (defcustom sml/show-client nil
  468. "Whether to show an \"@\" for emacsclient frames."
  469. :type 'boolean
  470. :group 'smart-mode-line-others)
  471. (put 'sml/show-client 'safe-local-variable 'booleanp)
  472. (defcustom sml/modified-char (char-to-string (if (char-displayable-p ) ?*))
  473. "String that indicates if buffer is modified. Should be one SINGLE char."
  474. :type 'string
  475. :group 'smart-mode-line-others
  476. :package-version '(smart-mode-line . "1.16"))
  477. (defcustom sml/not-modified-char " "
  478. "String that indicates if buffer is un-modified. Should be one SINGLE char."
  479. :type 'string
  480. :group 'smart-mode-line-others
  481. :package-version '(smart-mode-line . "1.16"))
  482. (defcustom sml/show-trailing-N t
  483. "Whether the \"<N>\" suffix in buffer names should be displayed in the mode-line."
  484. :type 'boolean
  485. :group 'smart-mode-line-path-and-prefix)
  486. (put 'sml/show-trailing-N 'safe-local-variable 'booleanp)
  487. (defcustom sml/show-file-name t
  488. "Unless nil: show file name instead of buffer name on the mode-line."
  489. :type 'boolean
  490. :group 'smart-mode-line-path-and-prefix)
  491. (put 'sml/show-file-name 'safe-local-variable 'booleanp)
  492. (defcustom sml/fill-char ?\s
  493. "The char to be used for filling."
  494. :type 'char
  495. :group 'smart-mode-line-path-and-prefix)
  496. (defcustom sml/replacer-regexp-list
  497. `((,(concat "^" (if (boundp 'org-directory) (regexp-quote org-directory) "~/org/")) ":Org:")
  498. ("^~/\\.emacs\\.d/elpa/" ":ELPA:")
  499. ("^~/\\.emacs\\.d/" ":ED:")
  500. ("^/sudo:.*:" ":SU:")
  501. ("^~/Documents/" ":Doc:")
  502. ("^~/Dropbox/" ":DB:")
  503. ("^:\\([^:]*\\):Documento?s/" ":\\1/Doc:")
  504. ("^~/[Gg]it/" ":Git:")
  505. ("^~/[Gg]it[Hh]ub/" ":Git:")
  506. ("^~/[Gg]it\\([Hh]ub\\|\\)-?[Pp]rojects/" ":Git:"))
  507. "List of pairs of strings used (by `sml/replacer') to create prefixes.
  508. The first string of each pair is a regular expression, the second
  509. is a replacement. These pairs are sequentially applied on the
  510. file path to replace portions of it, turning them into prefixes.
  511. For instance, \"~/.emacs.d/\" is replaced by \":ED:\", which is
  512. shorter but easily identified.
  513. The replacement strings can really be anything, but to be colored
  514. as a prefix a string must start and end with \":\" (see the
  515. default as an example, as an exception \"~/\" is also a prefix).
  516. Replacement doesn't stop on first match, so you can have stacking replacements:
  517. (add-to-list 'sml/replacer-regexp-list '(\"^:DB:Org/\" \":Org:\") t)
  518. Remember that `add-to-list' adds items to the FRONT, and you'll
  519. usually want to add them to the back (thus the t at the end).
  520. You can also set custom colors (faces) for these prefixes, just
  521. set `sml/prefix-face-list' accordingly."
  522. :type '(repeat (list regexp string))
  523. :group 'smart-mode-line-path-and-prefix
  524. :package-version '(smart-mode-line . "1.22"))
  525. (defcustom sml/prefix-regexp '(":\\(.*:\\)" "~/")
  526. "List of Regexps used to identify prefixes.
  527. A prefix is anything at the beginning of a line that matches any
  528. of these regexps. Don't start these regexps with \"^\", the
  529. parser applies that for you."
  530. :type '(repeat regexp)
  531. :group 'smart-mode-line-path-and-prefix)
  532. (defcustom sml/prefix-face-list '((":SU:" sml/sudo)
  533. (":G" sml/git)
  534. (sml/projectile-replacement-format sml/projectile)
  535. ("" sml/prefix))
  536. "List of (STRING FACE) pairs used by `sml/propertize-prefix'.
  537. After the file path is constructed, the prefix contained in it is
  538. colored according to this list. The elements are checked one by
  539. one and, if the prefix contains the STRING part of the pair, then
  540. FACE is applied to it (and checking stops there)."
  541. :type '(repeat (list string face))
  542. :group 'smart-mode-line-path-and-prefix)
  543. (defcustom sml/name-width 44
  544. "Minimum and maximum size of the file name in the mode-line.
  545. If `sml/shorten-directory' is nil, this is the minimum width.
  546. Otherwise, this is both the minimum and maximum width.
  547. Alternatively, you can set the minimum and maximum widths
  548. separately, by setting this variable to a cons cell of integers:
  549. (MIN-WIDTH . MAX-WIDTH)
  550. "
  551. :type '(choice integer (cons (integer :tag "Minimum width")
  552. (integer :tag "Maximum width")))
  553. :group 'smart-mode-line-path-and-prefix)
  554. (defvaralias 'sml/path-width 'sml/name-width)
  555. (defcustom sml/shorten-directory t
  556. "Should directory name be shortened to fit width?
  557. When the buffer+directory name is longer than
  558. `sml/name-width':
  559. if nil the rest of the mode-line is pushed right;
  560. otherwise the directory name is shortened to fit."
  561. :type 'boolean
  562. :group 'smart-mode-line-path-and-prefix
  563. :set 'sml/set-shortener-func)
  564. (put 'sml/shorten-directory 'safe-local-variable 'booleanp)
  565. (defcustom sml/full-mode-string " +"
  566. "String that's appended to the minor-mode list when it's full."
  567. :type 'string
  568. :group 'smart-mode-line-mode-list)
  569. (defcustom sml/shorten-mode-string " -"
  570. "String that's appended to the minor-mode list when all modes are displayed."
  571. :type 'string
  572. :group 'smart-mode-line-mode-list)
  573. (defcustom sml/shorten-modes t
  574. "Should modes list be shortened to fit width?
  575. When the modes list is longer than `sml/mode-width':
  576. if nil the rest of the mode-line is pushed right;
  577. otherwise the list is shortened to fit."
  578. :type 'boolean
  579. :group 'smart-mode-line-mode-list)
  580. (put 'sml/shorten-modes 'safe-local-variable 'booleanp)
  581. (defun sml/toggle-shorten-directory (&rest val)
  582. "Toggle the variable `sml/shorten-directory'.
  583. If given an argument VAL, the variable is set to the argument,
  584. otherwise it is toggled. This can be used as an alternative to
  585. customizing the variable with `customize-group'. Setting the
  586. variable with `setq' will NOT work and should be avoided."
  587. (interactive)
  588. (sml/set-shortener-func 'sml/shorten-directory
  589. (if val (car-safe val)
  590. (not sml/shorten-directory))))
  591. (defun sml/toggle-shorten-modes (&rest val)
  592. "Toggle the variable `sml/shorten-modes'.
  593. If given an argument VAL, the variable is set to the argument,
  594. otherwise it is toggled. This can be used as an alternative to
  595. customizing the variable with `customize-group'. Equivalent to
  596. setting the variable with `setq'."
  597. (interactive)
  598. (setq sml/shorten-modes (if val (car val)
  599. (not sml/shorten-modes)))
  600. (force-mode-line-update))
  601. (defcustom sml/mode-width 'full
  602. "Maximum and/or minimum size of the modes list in the mode-line.
  603. If it is an integer, then the modes list width is that many
  604. characters.
  605. If it is the symbol `full', then the mode-list fills all the
  606. empty space is available in the mode-line (this has the effect of
  607. indenting right anything after the mode-list).
  608. If it is the symbol `right', then it behaves like `full', but the
  609. minor-modes list is moved all the way to the right.
  610. If `sml/shorten-modes' is nil, this is the minimum width.
  611. Otherwise, this is both the minimum and maximum width."
  612. :type '(choice integer symbol)
  613. :group 'smart-mode-line-mode-list
  614. :package-version '(smart-mode-line . "2.4.5"))
  615. (defcustom sml/battery-format " %p"
  616. "Format used to display the battery in the mode-line.
  617. Only relevant if using `display-battery-mode'. See that function
  618. for the syntax."
  619. :type 'string
  620. :group 'smart-mode-line-others)
  621. (defcustom sml/modified-time-string "Modified on %T %Y-%m-%d."
  622. "String format used for displaying the modified time.
  623. This is shown in the tooltip when hovering over the \"modified
  624. file\" character (which is usually a * right before the file
  625. name."
  626. :type 'string
  627. :group 'smart-mode-line-others)
  628. (defcustom sml/extra-filler 0
  629. "The number of extra filling chars to use.
  630. It comes into play when `sml/mode-width' is set to 'full.
  631. This is necessary because the mode-line width (which we need but
  632. don't have access to) is larger than `window-total-width' (which
  633. we have access to).
  634. Decrease this if right indentation seems to be going too far (or
  635. if you just want to fine-tune it)."
  636. :type 'integer
  637. :group 'smart-mode-line-mode-list)
  638. ;; Face definitions
  639. (defface sml/global '((t :inverse-video nil)) "" :group 'smart-mode-line-faces)
  640. (defface sml/modes '((t :inherit sml/global)) "" :group 'smart-mode-line-faces)
  641. (defface sml/minor-modes '((t :inherit sml/global)) "" :group 'smart-mode-line-faces)
  642. (defface sml/filename '((t :inherit sml/global :weight bold)) "" :group 'smart-mode-line-faces)
  643. (defface sml/prefix '((t :inherit sml/global)) "" :group 'smart-mode-line-faces)
  644. (defface sml/read-only '((t :inherit sml/not-modified)) "" :group 'smart-mode-line-faces)
  645. (defface sml/modified '((t :inherit sml/not-modified :foreground "Red" :weight bold))
  646. "" :group 'smart-mode-line-faces)
  647. (defface sml/outside-modified '((t :inherit sml/not-modified :foreground "#ffffff" :background "#c82829"))
  648. "" :group 'smart-mode-line-faces)
  649. (defface sml/line-number '((t :inherit sml/modes :weight bold)) "" :group 'smart-mode-line-faces)
  650. (defface sml/remote '((t :inherit sml/global)) "" :group 'smart-mode-line-faces)
  651. (defface sml/name-filling '((t :inherit sml/position-percentage)) "" :group 'smart-mode-line-faces)
  652. (defface sml/position-percentage '((t :inherit sml/prefix :weight normal)) "" :group 'smart-mode-line-faces)
  653. (defface sml/col-number '((t :inherit sml/global)) "" :group 'smart-mode-line-faces)
  654. (defface sml/numbers-separator '((t :inherit sml/col-number)) "" :group 'smart-mode-line-faces)
  655. (defface sml/client '((t :inherit sml/prefix)) "" :group 'smart-mode-line-faces)
  656. (defface sml/not-modified '((t :inherit sml/global)) "" :group 'smart-mode-line-faces)
  657. (defface sml/mule-info '((t :inherit sml/global)) "" :group 'smart-mode-line-faces)
  658. (defface sml/sudo '((t :inherit sml/outside-modified)) "" :group 'smart-mode-line-faces)
  659. (defface sml/git '((t :inherit (sml/read-only sml/prefix))) "" :group 'smart-mode-line-faces)
  660. (defface sml/folder '((t :inherit sml/global :weight normal)) "" :group 'smart-mode-line-faces)
  661. (defface sml/process '((t :inherit sml/prefix)) "" :group 'smart-mode-line-faces)
  662. (defface sml/vc '((t :inherit sml/git)) "" :group 'smart-mode-line-faces)
  663. (defface sml/vc-edited '((t :inherit sml/prefix)) "" :group 'smart-mode-line-faces)
  664. (defface sml/charging '((t :inherit sml/global :foreground "ForestGreen")) "" :group 'smart-mode-line-faces)
  665. (defface sml/discharging '((t :inherit sml/global :foreground "Red")) "" :group 'smart-mode-line-faces)
  666. (defface sml/time '((t :inherit sml/modes)) "" :group 'smart-mode-line-faces)
  667. (defvar sml/-apply-theme-is-running nil "Avoid nesting in `sml/apply-theme'.")
  668. (defcustom sml/no-confirm-load-theme nil
  669. "If non-nil, `sml/apply-theme' will pass the NO-CONFIRM flag to `load-theme'.
  670. If you're having problems with Emacs always asking for permission
  671. to load a theme (and not remembering your choice), you can set
  672. this to t to workaround the problem. But it's recommended that
  673. you try the problem instead."
  674. :type 'boolean
  675. :group 'smart-mode-line-faces
  676. :package-version '(smart-mode-line . "2.5.2"))
  677. ;;;###autoload
  678. (when load-file-name
  679. (let ((dir (file-name-as-directory (file-name-directory load-file-name))))
  680. (add-to-list 'custom-theme-load-path dir)
  681. (when (file-directory-p (file-name-as-directory (concat dir "themes")))
  682. (add-to-list 'custom-theme-load-path
  683. (file-name-as-directory (concat dir "themes"))))))
  684. (defun sml/apply-theme (theme &optional value silent)
  685. "Apply the theme called smart-mode-line-THEME.
  686. THEME is usually one of the symbols: respectful, dark, or light;
  687. but it can be something else if there are other smart-mode-line
  688. themes defined.
  689. See the `sml/theme' variable for the meaning of each symbol.
  690. This function will call `disable-theme' on any enabled themes
  691. whose name starts with \"smart-mode-line-\", then it will call
  692. `load-theme' on the theme called \"smart-mode-line-THEME\".
  693. This also sets the `sml/theme' variable, see its documentation
  694. for more information on each value.
  695. The second argument (VALUE) is for internal use only, DON'T USE IT.
  696. Third argument SILENT prevents messages."
  697. (interactive
  698. (list
  699. (intern
  700. (completing-read
  701. "Load smart-mode-line theme: "
  702. (cons
  703. 'automatic
  704. (mapcar
  705. (lambda (x) (replace-regexp-in-string "\\`smart-mode-line-" "" (symbol-name x)))
  706. (cl-remove-if-not #'sml/theme-p (custom-available-themes))))))
  707. nil nil))
  708. (sml/-debug "Entering apply-theme")
  709. (when (eq theme (intern "")) (setq theme nil))
  710. (sml/-debug theme)
  711. (sml/-debug sml/theme)
  712. (unless silent (message "[sml] %s set to %s" 'sml/theme (or value theme)))
  713. (sml/-debug sml/-apply-theme-is-running)
  714. (unless sml/-apply-theme-is-running
  715. (let ((sml/-apply-theme-is-running t)) ;Avoid nesting.
  716. ;; Set the variable
  717. (setq-default sml/theme (or value theme))
  718. (sml/-debug sml/theme)
  719. ;; Disable any previous smart-mode-line themes.
  720. (sml/-debug custom-enabled-themes)
  721. (mapc (lambda (x) (when (sml/theme-p x) (disable-theme x)))
  722. custom-enabled-themes)
  723. (sml/-debug custom-enabled-themes)
  724. ;; Load the theme requested.
  725. (sml/-debug sml/theme)
  726. (when (eq sml/theme 'automatic)
  727. (setq sml/theme (sml/-automatically-decide-theme)))
  728. (sml/-debug sml/theme)
  729. (when sml/theme
  730. (let ((theme-name
  731. (if (sml/theme-p sml/theme) sml/theme
  732. (intern (format "smart-mode-line-%s" sml/theme)))))
  733. (sml/-debug theme-name)
  734. (load-theme theme-name sml/no-confirm-load-theme))))))
  735. (defadvice enable-theme (after sml/after-enable-theme-advice (theme) activate)
  736. "Make sure smart-mode-line themes take priority over global themes that don't customize sml faces."
  737. (unless (or (eq theme 'user) (sml/faces-from-theme theme))
  738. (mapc #'enable-theme
  739. (reverse (cl-remove-if-not #'sml/theme-p custom-enabled-themes)))))
  740. (defun sml/theme-p (theme)
  741. "Return non-nil if theme named THEME is a smart-mode-line theme.
  742. Takes symbols and strings."
  743. (string-match "\\`smart-mode-line-" (if (symbolp theme) (symbol-name theme) theme)))
  744. (defvaralias 'sml/show-encoding 'sml/mule-info)
  745. (defcustom sml/show-eol nil
  746. "Whether to display the buffer EOL in the mode-line."
  747. :type 'boolean
  748. :group 'smart-mode-line-others)
  749. (put 'sml/show-eol 'safe-local-variable 'booleanp)
  750. (defcustom sml/outside-modified-char "M"
  751. "Char to display if buffer needs to be reverted."
  752. :type 'string
  753. :group 'smart-mode-line-others
  754. :package-version '(smart-mode-line . "1.20"))
  755. (defvaralias 'sml/encoding-format 'sml/mule-info)
  756. (defcustom sml/mule-info "%z"
  757. "Format for multilingual information. Set this to nil to hide buffer encoding."
  758. :type '(choice string (const :tag "Don't display." nil))
  759. :group 'smart-mode-line-others
  760. :package-version '(smart-mode-line . "2.0"))
  761. (defcustom sml/read-only-char "R"
  762. "Displayed when buffer is readonly."
  763. :type 'string
  764. :group 'smart-mode-line-others
  765. :package-version '(smart-mode-line . "1.20"))
  766. (defcustom sml/show-frame-identification nil
  767. "Whether to show frame identification or not.
  768. In some systems this doesn't even display anything. It's most useful
  769. on terminals, but you might want to disable it anyway.
  770. Just set this to nil, and frame identification won't be displayed."
  771. :type 'boolean
  772. :group 'smart-mode-line-others
  773. :package-version '(smart-mode-line . "2.0.3"))
  774. (put 'sml/show-frame-identification 'safe-local-variable 'booleanp)
  775. (defcustom sml/vc-mode-show-backend nil
  776. "Whether to show or not the backend in vc-mode's mode-line description.
  777. I think most people only use one backend, so this defaults to nil.
  778. If you want it to show the backend, just set it to t."
  779. :type 'boolean
  780. :group 'smart-mode-line-others
  781. :package-version '(smart-mode-line . "1.22"))
  782. (put 'sml/vc-mode-show-backend 'safe-local-variable 'booleanp)
  783. (defvar sml/position-construct nil "Used for recycling position information.")
  784. (put 'sml/position-construct 'risky-local-variable t)
  785. (defvar sml/position-help-text nil "Help-text for position information.")
  786. (make-variable-buffer-local 'sml/position-help-text)
  787. ;;; Buffer Identification
  788. (defvar sml/buffer-identification-filling nil
  789. "Filling generated by `sml/fill-for-buffer-identification'.")
  790. (make-variable-buffer-local 'sml/buffer-identification-filling)
  791. (put 'sml/buffer-identification-filling 'risky-local-variable t)
  792. (defvar sml/buffer-identification nil
  793. "Used for recycling buffer identification without having to recompute it.")
  794. (make-variable-buffer-local 'sml/buffer-identification)
  795. (put 'sml/buffer-identification 'risky-local-variable t)
  796. (defadvice rename-buffer (after sml/after-rename-buffer-advice ())
  797. "Regenerate buffer-identification after `rename-buffer'."
  798. (sml/generate-buffer-identification))
  799. (defadvice set-visited-file-name (after sml/after-set-visited-file-name-advice ())
  800. "Regenerate buffer-identification after `set-visited-file-name'."
  801. (sml/generate-buffer-identification))
  802. (defvar sml/name-width-old nil "Used for recalculating buffer identification filling only when necessary.")
  803. (make-variable-buffer-local 'sml/name-width-old)
  804. (defvar sml/shorten-directory-old nil "Used for recalculating buffer identification filling only when necessary.")
  805. (make-variable-buffer-local 'sml/shorten-directory-old)
  806. (defun sml/generate-buffer-identification-if-necessary ()
  807. "Call `sml/generate-buffer-identification' only if `sml/name-width' has changed."
  808. (unless (and (equal sml/name-width-old sml/name-width)
  809. (equal sml/shorten-directory-old sml/shorten-directory))
  810. (setq sml/name-width-old sml/name-width)
  811. (setq sml/shorten-directory-old sml/shorten-directory)
  812. (sml/generate-buffer-identification))
  813. nil)
  814. (defvar sml/mode-line-client
  815. `(sml/show-client
  816. (:eval (if (frame-parameter nil 'client)
  817. ,(propertize "@" 'face 'sml/client 'help-echo (purecopy "emacsclient frame"))
  818. " ")))
  819. "Construct that replaces `mode-line-client'.")
  820. (defvar sml/mode-line-buffer-identification
  821. '("" (sml/buffer-identification
  822. sml/buffer-identification
  823. (:eval (sml/generate-buffer-identification))))
  824. "Replace the default `mode-line-buffer-identification' with our own.")
  825. (defvar sml/projectile-replacement-format)
  826. (defvar sml/use-projectile-p)
  827. (defvar sml/projectile-loaded-p nil "Non-nil if projectile has been loaded.")
  828. (defcustom sml/pos-id-separator " "
  829. "Miscellaneous mode-line construct."
  830. :type 'string)
  831. (put 'sml/pos-id-separator 'risky-local-variable t)
  832. (defcustom sml/pre-modes-separator " "
  833. "Miscellaneous mode-line construct."
  834. :type 'string)
  835. (put 'sml/pre-modes-separator 'risky-local-variable t)
  836. (defcustom sml/pre-id-separator ""
  837. "Miscellaneous mode-line construct."
  838. :type 'string)
  839. (put 'sml/pre-id-separator 'risky-local-variable t)
  840. (defcustom sml/pre-minor-modes-separator ""
  841. "Miscellaneous mode-line construct."
  842. :type 'string)
  843. (put 'sml/pre-minor-modes-separator 'risky-local-variable t)
  844. (defcustom sml/pos-minor-modes-separator ""
  845. "Miscellaneous mode-line construct."
  846. :type 'string)
  847. (put 'sml/pos-minor-modes-separator 'risky-local-variable t)
  848. (defun sml/-automatically-decide-theme ()
  849. "Return the most appropriate sml theme, based on global theme."
  850. (sml/-debug "Entering -automatically-decide-theme")
  851. (sml/-debug (sml/global-theme-support-sml-p))
  852. (unless (sml/global-theme-support-sml-p)
  853. (sml/-debug (face-background 'mode-line nil t))
  854. (sml/-debug (face-background 'default nil t))
  855. (let ((bg (ignore-errors
  856. (or (face-background 'mode-line nil t)
  857. (face-background 'default nil t)))))
  858. (if (ignore-errors
  859. (and (stringp bg)
  860. (> (color-distance "white" bg)
  861. (color-distance "black" bg))))
  862. 'dark 'light))))
  863. (defun sml/-setup-theme ()
  864. "Decide what theme to use and apply it.
  865. Used during initialization."
  866. (sml/-debug "Entering -setup-theme")
  867. (sml/-debug sml/theme)
  868. (when sml/theme
  869. (when (eq sml/theme 'automatic)
  870. (setq sml/theme (sml/-automatically-decide-theme)))
  871. (sml/-debug "chosen theme:")
  872. (sml/-debug sml/theme)
  873. (sml/apply-theme sml/theme nil :silent)))
  874. (defvar battery-mode-line-format)
  875. ;;;###autoload
  876. (defun sml/setup (&optional arg)
  877. "Setup the mode-line to be smart and sexy.
  878. ARG is ignored. Just call this function in your init file, and
  879. the mode-line will be setup."
  880. (interactive)
  881. (sml/-debug "Entering setup")
  882. (sml/-debug custom-enabled-themes)
  883. ;; Just a couple of useful variables
  884. (setq sml/simplified nil)
  885. (setq battery-mode-line-format sml/battery-format)
  886. ;; Activate rich-minority, and configure it for us.
  887. (setq rm-base-text-properties
  888. (append rm-base-text-properties '('face 'sml/minor-modes)))
  889. ;; Set the theme the user requested.
  890. (sml/-setup-theme)
  891. ;;;; And this is where the magic happens.
  892. ;; Remove elements we implement separately, and improve the ones not removed.
  893. (sml/filter-mode-line-list 'mode-line-mule-info)
  894. (setq-default mode-line-client sml/mode-line-client)
  895. (sml/filter-mode-line-list 'mode-line-modified)
  896. (sml/filter-mode-line-list 'mode-line-remote)
  897. (setq-default mode-line-frame-identification
  898. '("" (sml/show-frame-identification "%F")
  899. sml/pre-id-separator))
  900. ;; (setq-default mode-line-buffer-identification '("%b"))
  901. (setq-default mode-line-buffer-identification
  902. sml/mode-line-buffer-identification)
  903. (sml/filter-mode-line-list 'mode-line-position)
  904. (sml/filter-mode-line-list 'mode-line-modes)
  905. (setq-default mode-line-end-spaces nil)
  906. ;; Add position descriptions on the left (they were already removed
  907. ;; from the middle). Since this is the very first symbol to be
  908. ;; evaluated, we also use it for calculating variables that need to
  909. ;; be updated
  910. (setq-default mode-line-front-space '((:eval (sml/generate-buffer-identification-if-necessary))
  911. (sml/position-help-text
  912. nil
  913. (:eval (let ((sml/-this-buffer-changed-p t))
  914. (sml/generate-position-help))))
  915. (sml/position-construct
  916. sml/position-construct
  917. (:eval (sml/compile-position-construct)))))
  918. (add-hook 'after-save-hook 'sml/generate-buffer-identification)
  919. (ad-activate 'rename-buffer)
  920. (ad-activate 'set-visited-file-name)
  921. (add-hook 'clone-indirect-buffer-hook 'sml/generate-buffer-identification)
  922. ;; (ad-activate 'set-buffer-modified-p)
  923. (add-hook 'after-change-functions 'sml/-this-buffer-changed)
  924. (add-hook 'post-command-hook 'sml/generate-position-help)
  925. ;; This is to ensure fixed name width. The reason we do this manually
  926. ;; is that some major-modes change `mode-line-buffer-identification'
  927. ;; (so we can't fill inside the variable), and we want this
  928. ;; symbol to be an element in `mode-line-format' for compatibility
  929. ;; with other packages which hack into the mode-line.
  930. (add-to-list 'mode-line-position
  931. '(sml/buffer-identification-filling
  932. sml/buffer-identification-filling
  933. (:eval (setq sml/buffer-identification-filling
  934. (sml/fill-for-buffer-identification)))))
  935. ;; Remove some annoying big spaces
  936. (setq-default mode-line-format
  937. (mapcar
  938. (lambda (x) (cond
  939. ;; ((eq x 'mode-line-buffer-identification)
  940. ;; '(:propertize mode-line-buffer-identification face sml/id))
  941. ((and (stringp x) (string= x " "))
  942. 'sml/pos-id-separator)
  943. ((and (stringp x) (string= x " "))
  944. 'sml/pre-modes-separator)
  945. (t x)))
  946. mode-line-format))
  947. ;;;; And here comes support for a bunch of extra stuff. Some of
  948. ;;;; these are just needed for coloring.
  949. ;; Shell and eshell support
  950. (add-hook 'comint-output-filter-functions 'sml/generate-buffer-identification)
  951. (add-hook 'eshell-directory-change-hook 'sml/generate-buffer-identification)
  952. ;; ;; Term support - Disabled for now because of Issue#198
  953. ;; (defadvice term-command-hook (after sml/term-advice-1 activate)
  954. ;; (sml/generate-buffer-identification))
  955. ;; (defadvice term-handle-ansi-terminal-messages (after sml/term-advice-2 activate)
  956. ;; (sml/generate-buffer-identification))
  957. ;; Dired overrides the buffer-identification (which we would
  958. ;; normally respect) but doesn't actually do anything useful with
  959. ;; it, so we overoverride back.
  960. (add-hook 'dired-mode-hook 'sml/set-buffer-identification)
  961. ;; Display time
  962. (add-hook 'display-time-hook 'sml/propertize-time-string)
  963. ;; Battery support
  964. (eval-after-load 'battery
  965. '(defadvice battery-update (after sml/after-battery-update-advice () activate)
  966. "Change battery color."
  967. (when battery-mode-line-string
  968. (setq battery-mode-line-string
  969. (propertize battery-mode-line-string
  970. 'face 'sml/battery)))))
  971. ;; Projectile support
  972. (eval-after-load "projectile"
  973. '(progn
  974. (setq sml/projectile-loaded-p t)
  975. (defcustom sml/projectile-replacement-format "[%s]"
  976. "Format used for replacements derived from projectile."
  977. :type 'string
  978. :group 'smart-mode-line-others
  979. :package-version '(smart-mode-line . "2.4"))
  980. (defcustom sml/use-projectile-p 'after-prefixes
  981. "Whether we should use projectile to guess path prefixes.
  982. If this is non-nil, and if current buffer is inside a project (as
  983. defined by projectile), we use the project's name as a
  984. prefix (with the `sml/projectile-replacement-format' variable).
  985. If this is 'after-prefix, then this replacement will only be used
  986. if no other prefixes (defined in `sml/replacer-regexp-list') were
  987. found to match the current file path."
  988. :type '(choice (const :tag "Use projectile only if current path doesn't match any prefixes." after-prefixes)
  989. (const :tag "Use projectile before checking prefixes." before-prefixes)
  990. (const :tag "Don't use projectile." nil))
  991. :group 'smart-mode-line-others
  992. :package-version '(smart-mode-line . "2.4.1"))
  993. (defface sml/projectile '((t :inherit sml/git)) "" :group 'smart-mode-line-faces)
  994. (add-to-list 'sml/prefix-regexp (format (regexp-quote sml/projectile-replacement-format) ".*"))))
  995. ;; vc-mode
  996. (eval-after-load "vc-hooks"
  997. '(defadvice vc-mode-line (after sml/after-vc-mode-line-advice () activate)
  998. "Color `vc-mode'."
  999. (when (stringp vc-mode)
  1000. (let ((noback (replace-regexp-in-string (format "^ %s" (vc-backend buffer-file-name)) " " vc-mode)))
  1001. (setq vc-mode
  1002. (propertize (if sml/vc-mode-show-backend vc-mode noback)
  1003. 'face (cond ((string-match "^ -" noback) 'sml/vc)
  1004. ((string-match "^ [:@]" noback) 'sml/vc-edited)
  1005. ((string-match "^ [!\\?]" noback) 'sml/modified))))))))
  1006. ;; Mew support
  1007. (eval-after-load "mew-net"
  1008. '(progn
  1009. (defgroup smart-mode-line-mew '() "Group for editing the mew-support variables." :group 'smart-mode-line)
  1010. (defcustom sml/mew-support t
  1011. "Whether to flash the mode-line when mew detects new mail."
  1012. :type 'boolean :group 'smart-mode-line-mew
  1013. :package-version '(smart-mode-line . "1.11"))
  1014. (defcustom sml/new-mail-background-color "#110000"
  1015. "When new mail arrives, mode-line background will be tinted this color.
  1016. Only works with mew-biff. Right now it stays colored until you
  1017. read the mail, so this color should probably be something sutil.
  1018. Might implement a quick flash eventually."
  1019. :type 'color :group 'smart-mode-line-mew
  1020. :package-version '(smart-mode-line . "1.11"))
  1021. (defcustom sml/mew-biff-format (concat "%2d" (if (char-displayable-p ?✉) "" "M"))
  1022. "Format used for new-mail notifications if you use mew with biff."
  1023. :type 'string :group 'smart-mode-line-mew
  1024. :package-version '(smart-mode-line . "1.11"))
  1025. (defadvice mew-biff-clear (around sml/mew-biff-clear-advice activate)
  1026. "Advice used to customize mew-biff-bark to fit sml's style."
  1027. ad-do-it
  1028. (when sml/mew-support
  1029. ;; Remove the color
  1030. (set-face-attribute 'mode-line nil :background sml/active-background-color)))
  1031. (defadvice mew-biff-bark (around sml/mew-biff-bark-advice (n) activate)
  1032. "Advice used to customize mew-biff-bark to fit sml's style."
  1033. ad-do-it
  1034. (when sml/mew-support
  1035. ;; Remove the color if mail has been read.
  1036. (if (= n 0) (set-face-attribute 'mode-line nil :background sml/active-background-color)
  1037. ;; Apply color if there's mail. (mew-biff-bark 100)
  1038. (set-face-attribute 'mode-line nil :background sml/new-mail-background-color)
  1039. (setq mew-biff-string (format sml/mew-biff-format n)))))))
  1040. (unless (and (boundp 'erc-track-position-in-mode-line)
  1041. (null erc-track-position-in-mode-line))
  1042. (setq erc-track-position-in-mode-line t))
  1043. (run-hooks 'sml/after-setup-hook))
  1044. ;;;###autoload
  1045. (defalias 'smart-mode-line-enable #'sml/setup)
  1046. (defun sml/global-theme-support-sml-p ()
  1047. "Non-nil if any of the enabled themes supports smart-mode-line."
  1048. (cl-remove-if
  1049. #'sml/theme-p
  1050. (cl-remove-if-not #'sml/faces-from-theme custom-enabled-themes)))
  1051. (defun sml/faces-from-theme (theme)
  1052. "Return the sml faces that THEME customizes."
  1053. (cl-remove-if-not
  1054. (lambda (it) (string-match "\\`sml/" (symbol-name it)))
  1055. (mapcar #'cadr (get theme 'theme-settings))))
  1056. (defun sml/set-buffer-identification (&rest ignored)
  1057. "Setq the buffer-identification of this buffer back to ours.
  1058. Currently, we only this for dired. For other modes (like info) we
  1059. respect their changes.
  1060. Argument IGNORED is obsolete."
  1061. (setq mode-line-buffer-identification sml/mode-line-buffer-identification))
  1062. (defvar sml/-this-buffer-changed-p nil
  1063. "t if buffer was changed since last help-text update.")
  1064. (make-variable-buffer-local 'sml/-this-buffer-changed-p)
  1065. (defun sml/-this-buffer-changed (&rest ignored)
  1066. "Set variable `sml/-this-buffer-changed-p' to t.
  1067. Argument IGNORED is ignored."
  1068. (setq sml/-this-buffer-changed-p t) nil)
  1069. (defun sml/generate-position-help (&rest ignored)
  1070. "Set the string describing various buffer content information.
  1071. Argument IGNORED is ignored."
  1072. (when (and sml/-this-buffer-changed-p
  1073. (get-buffer-window (current-buffer)))
  1074. (setq sml/-this-buffer-changed-p nil)
  1075. (setq sml/position-help-text
  1076. (format-mode-line
  1077. (concat "Buffer size:\n\t%IB\n"
  1078. ;; ;; This is way too slow, unfortunately.
  1079. ;; "Number of Lines:\n\t"
  1080. ;; (int-to-string (line-number-at-pos (point-max)))
  1081. "\nmouse-1: Display Line and Column Mode Menu")))
  1082. nil))
  1083. (defcustom sml/order-of-line-and-column nil
  1084. "Decide the order of line-number and column-number display.
  1085. When both `line-number-mode' and `column-number-mode' are
  1086. enabled, this variable decides which gets displayed on the left,
  1087. and which gets displayed on the right. If either one of the modes
  1088. is not enabled, this variable has no effect (obviously).
  1089. It can only be t or nil.
  1090. t means column-number:line-number
  1091. nil means line-number:column-number"
  1092. :type '(choice (const :tag "column-number:line-number" t)
  1093. (const :tag "line-number:column-number" nil))
  1094. :group 'smart-mode-line-position
  1095. :package-version '(smart-mode-line . "2.4"))
  1096. (defun sml/compile-position-construct (&optional symbol value)
  1097. "Recompile the `sml/position-construct' after one of the formats was edited.
  1098. Also sets SYMBOL to VALUE."
  1099. (when (and symbol value) (set symbol value))
  1100. (sml/generate-position-help)
  1101. (setq sml/position-construct
  1102. `((size-indication-mode
  1103. ,(propertize sml/size-indication-format
  1104. 'face 'sml/col-number
  1105. 'help-echo 'sml/position-help-text
  1106. 'mouse-face 'mode-line-highlight
  1107. 'local-map mode-line-column-line-number-mode-map))
  1108. (sml/order-of-line-and-column
  1109. (column-number-mode
  1110. ,(propertize sml/col-number-format
  1111. 'face 'sml/col-number
  1112. 'help-echo 'sml/position-help-text
  1113. 'mouse-face 'mode-line-highlight
  1114. 'local-map mode-line-column-line-number-mode-map))
  1115. (line-number-mode
  1116. ,(propertize sml/line-number-format
  1117. 'face 'sml/line-number
  1118. 'help-echo 'sml/position-help-text
  1119. 'mouse-face 'mode-line-highlight
  1120. 'local-map mode-line-column-line-number-mode-map)))
  1121. (column-number-mode
  1122. (line-number-mode
  1123. ,(propertize sml/numbers-separator
  1124. 'face 'sml/numbers-separator
  1125. 'help-echo 'sml/position-help-text
  1126. 'mouse-face 'mode-line-highlight
  1127. 'local-map mode-line-column-line-number-mode-map)))
  1128. (sml/order-of-line-and-column
  1129. (line-number-mode
  1130. ,(propertize sml/line-number-format
  1131. 'face 'sml/line-number
  1132. 'help-echo 'sml/position-help-text
  1133. 'mouse-face 'mode-line-highlight
  1134. 'local-map mode-line-column-line-number-mode-map))
  1135. (column-number-mode
  1136. ,(propertize sml/col-number-format
  1137. 'face 'sml/col-number
  1138. 'help-echo 'sml/position-help-text
  1139. 'mouse-face 'mode-line-highlight
  1140. 'local-map mode-line-column-line-number-mode-map))))))
  1141. (defun sml/generate-modified-status ()
  1142. "Return a string describing the modified status of the buffer."
  1143. (cond
  1144. ((not (or (and (buffer-file-name) (file-remote-p buffer-file-name))
  1145. (verify-visited-file-modtime (current-buffer))))
  1146. (propertize sml/outside-modified-char 'face 'sml/outside-modified
  1147. 'help-echo "Modified outside Emacs!\nRevert first!"))
  1148. ((buffer-modified-p)
  1149. (propertize (if buffer-read-only
  1150. sml/read-only-char
  1151. sml/modified-char)
  1152. 'face 'sml/modified
  1153. 'help-echo (if (and (buffer-file-name) (not (file-remote-p buffer-file-name)))
  1154. (format-time-string
  1155. sml/modified-time-string
  1156. (nth 5 (file-attributes (buffer-file-name))))
  1157. "Buffer Modified")
  1158. 'local-map '(keymap (mode-line keymap (mouse-1 . save-buffer)))))
  1159. (buffer-read-only (propertize sml/read-only-char
  1160. 'face 'sml/read-only
  1161. 'help-echo "Read-Only Buffer"))
  1162. (t (propertize sml/not-modified-char 'face 'sml/not-modified))))
  1163. (defmacro sml/propertize-position (s face help)
  1164. "Propertize string S as a line/column number, using FACE and help-echo HELP."
  1165. `(propertize ,s
  1166. 'face ,face
  1167. 'help-echo ,help
  1168. 'mouse-face 'mode-line-highlight
  1169. 'local-map mode-line-column-line-number-mode-map))
  1170. (defun sml/propertize-time-string ()
  1171. "Function to be added to `display-time-hook' to propertize the string."
  1172. (when (and (boundp 'display-time-string) (stringp display-time-string))
  1173. (setq display-time-string
  1174. (propertize display-time-string
  1175. 'face 'sml/time))))
  1176. (defun sml/filter-mode-line-list (l)
  1177. "Filter some elements of L and propertize the ones not filtered.
  1178. L must be a symbol! We assign right back to it"
  1179. (if (and (symbolp l) (listp (eval l)))
  1180. (set-default l
  1181. (remove nil (mapcar 'sml/parse-mode-line-elements (eval l))))
  1182. (error "l must be a symbol to a list!")))
  1183. (defun sml/fill-for-buffer-identification ()
  1184. "Return a string such that `mode-line-buffer-identification' is fixed-width.
  1185. In buffers where `mode-line-buffer-identification' is nil, we
  1186. don't do any filling. That's because the given mode probably
  1187. doesn't want any buffer-id."
  1188. (if mode-line-buffer-identification
  1189. (propertize
  1190. (make-string (max (- (or (car-safe sml/name-width) sml/name-width)
  1191. (string-width (format-mode-line mode-line-buffer-identification)))
  1192. 0)
  1193. sml/fill-char)
  1194. 'face 'sml/name-filling)
  1195. ""))
  1196. (defun sml/generate-buffer-identification (&rest ignored)
  1197. "Return fully propertized prefix+path+buffername.
  1198. Argument IGNORED is ignored."
  1199. (setq sml/name-width-old sml/name-width)
  1200. (setq sml/buffer-identification-filling nil)
  1201. (when (or ;; Only calculate all this if it will actually be used
  1202. (equal sml/mode-line-buffer-identification mode-line-buffer-identification)
  1203. (and (listp mode-line-buffer-identification)
  1204. (member (cadr sml/mode-line-buffer-identification) mode-line-buffer-identification))
  1205. (member sml/mode-line-buffer-identification mode-line-buffer-identification))
  1206. (setq sml/buffer-identification
  1207. (let* ((dir (sml/replacer (abbreviate-file-name (sml/get-directory))))
  1208. (sml/use-projectile-p (unless (or (not sml/projectile-loaded-p)
  1209. (and (buffer-file-name)
  1210. (file-remote-p (buffer-file-name))))
  1211. sml/use-projectile-p))
  1212. (prefix (sml/get-prefix dir))
  1213. (bufname (sml/buffer-name))
  1214. (dirsize (max 0 (- (abs (or (cdr-safe sml/name-width) sml/name-width))
  1215. (string-width prefix) (string-width bufname))))
  1216. (dirstring (funcall sml/shortener-func dir dirsize)))
  1217. (propertize (concat (sml/propertize-prefix (replace-regexp-in-string "%" "%%" prefix))
  1218. (propertize (replace-regexp-in-string "%" "%%" dirstring) 'face 'sml/folder)
  1219. (propertize (replace-regexp-in-string "%" "%%" bufname) 'face 'sml/filename))
  1220. 'help-echo (format "%s\n\nmouse-1: Previous buffer\nmouse-3: Next buffer"
  1221. (or (buffer-file-name) (buffer-name)))
  1222. 'mouse-face 'mode-line-highlight
  1223. 'local-map mode-line-buffer-identification-keymap)))))
  1224. (defun sml/parse-mode-line-elements (el)
  1225. "Propertize or delete EL.
  1226. To be used in mapcar and accumulate results."
  1227. (cond
  1228. ;; These are implemented separately
  1229. ((member el '("%[" "%]" "%1+" "(" ")" (t erc-modified-channels-object)
  1230. (:eval (if (display-graphic-p) " " "-"))
  1231. (:eval (unless (display-graphic-p) "-%-"))
  1232. (:eval (mode-line-frame-control))))
  1233. nil)
  1234. ((member (car-safe el) '(line-number-mode column-number-mode size-indication-mode current-input-method)) nil)
  1235. ;; mode-line-remote
  1236. ((and (stringp el) (string= el "%1@"))
  1237. `(sml/show-remote
  1238. (:propertize ,el face sml/remote)))
  1239. ;; mode-line-client
  1240. ((equal el '("" (:propertize ("" (:eval (if (frame-parameter nil 'client) "@" "")))
  1241. help-echo "emacsclient frame")))
  1242. `(sml/show-client
  1243. (:eval (if (frame-parameter nil 'client)
  1244. ,(propertize "@" 'face 'sml/client 'help-echo (purecopy "emacsclient frame"))
  1245. " "))))
  1246. ;; mode-line-modified
  1247. ((and (stringp el) (string-match "%[0-9-]*\\*" el))
  1248. '(:eval (sml/generate-modified-status)))
  1249. ;;;; mode-line-position
  1250. ;; Color the position percentage
  1251. ((or (sml/is-%p-p el)
  1252. (and (listp el) (memq 'mode-line-percent-position el)))
  1253. `(sml/position-percentage-format
  1254. (-3 (:propertize (:eval sml/position-percentage-format)
  1255. local-map ,mode-line-column-line-number-mode-map
  1256. mouse-face mode-line-highlight
  1257. face sml/position-percentage
  1258. help-echo "Buffer Relative Position\n\
  1259. mouse-1: Display Line and Column Mode Menu"))))
  1260. ;;;; mode-line-mule-info
  1261. ;; Partially hide some MULE info
  1262. ((and (stringp el) (string-match "\\s-*%[-0-9]*z" el))
  1263. `(sml/mule-info ((1 (:propertize
  1264. (current-input-method
  1265. ("" current-input-method-title)
  1266. " ")
  1267. face sml/mule-info
  1268. help-echo (concat
  1269. ,(purecopy "Current input method: ")
  1270. current-input-method
  1271. ,(purecopy "\n\
  1272. mouse-2: Disable input method\n\
  1273. mouse-3: Describe current input method"))
  1274. local-map ,mode-line-input-method-map
  1275. mouse-face mode-line-highlight))
  1276. (:propertize (:eval sml/mule-info)
  1277. face sml/mule-info
  1278. help-echo mode-line-mule-info-help-echo
  1279. mouse-face mode-line-highlight
  1280. local-map ,mode-line-coding-system-map))))
  1281. ;; Make EOL optional
  1282. ((equal el '(:eval (mode-line-eol-desc)))
  1283. '(sml/show-eol (:eval (mode-line-eol-desc))))
  1284. ;;;; mode-line-modes
  1285. ;; Color the mode line process
  1286. ((or (equal el '("" mode-line-process))
  1287. (equal (car (cdr-safe el)) '("" mode-line-process)))
  1288. '(mode-line-process
  1289. (:eval (let ((text (format-mode-line mode-line-process)))
  1290. (add-face-text-property 0 (length text) 'sml/process t text)
  1291. text))))
  1292. ;; Color the mode name, without changing other properties
  1293. ((and (listp el)
  1294. (equal (car el) :propertize)
  1295. (equal (cadr el) '("" mode-name)))
  1296. (setf (cadr el) '("" "%[" mode-name "%]"))
  1297. (append el '(face sml/modes)))
  1298. ;; Completely replace the minor modes (so we can truncate)
  1299. ((and (listp el)
  1300. (equal (car el) :propertize)
  1301. (equal (cadr el) '("" minor-mode-alist)))
  1302. '(:eval (sml/generate-minor-modes)))
  1303. ;; ;;; Propertize misc-info
  1304. ;; ((memq (car-safe el) '(which-func-mode global-mode-string))
  1305. ;; `(:eval (add-text-properties (format-mode-line ',el))))
  1306. ;; If it's something we don't recognize, just leave it as-is.
  1307. (t el)))
  1308. (defun sml/is-%p-p (x)
  1309. "Non-nil if X matches \"%p\" in a very subjective sense."
  1310. (or (and (listp x)
  1311. (cl-remove-if-not
  1312. (lambda (y) (string-match ".*%p.*" y))
  1313. (cl-remove-if-not #'stringp x)))
  1314. (and (stringp x)
  1315. (string-match ".*%p.*" x))))
  1316. (defun sml/buffer-name ()
  1317. "Return either buffer name or file name to be shown on the mode-line.
  1318. Uses `sml/show-file-name' to decide between the two.
  1319. Unless `sml/show-trailing-N' is nil, prevents the \"<N>\" (used in
  1320. duplicated buffer names) from being displayed."
  1321. (cond ((buffer-base-buffer)
  1322. (buffer-name))
  1323. ((and sml/show-file-name (buffer-file-name))
  1324. (file-name-nondirectory (buffer-file-name)))
  1325. ((derived-mode-p 'dired-mode)
  1326. (file-name-nondirectory (directory-file-name default-directory)))
  1327. (sml/show-trailing-N
  1328. (buffer-name))
  1329. (t (replace-regexp-in-string "<[0-9]+>$" "" (buffer-name)))))
  1330. (defun sml/fill-width-available ()
  1331. "Return the size available for filling."
  1332. (max 0
  1333. (+ sml/extra-filler
  1334. (- (window-total-width)
  1335. (let ((sml/simplified t))
  1336. (string-width (format-mode-line mode-line-format)))))))
  1337. (defconst sml/propertized-shorten-mode-string
  1338. '(:propertize sml/shorten-mode-string
  1339. face sml/minor-modes
  1340. help-echo "mouse-1: Shorten minor modes"
  1341. local-map (keymap (mode-line keymap (mouse-1 . sml/toggle-shorten-modes)))
  1342. mouse-face mode-line-highlight))
  1343. (defconst sml/propertized-full-mode-string
  1344. '(:propertize sml/full-mode-string
  1345. face sml/minor-modes
  1346. help-echo "mouse-1: Show all modes"
  1347. local-map (keymap (mode-line keymap (mouse-1 . sml/toggle-shorten-modes)))
  1348. mouse-face mode-line-highlight))
  1349. (defun sml/count-occurrences-starting-at (regex string start)
  1350. "Count occurrences of REGEX in STRING starting at index START."
  1351. (if (string-match regex string start)
  1352. (+ 1 (sml/count-occurrences-starting-at regex string (match-end 0)))
  1353. 0))
  1354. ;;; Patch, in case the user is using the wrong variable.
  1355. (defvar sml/-hidden-modes-bound-by-user
  1356. (bound-and-true-p sml/hidden-modes))
  1357. (when sml/-hidden-modes-bound-by-user
  1358. (setq sml/-hidden-modes-bound-by-user nil)
  1359. (setq rm-blacklist (bound-and-true-p sml/hidden-modes)))
  1360. (define-obsolete-variable-alias 'sml/hidden-modes 'rm-blacklist)
  1361. (defun sml/generate-minor-modes ()
  1362. "Extracts all rich strings necessary for the minor mode list."
  1363. (if sml/simplified
  1364. ""
  1365. (let* (;; The minor-mode-alist
  1366. (nameList (rm--mode-list-as-string-list))
  1367. ;; The size available
  1368. (size (max 0
  1369. (- (if (member sml/mode-width '(full right))
  1370. ;; Calculate how much width is available
  1371. (sml/fill-width-available)
  1372. ;; or use what the user requested.
  1373. sml/mode-width)
  1374. (string-width (format-mode-line
  1375. 'sml/pre-minor-modes-separator))
  1376. (string-width (format-mode-line
  1377. 'sml/pos-minor-modes-separator)))))
  1378. ;; Used for counting size.
  1379. (finalNameList (mapconcat 'identity nameList ""))
  1380. needs-removing filling)
  1381. ;; Calculate whether truncation is necessary.
  1382. (when (and sml/shorten-modes (> (string-width finalNameList) size))
  1383. ;; We need to remove 1+ "the number of spaces found".
  1384. (setq needs-removing
  1385. (1+
  1386. (sml/count-occurrences-starting-at
  1387. " " finalNameList
  1388. (- size (string-width sml/full-mode-string))))))
  1389. ;; Add truncation string if necessary
  1390. (when needs-removing
  1391. (setcdr (last nameList (1+ needs-removing))
  1392. (list t sml/propertized-full-mode-string)))
  1393. ;; If we're not shortenning, add " -" at the end.
  1394. (unless sml/shorten-modes
  1395. (add-to-list 'nameList sml/propertized-shorten-mode-string t))
  1396. ;; Padding
  1397. (setq filling (- size (string-width (format-mode-line nameList))))
  1398. (setq filling (make-string (max 0 filling) sml/fill-char))
  1399. (if (eq sml/mode-width 'right)
  1400. (list (propertize filling 'face 'sml/modes)
  1401. 'sml/pre-minor-modes-separator nameList
  1402. 'sml/pos-minor-modes-separator)
  1403. (list "" 'sml/pre-minor-modes-separator nameList
  1404. 'sml/pos-minor-modes-separator filling)))))
  1405. (defun sml/propertize-prefix (prefix)
  1406. "Set the color of PREFIX according to its contents."
  1407. (cl-loop for pair in sml/prefix-face-list
  1408. if (let* ((c (car pair))
  1409. (s (if (symbolp c)
  1410. (when (boundp c) (symbol-value c))
  1411. c)))
  1412. (when s
  1413. (string-match (format (regexp-quote s) ".*") prefix)))
  1414. return (propertize prefix 'face (car (cdr pair)))))
  1415. (defun sml/get-directory ()
  1416. "Decide if we want directory shown. If so, return it."
  1417. (abbreviate-file-name
  1418. (cond
  1419. ;; In email attachments, buffer-file-name is non-nil, but
  1420. ;; file-name-directory returns nil
  1421. ((buffer-file-name) (or (file-name-directory (buffer-file-name)) ""))
  1422. ((eq major-mode 'dired-mode)
  1423. (replace-regexp-in-string "/[^/]*/$" "/" default-directory))
  1424. ((and (symbolp major-mode)
  1425. (member major-mode '(shell-mode eshell-mode term-mode)))
  1426. default-directory)
  1427. ;; In indirect buffers, buffer-file-name is nil. The correct value is
  1428. ;; retrieved from the base buffer.
  1429. ((buffer-base-buffer)
  1430. (with-current-buffer (buffer-base-buffer) (sml/get-directory)))
  1431. (t ""))))
  1432. (defun sml/set-battery-font ()
  1433. "Set `sml/battery' face depending on battery state."
  1434. (let ((data (and (boundp 'battery-status-function)
  1435. battery-status-function
  1436. (funcall battery-status-function))))
  1437. (if (string-equal "AC" (cdr (assoc 76 data)))
  1438. (copy-face 'sml/charging 'sml/battery)
  1439. (copy-face 'sml/discharging 'sml/battery))))
  1440. (defadvice battery-update (before sml/set-battery-font activate)
  1441. "Fontify the battery display."
  1442. (sml/set-battery-font))
  1443. (defun sml/replacer (in)
  1444. "Run on string IN the replacements from `sml/replacer-regexp-list'.
  1445. Runs first on the given path, and if that doesn't have any affect,
  1446. runs them again on a version of the given path with all symlinks
  1447. expanded via `file-truename'. If neither run succeeds in making
  1448. any replacements, returns the path originally given.
  1449. Used by `sml/strip-prefix' and `sml/get-prefix'."
  1450. ;; First try replacing on the original path
  1451. (if (string= in "")
  1452. in
  1453. (sml/replacer-raw in)))
  1454. (defcustom sml/fallback-on-buffer-identification nil
  1455. "Whether to fallback on regular buffer-identification.
  1456. Defines the what should be displayed in the buffer identification
  1457. if it is unchanged by the entries in `sml/replacer-regexp-list'.
  1458. If the value is nil, use the sml behaviour (full file name).
  1459. Otherwise, use the default Emacs behaviour (usually just `buffer-name')."
  1460. :type 'boolean)
  1461. (defun sml/replacer-raw (in)
  1462. "Run on the string IN the replacements from `sml/replacer-regexp-list'.
  1463. If projectile is loaded, also performs replacements specified by
  1464. project name first."
  1465. (let ((out in)
  1466. proj)
  1467. ;; Maybe try projectile
  1468. (when (and sml/projectile-loaded-p
  1469. (eq sml/use-projectile-p 'before-prefixes))
  1470. (setq out (sml/perform-projectile-replacement out)))
  1471. ;; Try regular replacements
  1472. (when (string= out in)
  1473. (dolist (cur sml/replacer-regexp-list)
  1474. (setq out (replace-regexp-in-string (car cur) (car (cdr cur)) out))))
  1475. (when (and sml/fallback-on-buffer-identification
  1476. (string= out in))
  1477. (setq out (format-mode-line (propertized-buffer-identification "%12b"))))
  1478. ;; Try truename replacements
  1479. (when (string= out in)
  1480. (let* ((true-in (abbreviate-file-name (if (file-remote-p in)
  1481. in
  1482. (file-truename in))))
  1483. (true-out true-in))
  1484. (dolist (cur sml/replacer-regexp-list)
  1485. (setq true-out (replace-regexp-in-string
  1486. (car cur) (car (cdr cur)) true-out)))
  1487. (unless (string= true-in true-out)
  1488. (setq out true-out))))
  1489. ;; Maybe try projectile later
  1490. (when (and sml/projectile-loaded-p
  1491. (eq sml/use-projectile-p 'after-prefixes)
  1492. (string= out in))
  1493. (setq out (sml/perform-projectile-replacement out)))
  1494. out))
  1495. (declare-function projectile-project-p "projectile")
  1496. (declare-function projectile-project-name "projectile")
  1497. (defun sml/perform-projectile-replacement (in)
  1498. "If path IN is inside a project, use its name as a prefix."
  1499. (let ((proj (projectile-project-p)))
  1500. (if (stringp proj)
  1501. (let* ((replacement
  1502. (format sml/projectile-replacement-format
  1503. (projectile-project-name)))
  1504. (short (replace-regexp-in-string
  1505. (concat "^" (regexp-quote (abbreviate-file-name proj)))
  1506. replacement
  1507. in)))
  1508. (if (string= short in)
  1509. (let* ((true-in (abbreviate-file-name (file-truename in)))
  1510. (true-short
  1511. (replace-regexp-in-string
  1512. (concat "^" (regexp-quote (abbreviate-file-name (file-truename proj))))
  1513. replacement true-in)))
  1514. (if (string= true-in true-short) in true-short))
  1515. short))
  1516. in)))
  1517. (defun sml/regexp-composer (getter)
  1518. "Prepare the actual regexp using `sml/prefix-regexp'.
  1519. If GETTER is non-nil, result regexp also accepts empty match."
  1520. (let ((left "^\\(")
  1521. (right (if getter "\\|\\).*" "\\)")))
  1522. (if (stringp sml/prefix-regexp)
  1523. (if (string-match "\\(" sml/prefix-regexp)
  1524. sml/prefix-regexp
  1525. (concat left sml/prefix-regexp right))
  1526. (concat left (mapconcat 'identity sml/prefix-regexp "\\|") right))))
  1527. (defun sml/strip-prefix (path)
  1528. "Remove prefix from string PATH.
  1529. A prefix is anything at the beginning of the line that matches a
  1530. regexp in `sml/prefix-regexp'."
  1531. (replace-regexp-in-string (sml/regexp-composer nil) "" path))
  1532. (defun sml/get-prefix (path)
  1533. "Get prefix from string PATH.
  1534. A prefix is anything at the beginning of the line that matches a
  1535. regexp in `sml/prefix-regexp'."
  1536. (replace-regexp-in-string (sml/regexp-composer t) "\\1" path))
  1537. (defun sml/not-shorten-directory (dir ml)
  1538. "Return DIR, abbreviated and prefixed.
  1539. ML isn't used."
  1540. (sml/strip-prefix dir))
  1541. (defcustom sml/directory-truncation-string (if (char-displayable-p ?…) "…/" ".../")
  1542. "String used when truncating part of the file path.
  1543. Set this to nil or an empty string if you don't want any
  1544. indication of a truncated path."
  1545. :type 'string
  1546. :group 'smart-mode-line
  1547. :package-version '(smart-mode-line . "2.10"))
  1548. (defun sml/do-shorten-directory (dir max-length)
  1549. "Show up to MAX-LENGTH characters of a directory name DIR."
  1550. (let ((longname (sml/strip-prefix dir)))
  1551. ;; If it fits, return the string.
  1552. (if (<= (string-width longname) max-length) longname
  1553. ;; If it doesn't, shorten it
  1554. (let ((path (reverse (split-string longname "/")))
  1555. (output ""))
  1556. (when (and path (equal "" (car path)))
  1557. (setq path (cdr path)))
  1558. (let ((max (- max-length (string-width sml/directory-truncation-string))))
  1559. ;; Concat as many levels as possible, leaving 4 chars for safety.
  1560. (while (and path (<= (string-width (concat (car path) "/" output))
  1561. max))
  1562. (setq output (concat (car path) "/" output))
  1563. (setq path (cdr path))))
  1564. ;; If we had to shorten, prepend .../
  1565. (when path
  1566. (setq output (concat sml/directory-truncation-string output)))
  1567. output))))
  1568. (provide 'smart-mode-line)
  1569. ;;; smart-mode-line.el ends here