├── .gitignore ├── config-w3m.el ├── describe-variable.el ├── dired-extension.el ├── early-init.el ├── emms-config.el ├── gnus-config.el ├── init-helm.el ├── init.el ├── ledger-config.el ├── mail-config.el ├── org-config.el ├── tv-byzanz.el ├── tv-save-place.el ├── tv-utils.el └── wttr-weather.el /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | locate.db 3 | TAGS 4 | ID 5 | -------------------------------------------------------------------------------- /config-w3m.el: -------------------------------------------------------------------------------- 1 | ;;; .emacs-config-w3m.el -- config w3m for thievol -*- lexical-binding: t -*- 2 | 3 | ;; Code: 4 | 5 | (setq w3m-bookmark-file "~/.w3m/bookmark.html") 6 | 7 | ;; Get icons from melpa directory 8 | (setq w3m-icon-directory (expand-file-name 9 | "icons" 10 | (file-name-directory 11 | (locate-library "w3m")))) 12 | (setq w3m-default-save-directory "~/download/") 13 | 14 | (setq w3m-coding-system 'utf-8 15 | w3m-language "french" 16 | w3m-output-coding-system 'utf-8 17 | w3m-input-coding-system 'utf-8 18 | w3m-terminal-coding-system 'utf-8 19 | w3m-default-display-inline-images nil 20 | ;; Set these variables manually as `w3m-display-mode' is sucking. 21 | w3m-use-tab t 22 | w3m-pop-up-frames nil 23 | w3m-pop-up-windows nil) 24 | 25 | ;; `w3m-bookmark-save-buffer' is backing up bookmark file by renaming, 26 | ;; so that when `w3m-bookmark-file' is a symlink the symlink is 27 | ;; replaced by the file, fix this. 28 | (defun tv:advice--w3m-bookmark-save-buffer () 29 | (cond 30 | ((buffer-file-name) 31 | (basic-save-buffer)) 32 | ((buffer-modified-p) 33 | (when (and (file-exists-p w3m-bookmark-file) 34 | make-backup-files 35 | (funcall backup-enable-predicate w3m-bookmark-file)) 36 | (with-current-buffer (find-file-noselect w3m-bookmark-file) 37 | (backup-buffer) 38 | (kill-buffer))) 39 | (write-region (point-min) (point-max) w3m-bookmark-file nil t) 40 | (kill-buffer)))) 41 | (advice-add 'w3m-bookmark-save-buffer :override #'tv:advice--w3m-bookmark-save-buffer) 42 | 43 | (with-eval-after-load 'w3m-search 44 | (add-to-list 'w3m-search-engine-alist '("DuckDuckGo" "https://duckduckgo.com/lite/?q=%s&kp=1")) 45 | (setq w3m-search-default-engine "DuckDuckGo")) 46 | 47 | (setq w3m-home-page "about:blank") ; "https://www.duckduckgo.com") 48 | 49 | ;; enable-cookies-in-w3m 50 | (setq w3m-use-cookies t) 51 | (setq w3m-cookie-accept-bad-cookies t) 52 | 53 | ;; netscape-vs-firefox 54 | (setq browse-url-netscape-program "firefox") 55 | 56 | ;; Remove-trailing-white-space-in-w3m-buffers 57 | (add-hook 'w3m-display-hook 58 | #'(lambda (url) 59 | (let ((buffer-read-only nil)) 60 | (delete-trailing-whitespace)))) 61 | 62 | (defun tv:w3m-fill-region-or-paragraph () 63 | (interactive) 64 | (let ((inhibit-read-only t)) 65 | (fill-region (point-at-bol) 66 | (save-excursion 67 | (forward-paragraph) (point)) 68 | nil t))) 69 | 70 | (defun tv:advice--w3m-view-this-url (&optional arg new-session) 71 | "Display the page pointed to by the link under point. 72 | If ARG is the number 2 or the list of the number 16 (you may produce 73 | this by typing `C-u' twice) or NEW-SESSION is non-nil and the link is 74 | an anchor, this function makes a copy of the current buffer in advance. 75 | Otherwise, if ARG is non-nil, it forces to reload the url at point." 76 | (interactive (if (member current-prefix-arg '(2 (16))) 77 | (list nil t) 78 | (list current-prefix-arg nil))) 79 | ;; Store the current position in the history structure. 80 | (w3m-history-store-position) 81 | (let ((w3m-prefer-cache 82 | (or w3m-prefer-cache 83 | (and (stringp w3m-current-url) 84 | (string-match "\\`about://\\(?:db-\\)?history/" 85 | w3m-current-url)))) 86 | act url) 87 | (cond 88 | ((setq act (w3m-action)) 89 | (let ((w3m-form-new-session new-session) 90 | (w3m-form-download nil)) 91 | (ignore w3m-form-new-session w3m-form-download) 92 | (eval act))) 93 | ((setq url (w3m-url-valid (w3m-anchor))) 94 | (if new-session 95 | (w3m-goto-url-new-session url arg) 96 | (w3m-goto-url url arg))) 97 | ((w3m-url-valid (w3m-image)) 98 | (if (display-images-p) 99 | (w3m-toggle-inline-image) 100 | (w3m-view-image))) 101 | ((setq url (w3m-active-region-or-url-at-point 'never)) 102 | (unless (eq 'quit (setq url (w3m-input-url nil url 'quit nil 103 | 'feeling-searchy 'no-initial))) 104 | (if new-session 105 | (w3m-goto-url-new-session url arg) 106 | (w3m-goto-url url arg)))) 107 | (t (or (w3m-next-anchor) 108 | (w3m-message "No URL at point")))))) 109 | (advice-add 'w3m-view-this-url :override #'tv:advice--w3m-view-this-url) 110 | 111 | (defun tv:w3m-form-p (obj) 112 | "Return t if OBJ is a form object." 113 | (and (vectorp obj) 114 | (symbolp (aref obj 0)) 115 | (eq (aref obj 0) 'w3m-form-object))) 116 | 117 | (defun tv:w3m-RET () 118 | (interactive) 119 | (if (tv:w3m-form-p (cadr (w3m-action))) 120 | (w3m-view-this-url) 121 | (tv:scroll-down))) 122 | 123 | (provide 'config-w3m) 124 | 125 | ;;; .emacs-config-w3m.el ends here 126 | 127 | 128 | -------------------------------------------------------------------------------- /describe-variable.el: -------------------------------------------------------------------------------- 1 | ;;; describe-variable.el --- Advice describe-variable -*- lexical-binding: t -*- 2 | 3 | ;;; Code: 4 | 5 | (require 'help) 6 | (require 'help-fns) 7 | (require 'pp) 8 | (eval-when-compile (require 'cl-lib)) 9 | 10 | (defvar describe-variable--offset-value 800) 11 | 12 | (defun tv:pp (object &optional stream) 13 | (let ((fn (lambda (ob &optional stream) 14 | (princ (pp-to-string ob) 15 | (or stream standard-output)) 16 | (terpri))) 17 | (print-quoted t) 18 | (print-circle t) 19 | prefix suffix map-fn looping 20 | (standard-output (or stream (current-buffer)))) 21 | (cond ((ring-p object) 22 | (setq looping nil)) 23 | ((consp object) 24 | (setq prefix "\n(" 25 | suffix ")" 26 | map-fn 'mapc 27 | looping t)) 28 | ((vectorp object) 29 | (setq prefix "\n[" 30 | suffix "]" 31 | map-fn 'mapc 32 | looping t)) 33 | ((hash-table-p object) 34 | (setq prefix (format "#s(hash-table size %s test %s rehash-size %s rehash-threshold %s data\n" 35 | (hash-table-size object) 36 | (hash-table-test object) 37 | (hash-table-rehash-size object) 38 | (hash-table-rehash-threshold object)) 39 | suffix ")" 40 | map-fn 'maphash 41 | fn `(lambda (k v &optional stream) 42 | (funcall ,fn k stream) 43 | (funcall ,fn v stream)) 44 | looping t))) 45 | (if looping 46 | (with-current-buffer standard-output 47 | (insert prefix) 48 | (funcall map-fn fn object) 49 | (cl-letf (((point) (1- (point)))) 50 | (insert suffix))) 51 | (funcall fn object stream)))) 52 | 53 | (defun tv:pp-region (beg end &optional sym) 54 | (let ((inhibit-read-only t) 55 | (buf (current-buffer)) 56 | val pp-buf) 57 | (when (and beg end) 58 | (message "Prettifying region...") 59 | (goto-char beg) 60 | (setq val (if sym 61 | (symbol-value sym) 62 | (save-excursion 63 | (with-syntax-table emacs-lisp-mode-syntax-table 64 | (read (current-buffer)))))) 65 | (delete-region beg end) 66 | (with-temp-buffer 67 | (lisp-data-mode) 68 | (tv:pp val (current-buffer)) 69 | (with-syntax-table emacs-lisp-mode-syntax-table 70 | (font-lock-ensure (point-min) (point-max))) 71 | (setq pp-buf (current-buffer)) 72 | (with-current-buffer buf 73 | (save-excursion 74 | (insert-buffer-substring pp-buf)))) 75 | (message "Prettifying region done")))) 76 | 77 | (defun tv:pp-value-in-help () 78 | (interactive) 79 | (let ((inhibit-read-only t) 80 | (sym (save-excursion 81 | (goto-char (point-min)) 82 | (symbol-at-point))) 83 | beg end) 84 | (save-excursion 85 | (goto-char (point-min)) 86 | (when (re-search-forward "^Value: ?$" nil t) 87 | (forward-line 1) 88 | (setq beg (point)) 89 | (setq end (point-max)))) 90 | (tv:pp-region beg end sym))) 91 | 92 | (defun tv:describe-variable (variable &optional buffer frame) 93 | "Optimized `describe-variable' version. 94 | It is based on emacs-28.2 version of `describe-variable'. 95 | Large values are not pretty printed." 96 | (interactive 97 | (let ((v (variable-at-point)) 98 | (enable-recursive-minibuffers t) 99 | (orig-buffer (current-buffer)) 100 | val) 101 | (setq val (completing-read 102 | (format-prompt "Describe variable" (and (symbolp v) v)) 103 | #'help--symbol-completion-table 104 | (lambda (vv) 105 | (or (get vv 'variable-documentation) 106 | (and (not (keywordp vv)) 107 | ;; Since the variable may only exist in the 108 | ;; original buffer, we have to look for it 109 | ;; there. 110 | (buffer-local-boundp vv orig-buffer)))) 111 | t nil nil 112 | (if (symbolp v) (symbol-name v)))) 113 | (list (if (equal val "") 114 | v (intern val))))) 115 | (let (file-name) 116 | (unless (buffer-live-p buffer) (setq buffer (current-buffer))) 117 | (unless (frame-live-p frame) (setq frame (selected-frame))) 118 | (if (not (symbolp variable)) 119 | (user-error "You didn't specify a variable") 120 | (save-excursion 121 | (let ((valvoid (not (with-current-buffer buffer (boundp variable)))) 122 | val val-start-pos locus) 123 | ;; Extract the value before setting up the output buffer, 124 | ;; in case `buffer' *is* the output buffer. 125 | (unless valvoid 126 | (with-selected-frame frame 127 | (with-current-buffer buffer 128 | (setq val (symbol-value variable) 129 | locus (variable-binding-locus variable))))) 130 | (help-setup-xref (list #'describe-variable variable buffer) 131 | (called-interactively-p 'interactive)) 132 | (with-help-window (help-buffer) 133 | (with-current-buffer buffer 134 | (prin1 variable) 135 | (setq file-name (find-lisp-object-file-name variable 'defvar)) 136 | 137 | (princ (if file-name 138 | (progn 139 | (princ (format-message 140 | " is a variable defined in `%s'.\n\n" 141 | (if (eq file-name 'C-source) 142 | "C source code" 143 | (help-fns-short-filename file-name)))) 144 | (with-current-buffer standard-output 145 | (setq help-mode--current-data 146 | (list :symbol variable 147 | :type (if (eq file-name 'C-source) 148 | 'variable 149 | 'defvar) 150 | :file file-name)) 151 | (save-excursion 152 | (re-search-backward (substitute-command-keys 153 | "`\\([^`']+\\)'") 154 | nil t) 155 | (help-xref-button 1 'help-variable-def 156 | variable file-name))) 157 | (if valvoid 158 | "It is void as a variable." 159 | "Its ")) 160 | (with-current-buffer standard-output 161 | (setq help-mode--current-data (list :symbol variable 162 | :type 'variable))) 163 | (if valvoid 164 | " is void as a variable." 165 | (substitute-command-keys "'s "))))) 166 | (unless valvoid 167 | (with-current-buffer standard-output 168 | (setq val-start-pos (point)) 169 | (princ "value is") 170 | (let ((line-beg (line-beginning-position)) 171 | (print-rep 172 | (let ((rep 173 | (let ((print-quoted t) 174 | (print-circle t)) 175 | (cl-prin1-to-string val)))) 176 | (if (and (symbolp val) (not (booleanp val))) 177 | (format-message "`%s'" rep) 178 | rep)))) 179 | (if (< (+ (length print-rep) (point) (- line-beg)) 68) 180 | (insert " " print-rep) 181 | (terpri) 182 | (let ((buf (current-buffer))) 183 | (with-temp-buffer 184 | (lisp-mode-variables nil) 185 | (set-syntax-table emacs-lisp-mode-syntax-table) 186 | (insert print-rep) 187 | (unless (> (- (point-max) (point-min)) describe-variable--offset-value) 188 | (pp-buffer)) 189 | (let ((pp-buffer (current-buffer))) 190 | (with-current-buffer buf 191 | (insert-buffer-substring pp-buffer))))) 192 | ;; Remove trailing newline. 193 | (and (= (char-before) ?\n) (delete-char -1))) 194 | (let* ((sv (get variable 'standard-value)) 195 | (origval (and (consp sv) 196 | (condition-case nil 197 | (eval (car sv) t) 198 | (error :help-eval-error)))) 199 | from) 200 | (when (and (consp sv) 201 | (not (equal origval val)) 202 | (not (equal origval :help-eval-error))) 203 | (princ "\nOriginal value was \n") 204 | (setq from (point)) 205 | (if (and (symbolp origval) (not (booleanp origval))) 206 | (let* ((rep (cl-prin1-to-string origval)) 207 | (print-rep (format-message "`%s'" rep))) 208 | (insert print-rep)) 209 | (cl-prin1 origval)) 210 | (save-restriction 211 | (narrow-to-region from (point)) 212 | (unless (> (- (point) from) describe-variable--offset-value) 213 | (save-excursion (pp-buffer)))) 214 | (if (< (point) (+ from 20)) 215 | (delete-region (1- from) from))))))) 216 | (terpri) 217 | (when locus 218 | (cond 219 | ((bufferp locus) 220 | (princ (format "Local in buffer %s; " 221 | (buffer-name buffer)))) 222 | ((terminal-live-p locus) 223 | (princ "It is a terminal-local variable; ")) 224 | (t 225 | (princ (format "It is local to %S" locus)))) 226 | (if (not (default-boundp variable)) 227 | (princ "globally void") 228 | (let ((global-val (default-value variable))) 229 | (with-current-buffer standard-output 230 | (princ "global value is ") 231 | (if (eq val global-val) 232 | (princ "the same.") 233 | (terpri) 234 | ;; FIXED: 235 | ;; Fixme: pp can take an age if you happen to 236 | ;; ask for a very large expression. We should 237 | ;; probably print it raw once and check it's a 238 | ;; sensible size before prettyprinting. -- fx 239 | (let ((from (point))) 240 | (cl-prin1 global-val) 241 | (save-restriction 242 | (narrow-to-region from (point)) 243 | (unless (> (- (point) from) describe-variable--offset-value) 244 | (save-excursion (pp-buffer)))) 245 | ;; See previous comment for this function. 246 | ;; (help-xref-on-pp from (point)) 247 | (if (< (point) (+ from 20)) 248 | (delete-region (1- from) from))))))) 249 | (terpri)) 250 | 251 | ;; If the value is large, move it to the end. 252 | (with-current-buffer standard-output 253 | (when (or (> (- (point-max) (point-min)) describe-variable--offset-value) 254 | (> (count-lines (point-min) (point-max)) 10)) 255 | ;; Note that setting the syntax table like below 256 | ;; makes forward-sexp move over a `'s' at the end 257 | ;; of a symbol. 258 | (set-syntax-table emacs-lisp-mode-syntax-table) 259 | (goto-char val-start-pos) 260 | (when (looking-at "value is") (replace-match "")) 261 | (save-excursion 262 | (insert "\n\nValue:") 263 | (setq-local help-button-cache (point-marker))) 264 | (insert "value is shown ") 265 | (insert-button "below" 266 | 'action help-button-cache 267 | 'follow-link t 268 | 'help-echo "mouse-2, RET: show value") 269 | (insert ".\n"))) 270 | (terpri) 271 | 272 | (let* ((alias (condition-case nil 273 | (indirect-variable variable) 274 | (error variable))) 275 | (doc (or (documentation-property 276 | variable 'variable-documentation) 277 | (documentation-property 278 | alias 'variable-documentation)))) 279 | 280 | (with-current-buffer standard-output 281 | (insert (or doc "Not documented as a variable."))) 282 | 283 | ;; Output the indented administrative bits. 284 | (with-current-buffer buffer 285 | (help-fns--run-describe-functions 286 | help-fns-describe-variable-functions variable)) 287 | 288 | (with-current-buffer standard-output 289 | ;; If we have the long value of the variable at the 290 | ;; end, remove superfluous empty lines before it. 291 | (unless (eobp) 292 | (while (looking-at-p "\n") 293 | (delete-char 1))))) 294 | 295 | (with-current-buffer standard-output 296 | ;; Return the text we displayed. 297 | (buffer-string)))))))) 298 | 299 | 300 | (advice-add 'describe-variable :override #'tv:describe-variable) 301 | 302 | (provide 'describe-variable) 303 | 304 | ;; Local Variables: 305 | ;; byte-compile-warnings: (not obsolete) 306 | ;; indent-tabs-mode: nil 307 | ;; End: 308 | 309 | ;;; describe-variable.el ends here 310 | -------------------------------------------------------------------------------- /dired-extension.el: -------------------------------------------------------------------------------- 1 | ;;; dired-extension.el -- improvements for dired -*- lexical-binding: t -*- 2 | 3 | ; $Id: dired-extension.el,v 1.36 2010/05/30 07:03:33 thierry Exp thierry $ 4 | 5 | ;;; Code: 6 | (require 'dired) 7 | (require 'cl-lib) 8 | 9 | ;;; Dired config 10 | 11 | (setq dired-font-lock-keywords 12 | (list 13 | ;; Marked files. 14 | ;; Allow copy/rename/sym/hard files to be marked also. 15 | (list ;(concat "^[" (char-to-string dired-marker-char) "]") 16 | (concat "^\\([^ " (char-to-string dired-del-marker) "]\\)") 17 | '(".+" nil nil (0 dired-marked-face))) ; Don't jump to filename to mark whole line. 18 | 19 | ;; Flagged files. 20 | (list (concat "^[" (char-to-string dired-del-marker) "]") 21 | '(".+" (dired-move-to-filename) nil (0 dired-flagged-face))) 22 | 23 | ;; Symbolic links. 24 | (list dired-re-sym ;"\\([^ ]+\\) -> [^ ]+$" 25 | '(".+" (dired-move-to-filename) nil (0 dired-symlink-face))) 26 | 27 | ;; Flagged files or not yet saved (.# or #.#) 28 | (list "\\(^..*-\\).*\\( [0-9:]* \\)\\(\.?#.*#?\\)$" '(3 dired-symlink-face)) 29 | 30 | ;; Directory headers. 31 | (list dired-subdir-regexp '(1 dired-header-face)) 32 | 33 | ;; Size used in dir (second line). 34 | (list "^..\\([a-zA-Z ]*\\)\\([0-9.,]+[kKMGTPEZY]?\\)\\( [a-zA-Z]*\\)?\\( [0-9.,]+[kKMGTPEZY]?\\)?" '(2 '((:foreground "cyan")))) 35 | 36 | ;; Dired marks. (C,D, etc... at beginning of line) 37 | (list dired-re-mark '(0 dired-mark-face)) 38 | 39 | ;; Match from beginning of line to filename. 40 | (list "^..\\([drwxslt-]*\\) *\\([0-9]*\\) *\\([a-z ]*\\) *\\([0-9.,]*[kKMGTPEZY]?\\)\\( *[ 0-9a-zA-Z-éèû.]* [0-9:]*[ 0-9:]* \\)" 41 | '(1 '((:foreground "IndianRed")))) 42 | (list "^..\\([drwxslt-]*\\) *\\([0-9]*\\) *\\([a-z ]*\\) *\\([0-9.,]*[kKMGTPEZY]?\\)\\( *[ 0-9a-zA-Z-éèû.]* [0-9:]*[ 0-9:]* \\)" 43 | '(2 '((:foreground "cyan")))) 44 | (list "^..\\([drwxslt-]*\\) *\\([0-9]*\\) *\\([a-z ]*\\) *\\([0-9.,]*[kKMGTPEZY]?\\)\\( *[ 0-9a-zA-Z-éèû.]* [0-9:]*[ 0-9:]* \\)" 45 | '(3 '((:foreground "ForestGreen")))) 46 | (list "^..\\([drwxslt-]*\\) *\\([0-9]*\\) *\\([a-z ]*\\) *\\([0-9.,]*[kKMGTPEZY]?\\)\\( *[ 0-9a-zA-Z-éèû.]* [0-9:]*[ 0-9:]* \\)" 47 | '(4 '((:foreground "cyan")))) 48 | (list "^..\\([drwxslt-]*\\) *\\([0-9]*\\) *\\([a-z ]*\\) *\\([0-9.,]*[kKMGTPEZY]?\\)\\( *[ 0-9a-zA-Z-éèû.]* [0-9:]*[ 0-9:]* \\)" 49 | '(5 '((:foreground "Gold")))) 50 | 51 | ;; We make heavy use of MATCH-ANCHORED, since the regexps don't identify the 52 | ;; file name itself. We search for Dired defined regexps, and then use the 53 | ;; Dired defined function `dired-move-to-filename' before searching for the 54 | ;; simple regexp ".+". It is that regexp which matches the file name. 55 | 56 | ;; Subdirectories. 57 | (list dired-re-dir 58 | '(".+" (dired-move-to-filename) nil (0 dired-directory-face))) 59 | 60 | ;; Files suffixed with `completion-ignored-extensions'. 61 | '(eval . 62 | ;; It is quicker to first find just an extension, then go back to the 63 | ;; start of that file name. So we do this complex MATCH-ANCHORED form. 64 | (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$") 65 | '(".+" (dired-move-to-filename) nil (0 dired-ignored-face)))) 66 | ;; plus a character put in by -F. 67 | '(eval . 68 | (list (concat "\\(" (regexp-opt completion-ignored-extensions) 69 | "\\|#\\)[*=|]$") 70 | '(".+" (progn 71 | (end-of-line) 72 | ;; If the last character is not part of the filename, 73 | ;; move back to the start of the filename 74 | ;; so it can be fontified. 75 | ;; Otherwise, leave point at the end of the line; 76 | ;; that way, nothing is fontified. 77 | (unless (get-text-property (1- (point)) 'mouse-face) 78 | (dired-move-to-filename))) 79 | nil (0 dired-ignored-face)))) 80 | 81 | ;; Regular file names. 82 | (list "\\(^..*-\\).*\\( [0-9:]* \\)\\(.*\\)$" 83 | '(".+" (dired-move-to-filename) nil (0 '((:foreground "Dodgerblue3"))))) 84 | 85 | 86 | ;; Filenames extensions. 87 | ;(list "[^ .]\\.\\([a-zA-Z]*\\)[*]?$" '(1 '((:foreground "purple")) t)) 88 | (list "[^ .]\\.\\([a-zA-Z]*\\)$" '(1 '((:foreground "purple")) t)) 89 | ;(list "[^ .]\\.\\([^. /]+\\)$" '(1 '((:foreground "purple")) t)) 90 | 91 | ;; Executable flags (Use C-u s) 92 | (list "[^ .]\\([*]?$\\)" '(1 '((:foreground "red")) t)) 93 | 94 | ;; Compressed filenames extensions. 95 | (list "[^ .]\\.\\([tz7]?[bgi]?[pzZ]2?\\)[*]?$" '(1 '((:foreground "yellow")) t)) 96 | 97 | ;; Total available size (second line), not used by tramp so put it after all. 98 | (list "^..\\([a-zA-Z ]*\\)\\([0-9.,]+[kKMGTPEZY]?\\)\\( [a-zA-Z]*\\)?\\( [0-9.,]+[kKMGTPEZY]?\\)?" '(4 '((:foreground "cyan")) t)) 99 | 100 | ;; Files that are group or world writable. 101 | (list (concat dired-re-maybe-mark dired-re-inode-size 102 | "\\([-d]\\(....w....\\|.......w.\\)\\)") 103 | '(1 dired-warning-face) 104 | '(".+" (dired-move-to-filename) nil (0 dired-warning-face))) 105 | 106 | ;; Explicitly put the default face on file names ending in a colon to 107 | ;; avoid fontifying them as directory header. 108 | (list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$") 109 | '(".+" (dired-move-to-filename) nil (0 'default))))) 110 | 111 | 112 | ;;; showup size available when -h arg of ls used. 113 | 114 | (defun tv:-advice-get-free-disk-space (dir) 115 | (unless (file-remote-p (expand-file-name dir)) 116 | (save-match-data 117 | ;; That is for windows. 118 | (if (fboundp 'file-system-info) 119 | (let ((fsinfo (file-system-info dir))) 120 | (if fsinfo 121 | (format "%.0f" (/ (nth 2 fsinfo) 1024)))) 122 | ;; And this is for Linux. 123 | (when (executable-find directory-free-space-program) 124 | (cl-getf (tv:get-disk-info dir 'human) :available)))))) 125 | 126 | (defun tv:get-disk-info (directory &optional human) 127 | (let* ((directory-free-space-args 128 | (if (and dired-actual-switches 129 | (string-match "h" dired-actual-switches)) 130 | (concat directory-free-space-args "h") 131 | directory-free-space-args)) 132 | (default-directory (expand-file-name directory)) 133 | (dir (or (file-remote-p default-directory 'localname) 134 | default-directory)) 135 | (args (if human 136 | (concat directory-free-space-args "h") 137 | directory-free-space-args)) 138 | (data (with-temp-buffer 139 | (process-file directory-free-space-program 140 | nil t nil args dir) 141 | (split-string (buffer-string) "\n" t))) 142 | (values (split-string (cadr data)))) 143 | (cl-loop for i in '(:device :blocks :used :available :capacity :mount-point) 144 | for j in values 145 | append (list i j)))) 146 | 147 | (when (< emacs-major-version 27) 148 | (advice-add 'get-free-disk-space :override 'tv:-advice-get-free-disk-space)) 149 | 150 | 151 | (provide 'dired-extension) 152 | 153 | ;; Local Variables: 154 | ;; byte-compile-warnings: (not cl-functions obsolete) 155 | ;; End: 156 | 157 | ;;; dired-extension.el ends here 158 | -------------------------------------------------------------------------------- /early-init.el: -------------------------------------------------------------------------------- 1 | ;;; early-init.el --- evaluated before init.el -*- lexical-binding: t -*- 2 | 3 | (when (and (fboundp 'native-comp-available-p) 4 | (native-comp-available-p)) 5 | (setq native-comp-deferred-compilation t 6 | native-comp-async-query-on-exit t 7 | native-comp-async-jobs-number 4 8 | native-comp-async-report-warnings-errors 'silent)) 9 | 10 | (advice-add 'emacs-repository-get-version :override #'ignore) 11 | (advice-add 'emacs-repository-get-branch :override #'ignore) 12 | (add-hook 'after-init-hook (lambda () 13 | (advice-remove 'emacs-repository-get-version #'ignore) 14 | (advice-remove 'emacs-repository-get-branch #'ignore))) 15 | 16 | (setq inhibit-startup-echo-area-message "thierry") 17 | 18 | (setq package-archives '(("melpa" . "https://melpa.org/packages/") 19 | ("gnu" . "https://elpa.gnu.org/packages/") 20 | ("nongnu" . "https://elpa.nongnu.org/nongnu/"))) 21 | (setq package-load-list '(all)) 22 | ;; (setq package-load-list '((helm nil) (helm-core nil) (async nil) (wfnames nil) all)) 23 | -------------------------------------------------------------------------------- /emms-config.el: -------------------------------------------------------------------------------- 1 | ;;; emms-config.el --- emms config. -*- lexical-binding: t -*- 2 | 3 | ;;; Code: 4 | 5 | (setq emms-score-file "~/.emacs.d/emms/scores") 6 | (setq emms-stream-bookmarks-file "~/.emacs.d/emms/emms-streams") 7 | (setq emms-history-file "~/.emacs.d/emms/emms-history") 8 | (setq emms-cache-file "~/.emacs.d/emms/emms-cache") 9 | (setq emms-source-file-default-directory "/home/thierry/Musique") 10 | 11 | ;; Needed when installing from source. 12 | (require 'emms-auto nil t) 13 | 14 | ;; Add lexbind cookie to emms-cache to shutup warnings in emacs-31. 15 | (with-eval-after-load 'emms-cache 16 | (defun tv:advice-emms-cache-save (old--fn) 17 | (let ((header (concat ";;; .emms-cache -*- mode: emacs-lisp; coding: " 18 | (symbol-name emms-cache-file-coding-system) 19 | "; lexical-binding: t -*-\n"))) 20 | (funcall old--fn) 21 | (with-current-buffer (find-file-noselect emms-cache-file) 22 | (goto-char (point-min)) 23 | (delete-region (point) (pos-eol)) 24 | (insert header) 25 | (save-buffer) 26 | (kill-buffer)))) 27 | (advice-add 'emms-cache-save :around #'tv:advice-emms-cache-save)) 28 | 29 | (emms-all) 30 | 31 | ;; Setup `emms-player-list'. 32 | (setq emms-player-list '(emms-player-mpv emms-player-vlc emms-player-vlc-playlist)) 33 | ;; (emms-default-players) 34 | 35 | (setq emms-player-mpv-parameters 36 | ;; "--no-video" for mp4's. 37 | '("--no-video" "--no-terminal" "--force-window=no" "--audio-display=no")) 38 | 39 | ;; «enable-emms-scoring» (to ".enable-emms-scoring") 40 | (setq emms-score-enabled-p t) 41 | 42 | ;; «Start-browser-with-album» (to ".Start-browser-with-album") 43 | (setq emms-browser-default-browse-type 'info-album) 44 | 45 | ;; «default-action-for-bookmark-streams» (to ".default-action-for-bookmark-streams") 46 | (setq emms-stream-default-action "play") 47 | 48 | (add-to-list 'emms-info-functions 'emms-info-mp3info) 49 | (setq emms-browser-default-covers '("~/.emacs.d/emms/cover_small.jpg")) 50 | 51 | ;; «Mode-line» (to ".Mode-line") 52 | (setq emms-mode-line-icon-color "Gold1") 53 | (setq emms-mode-line-icon-before-format "[") 54 | (setq emms-mode-line-format " `%s'") 55 | (setq emms-playing-time-display-format " %s] ") 56 | (defun emms-mode-line-playlist-current () 57 | "Format the currently playing song." 58 | (let* ((track (emms-playlist-current-selected-track)) 59 | (cur-track (emms-track-description track)) 60 | (all (emms-info-track-description (emms-playlist-current-selected-track)))) 61 | (format emms-mode-line-format 62 | (propertize (truncate-string-to-width cur-track 20 nil nil "⃨") 63 | 'face 'font-lock-type-face 64 | 'help-echo all)))) 65 | 66 | (defun tv:emms-mode-line-icon-function () 67 | (let* ((pls (emms-mode-line-playlist-current)) 68 | (icon (if (string-match "\\` *[`]http://" pls) "📻" "🎵"))) 69 | (concat " " emms-mode-line-icon-before-format icon pls))) 70 | 71 | (setq emms-mode-line-mode-line-function 'tv:emms-mode-line-icon-function) 72 | 73 | (emms-mode-line 1) 74 | 75 | (defun tv:emms-volume--pulse-get-volume () 76 | (with-temp-buffer 77 | (call-process "pactl" nil t nil "list" "sinks") 78 | (goto-char (point-min)) 79 | (when (re-search-forward "^[\t ]*Volume.?:.*/ *\\([0-9]*\\)% */" nil t) 80 | (string-to-number (match-string 1))))) 81 | (advice-add 'emms-volume--pulse-get-volume :override #'tv:emms-volume--pulse-get-volume) 82 | (setq emms-volume-change-function #'emms-volume-pulse-change) 83 | 84 | ;; «Bindings» (to ".Bindings") 85 | 86 | (global-set-key (kbd " r") 'emms-streams) 87 | (helm-define-key-with-subkeys 88 | global-map (kbd " +") 89 | ?+ 'emms-volume-raise '((?- . emms-volume-lower))) 90 | (helm-define-key-with-subkeys 91 | global-map (kbd " -") 92 | ?- 'emms-volume-lower '((?+ . emms-volume-raise))) 93 | (global-set-key (kbd " b") 'emms-smart-browse) 94 | (global-set-key (kbd " s") 'emms-stop) 95 | (global-set-key (kbd " RET")'emms-start) 96 | (global-set-key (kbd " c") 'emms-browser-clear-playlist) 97 | (global-set-key (kbd " p") 'emms-pause) 98 | (global-set-key (kbd " >") 'emms-next) 99 | (global-set-key (kbd " <") 'emms-previous) 100 | (global-set-key (kbd " m") 'emms-mode-line-toggle) 101 | 102 | ;; «Update-mpd-directory» (to ".Update-mpd-directory") 103 | 104 | (defun tv:emms-update-and-clean-cache () 105 | (interactive) 106 | (when emms-cache-db 107 | (clrhash emms-cache-db) 108 | (and (file-exists-p emms-cache-file) 109 | (delete-file emms-cache-file)) 110 | (and (file-exists-p emms-history-file) 111 | (delete-file emms-history-file)) 112 | (with-current-buffer (find-file-noselect emms-cache-file) 113 | (save-buffer)) 114 | (emms-add-directory-tree "~/Musique/"))) 115 | 116 | 117 | (defun tv:emms-track-simple-description (track) 118 | "Simple function to give a user-readable description of a track. 119 | If it's a file track, just return the file name. Otherwise, 120 | return the type and the name with a colon in between. 121 | Hex-encoded characters in URLs are replaced by the decoded 122 | character." 123 | (let ((type (emms-track-type track))) 124 | (cond ((eq 'file type) 125 | (file-name-sans-extension 126 | (file-name-nondirectory (emms-track-name track)))) 127 | ((eq 'url type) 128 | (emms-format-url-track-name (emms-track-name track))) 129 | (t (concat (symbol-name type) 130 | ": " (emms-track-name track)))))) 131 | (setq emms-track-description-function 'tv:emms-track-simple-description) 132 | 133 | ;; Switch to xfce presentation mode 134 | (defun tv:emms-xfce-presentation-mode-1 (val) 135 | (call-process "xfconf-query" nil nil nil 136 | "xfconf-query" "-c" "xfce4-power-manager" 137 | "-p" "/xfce4-power-manager/presentation-mode" 138 | "-s" val)) 139 | 140 | (defun tv:emms-player-start-hook () 141 | (tv:emms-xfce-presentation-mode-1 "true")) 142 | 143 | (defun tv:emms-player-stop-hook () 144 | (tv:emms-xfce-presentation-mode-1 "false")) 145 | 146 | (add-hook 'emms-player-started-hook 'tv:emms-player-start-hook) 147 | (add-hook 'emms-player-stopped-hook 'tv:emms-player-stop-hook) 148 | (add-hook 'emms-player-finished-hook 'tv:emms-player-stop-hook) 149 | 150 | ;; Fix error: 151 | ;; emms-info-native error processing 152 | ;; http://europe1.lmn.fm/europe1.mp3: 153 | ;; (file-missing Opening input file Aucun fichier ou dossier de ce nom /home/thierry/.emacs.d/emacs-config/http:/europe1.lmn.fm/europe1.mp3) 154 | (defun tv:advice-emms-info-native--find-stream-type (filename) 155 | (unless (string-match-p "\\`http" filename) 156 | (pcase (file-name-extension filename) 157 | ("ogg" 'vorbis) 158 | ("opus" 'opus) 159 | ("flac" 'flac) 160 | ("mp3" 'mp3) 161 | ("spc" 'spc) 162 | (_ nil)))) 163 | (advice-add 'emms-info-native--find-stream-type :override #'tv:advice-emms-info-native--find-stream-type) 164 | 165 | (provide 'emms-config) 166 | 167 | ;;; emms-config.el ends here 168 | -------------------------------------------------------------------------------- /gnus-config.el: -------------------------------------------------------------------------------- 1 | ;;; gnus-config.el --- Gnus init file -*- lexical-binding: t -*- 2 | 3 | ;; Set `gnus-init-file' to the path of this file in init.el before 4 | ;; calling `gnus'. 5 | 6 | ;;; Code: 7 | 8 | ;; Specify mail-config path to use gnus in helm.sh (need to symlink 9 | ;; gnus-config to ~/.gnus as well). 10 | (require 'mail-config "~/elisp/emacs-config/mail-config.el") 11 | 12 | (with-eval-after-load 'gnus-sum 13 | (define-key gnus-summary-mode-map [remap gnus-summary-save-parts] 'tv:gnus-save-mime-parts) 14 | (define-key gnus-summary-mode-map (kbd "M-q") 'gnus-article-fill-long-lines) 15 | (define-key gnus-summary-mode-map (kbd "N") 'gnus-summary-next-unread-article) 16 | (define-key gnus-summary-mode-map (kbd "n") 'gnus-summary-next-article) 17 | (define-key gnus-summary-mode-map (kbd "p") 'gnus-summary-prev-article)) 18 | 19 | ;; Don't read/write to the .newrc file, go straight to the *.eld. 20 | (setq gnus-save-newsrc-file nil 21 | gnus-read-newsrc-file nil) 22 | 23 | (setq gnus-read-active-file 'some) 24 | (setq gnus-check-new-newsgroups 'ask-server) 25 | ;; Allow followup to news from Gmane. 26 | (setq gnus-mailing-list-groups "^gmane") 27 | 28 | ;;; Gnus methods 29 | ;; 30 | ;; 31 | ;; Three methods described here to use Emails with Gnus: 32 | 33 | ;; 1) This is the configuration using dovecot server. 34 | ;; Need dovecot imap package installed, add this line to 35 | ;; /etc/dovecot/conf.d/10-mail.conf: 36 | ;; mail_location = maildir:~/Maildir:LAYOUT=fs 37 | ;; Need also offlineimap to feed ~/Maildir. 38 | 39 | ;; (setq gnus-select-method 40 | ;; '(nnimap "Posteo" 41 | ;; (nnimap-address "localhost") 42 | ;; (nnimap-stream network) 43 | ;; (nnimap-authenticator login))) 44 | 45 | (setq gnus-select-method '(nntp "news.gmane.io")) 46 | 47 | ;; 2) The nnmaildir config: Use offlineimap to feed ~/.nnmaildir 48 | ;; The ~/.offlineimaprc used by offlineimap command should point to 49 | ;; ~/.nnmaildir. Looks nice but too slow to be used. 50 | ;; (setq gnus-select-method '(nnmaildir "Posteo" (directory "~/.nnmaildir"))) 51 | 52 | ;; 3) the online method with nnimap (no mails offline but they can be 53 | ;; cached with gnus-agent): 54 | 55 | ;; Secondary methods are mails and possibly other nntp servers. 56 | (setq gnus-secondary-select-methods '(;; Add as many mail account as needed with a label. 57 | ;; Add then an entry in .authinfo: 58 | ;; machine label port xxx login xxx password xxx 59 | (nnimap "posteo" ; Label for reference in .authinfo for machine name. 60 | (nnimap-address "posteo.de") 61 | ;; Don't download mime parts when receiving mail, only text part, use 62 | ;; instead `A-C' to see entire mail. 63 | (nnimap-fetch-partial-articles "text/")))) 64 | ;; Gnus topic 65 | (with-eval-after-load 'gnus-topic 66 | (progn 67 | (setq gnus-topic-topology '(("Gnus" visible) 68 | (("posteo" visible nil nil)) 69 | (("gmane" visible)) 70 | (("misc" visible)))) 71 | (setq gnus-topic-alist '(("posteo" 72 | "nnimap+posteo:INBOX" 73 | "nnimap+posteo:github-helm" 74 | "nnimap+posteo:Emacs-bug" 75 | "nnimap+posteo:Emacs-devel" 76 | "nnimap+posteo:github-async" 77 | "nnimap+posteo:Fortuneo" 78 | "nnimap+posteo:Pub" 79 | "nnimap+posteo:Sent" 80 | "nnimap+posteo:Spam" 81 | "nnimap+posteo:Spam-Log" 82 | "nnimap+posteo:Trash" 83 | "nnimap+posteo:github-magit" 84 | "nnimap+posteo:github-mu") 85 | ("gmane" 86 | "gmane.emacs.bugs" 87 | "gmane.emacs.devel" 88 | "gmane.emacs.elpa.scm") 89 | ("misc") 90 | ("Gnus" 91 | "nnfolder+archive:sent"))))) 92 | (add-hook 'gnus-group-mode-hook 'gnus-topic-mode) 93 | 94 | (setq gnus-ignored-from-addresses "thievol@posteo\\.net") 95 | (setq gnus-thread-sort-functions '((not gnus-thread-sort-by-number))) 96 | 97 | ;; Change "From" field according to "To" field on reply. 98 | (setq gnus-posting-styles 99 | '(((header "from" "thievol@posteo\\.net") 100 | (name "Thierry Volpiatto") 101 | (gcc "thievol@posteo.net") 102 | (address "thievol@posteo.net") 103 | (signature-file "~/.signature")))) 104 | 105 | ;; To add a mail account: 106 | ;; 107 | ;; 1) Add an nnimap entry in `gnus-secondary-select-methods'. 108 | ;; 2) Add an entry in `gnus-posting-styles' 109 | ;; 3) Add an entry in `tv-smtp-accounts' 110 | ;; 4) Add entries in authinfo for imap and smtp refering to labels. (See below) 111 | 112 | (defvar tv-smtp-accounts 113 | '(("thievol@posteo.net" 114 | (:server "posteo.de" 115 | :port 587 116 | :name "Thierry Volpiatto")))) 117 | 118 | (defun tv-change-smtp-server () 119 | "Use account found in `tv-smtp-accounts' according to from header. 120 | `from' is set in `gnus-posting-styles' according to `to' header. 121 | or manually with `tv-send-mail-with-account'. 122 | This will run in `message-send-hook'." 123 | (save-excursion 124 | (save-restriction 125 | (message-narrow-to-headers) 126 | (let* ((from (message-fetch-field "from")) 127 | (user-account (cl-loop for account in tv-smtp-accounts thereis 128 | (and (string-match (car account) from) 129 | account))) 130 | (server (cl-getf (cadr user-account) :server)) 131 | (port (cl-getf (cadr user-account) :port)) 132 | (user (car user-account))) 133 | (setq smtpmail-smtp-user user 134 | smtpmail-default-smtp-server server 135 | smtpmail-smtp-server server 136 | smtpmail-smtp-service port))))) 137 | 138 | (add-hook 'message-send-hook 'tv-change-smtp-server) 139 | 140 | (defun tv-send-mail-with-account () 141 | "Change mail account manually to send this mail." 142 | (interactive) 143 | (save-excursion 144 | (let* ((from (save-restriction 145 | (message-narrow-to-headers) 146 | (message-fetch-field "from"))) 147 | (mail (completing-read 148 | "Use account: " 149 | (mapcar 'car tv-smtp-accounts))) 150 | (name (cl-getf (cadr (assoc mail tv-smtp-accounts)) :name)) 151 | (new-from (message-make-from name mail))) 152 | (message-goto-from) 153 | (forward-line 0) 154 | (re-search-forward ": " (point-at-eol)) 155 | (delete-region (point) (point-at-eol)) 156 | (insert new-from)))) 157 | (define-key message-mode-map (kbd "C-c p") 'tv-send-mail-with-account) 158 | 159 | ;; Nnml mail directory 160 | (setq nnml-directory "~/Mail") 161 | 162 | ;;; Archivage des mails envoyés 163 | ;; 164 | (setq gnus-message-archive-group "sent") 165 | 166 | ;;; Show all these headers 167 | ;; 168 | ;; 169 | (setq gnus-visible-headers 170 | '("^From:" 171 | "^Newsgroups:" 172 | "^Subject:" 173 | "^Date:" 174 | "^Followup-To:" 175 | "^Reply-To:" 176 | "^Organization:" 177 | "^Summary:" 178 | "^Keywords:" 179 | "^To:" 180 | "^[BGF]?Cc:" 181 | "^Posted-To:" 182 | "^Mail-Copies-To:" 183 | "^Apparently-To:" 184 | "^X-Gnus-Warning:" 185 | "^Resent-From:" 186 | "^X-Sent:" 187 | "^X-Mailer:" 188 | "^X-Newsreader:" 189 | "^X-User-Agent:" 190 | "^User-Agent:")) 191 | 192 | ;;; Order of headers 193 | ;; 194 | ;; 195 | (setq gnus-sorted-header-list '("^From:" 196 | "^Subject:" 197 | "^Summary:" 198 | "^Keywords:" 199 | "^Newsgroups:" 200 | "^Followup-To:" 201 | "^To:" 202 | "^Cc:" 203 | "^Date:" 204 | "^User-Agent:" 205 | "^X-Mailer:" 206 | "^X-Newsreader:")) 207 | 208 | (setq gnus-buttonized-mime-types 209 | '("multipart/alternative" 210 | ".*/signed" 211 | "multipart/encrypted")) 212 | 213 | ;; timestamp 214 | (add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp) 215 | (setq gnus-group-line-format "%M%S%p%P%5y: %(%-40,40g%) %uX\n") 216 | 217 | ;; This will be used by gnus-group-line-format at "%uX". 218 | (defun gnus-user-format-function-X (headers) 219 | (let ((time (gnus-group-timestamp gnus-tmp-group))) 220 | (if time (format-time-string "%b %d %H:%M" time) ""))) 221 | 222 | (setq gnus-summary-line-format "%U%R%z%O%(%&user-date; %-15,15f %* %B%s%)\n" 223 | gnus-user-date-format-alist '(((gnus-seconds-today) . "Today, %H:%M") 224 | ((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M") 225 | (t . "%d.%m.%Y %H:%M")) 226 | gnus-sum-thread-tree-false-root "" 227 | gnus-sum-thread-tree-indent " " 228 | gnus-sum-thread-tree-root "" 229 | gnus-sum-thread-tree-leaf-with-other "├► " 230 | gnus-sum-thread-tree-single-leaf "╰► " 231 | gnus-sum-thread-tree-vertical "│") 232 | 233 | (add-hook 'gnus-summary-mode-hook 'hl-line-mode) 234 | (add-hook 'gnus-group-mode-hook 'hl-line-mode) 235 | 236 | ;; Agent 237 | (setq gnus-agent-expire-days 7) 238 | 239 | ;; Scoring 240 | ;; The scoring system sorts articles and authors you read often to the 241 | ;; beginning of the available mails. 242 | ;; Less interesting stuff is located at the end. 243 | (setq gnus-use-adaptive-scoring t) 244 | (setq gnus-score-expiry-days 14) 245 | (setq gnus-default-adaptive-score-alist 246 | '((gnus-unread-mark) 247 | (gnus-ticked-mark (from 4)) 248 | (gnus-dormant-mark (from 5)) 249 | (gnus-saved-mark (from 20) (subject 5)) 250 | (gnus-del-mark (from -2) (subject -5)) 251 | (gnus-read-mark (from 2) (subject 1)) 252 | (gnus-killed-mark (from 0) (subject -3)))) 253 | 254 | (setq gnus-score-decay-constant 1) ;default = 3 255 | (setq gnus-score-decay-scale 0.03) ;default = 0.05 256 | 257 | (setq gnus-decay-scores t) ;(gnus-decay-score 1000) 258 | 259 | ;; Use a global score file to filter gmane spam articles. 260 | (setq gnus-global-score-files 261 | '("~/News/scores/all.SCORE")) 262 | 263 | ;; all.SCORE contains: 264 | ;; (("xref" 265 | ;; ("gmane.spam.detected" -1000 nil s))) 266 | (setq gnus-summary-expunge-below -999) 267 | 268 | 269 | ;;; Message and smtp settings 270 | ;; 271 | ;; 272 | ;;; mm-* settings 273 | ;; 274 | ;; Junk mail 275 | 276 | ;; (when (require 'mm-decode) 277 | ;; (setq mm-discouraged-alternatives 278 | ;; '("text/html" 279 | ;; "text/richtext" 280 | ;; "text/enriched" 281 | ;; "multipart/related" 282 | ;; "image/.*") 283 | ;; mm-automatic-display 284 | ;; (remove "text/html" mm-automatic-display))) 285 | 286 | ;;; Remove white space in filenames 287 | ;; 288 | ;; 289 | 290 | ;; Try to inline images 291 | ;; (setq mm-inline-text-html-with-images t) 292 | 293 | 294 | (setq gnus-inhibit-mime-unbuttonizing nil) 295 | (setq gnus-buttonized-mime-types '("multipart/signed" 296 | "multipart/alternative")) 297 | 298 | ;; Automatically sign/encrypt replies to signed/encrypted mails. 299 | ;; All messages in Posteo are encrypted, so with these variables 300 | ;; replies would be always encrypted/signed. 301 | (setq gnus-message-replysign t ; not this one hopefully. 302 | gnus-message-replyencrypt nil 303 | gnus-message-replysignencrypted nil) 304 | 305 | ;; Suppression de la signature quand on quote. 306 | (setq message-cite-function 'message-cite-original-without-signature) 307 | 308 | (define-key gnus-article-mode-map (kbd "C-c C-c") 'tv:browse-url-or-show-patch) 309 | (define-key gnus-article-mode-map (kbd "") 'w3m-next-anchor) 310 | (define-key gnus-article-mode-map (kbd "") 'w3m-previous-anchor) 311 | 312 | ;;; gnus-config.el ends here 313 | 314 | -------------------------------------------------------------------------------- /init-helm.el: -------------------------------------------------------------------------------- 1 | ;;; init-helm.el --- My startup file for helm. -*- lexical-binding: t -*- 2 | ;;; Code: 3 | 4 | ;;; Load helm-core. 5 | 6 | (require 'helm) 7 | ;; Only needed when installed from source. 8 | ;; NOTE: package.el creates an autoload file without a provide whereas 9 | ;; make creates it with a provide, so require helm-autoloads is 10 | ;; supported only when building with make from source. 11 | (require 'helm-autoloads) 12 | (setq helm-reuse-last-window-split-state t 13 | helm-commands-using-frame '(completion-at-point helm-imenu 14 | helm-imenu-in-all-buffers) 15 | helm-use-frame-when-more-than-two-windows t 16 | helm-use-frame-when-no-suitable-window t 17 | helm-frame-background-color "DarkSlateGray" 18 | helm-move-to-line-cycle-in-source t 19 | helm-autoresize-max-height 80 ; it is %. 20 | helm-autoresize-min-height 20 ; it is %. 21 | helm-follow-mode-persistent t 22 | helm-visible-mark-prefix "✓" 23 | helm-kill-real-or-display-selection 'real) 24 | (set-face-foreground 'helm-mark-prefix "Gold1") 25 | (add-to-list 'helm-sources-using-default-as-input 'helm-source-info-bash) 26 | (helm-define-key-with-subkeys global-map (kbd "C-c n") ?n 'helm-cycle-resume) 27 | (define-key helm-map (kbd "C-%") #'helm-exchange-minibuffer-and-header-line) 28 | (define-key helm-map (kbd "C--") #'helm-swap-windows) 29 | 30 | ;;; Load all autoloads for helm extensions 31 | ;; 32 | ;; 33 | (load "helm-extensions-autoloads.el") 34 | 35 | 36 | (defun helm/debug-toggle () 37 | (interactive) 38 | (setq helm-debug (not helm-debug)) 39 | (message "Helm Debug is now %s" 40 | (if helm-debug "Enabled" "Disabled"))) 41 | 42 | (defun helm/occur-which-func () 43 | (interactive) 44 | (with-current-buffer 45 | (or (helm-aif (with-helm-buffer 46 | (window-buffer helm-persistent-action-display-window)) 47 | (and (null (minibufferp it)) it)) 48 | helm-current-buffer) 49 | (when (eq major-mode 'emacs-lisp-mode) 50 | (message "[%s]" (which-function))))) 51 | 52 | (defun helm/bash-history () 53 | (interactive) 54 | (helm :sources (helm-build-in-file-source "Bash history" "~/.bash_history" 55 | :action '(("Kill new" . kill-new) 56 | ("Send command to Tmux" . emamux:send-command))) 57 | :buffer "*helm bash history*")) 58 | 59 | ;;; Package declarations. 60 | ;; 61 | 62 | ;;; Helm-mode (it is loading nearly everything) 63 | ;; 64 | (add-hook 'helm-mode-hook 65 | (lambda () 66 | (setq completion-styles 67 | (cond ((assq 'helm-flex completion-styles-alist) 68 | '(helm-flex)) ;; emacs-26. 69 | ((assq 'flex completion-styles-alist) 70 | '(flex)))))) ;; emacs-27+. 71 | 72 | (setq helm-completion-mode-string " ⎈") 73 | 74 | (helm-mode 1) 75 | 76 | (add-to-list 'helm-completing-read-command-categories 77 | '("psession-make-persistent-variable" . symbol-help)) 78 | (add-to-list 'helm-completing-read-command-categories 79 | '("psession-remove-persistent-variables" . symbol-help)) 80 | 81 | (setq helm-completing-read-handlers-alist 82 | '((find-tag . helm-completing-read-default-find-tag) 83 | (ggtags-find-tag-dwim . helm-completing-read-default-find-tag) 84 | (tmm-menubar) 85 | (find-file) 86 | (execute-extended-command) 87 | (shell) ; Fixed by c04b867a but completion is useless here. 88 | (cancel-debug-on-entry) 89 | (dired-do-rename . helm-read-file-name-handler-1) 90 | (dired-do-copy . helm-read-file-name-handler-1) 91 | (dired-do-symlink . helm-read-file-name-handler-1) 92 | (dired-do-relsymlink . helm-read-file-name-handler-1) 93 | (dired-do-hardlink . helm-read-file-name-handler-1) 94 | (dired-do-touch . nil) 95 | (read-multiple-choice--long-answers . nil) 96 | (basic-save-buffer . helm-read-file-name-handler-1) 97 | (write-file . (default helm-read-file-name-handler-1)) 98 | (write-region . (default helm-read-file-name-handler-1)) 99 | (all-the-icons-insert . helm-mode-all-the-icons-handler))) 100 | 101 | ;; Fix CAP with LSP in python. 102 | (add-to-list 'helm-completion-styles-alist '(python-mode . (emacs helm helm-flex))) 103 | 104 | ;; Custom completion matching 105 | (add-to-list 'helm-completion-styles-alist '(switch-to-buffer . helm-fuzzy)) 106 | 107 | ;; `completions-detailed' works now with both 108 | ;; `helm-completing-read-default-1' and 109 | ;; `helm-completing-read-default-2'. To test it with *default-2 add 110 | ;; the describe-* fns to helm-completion-styles-alist 111 | ;; i.e. (fun . (emacs helm flex)). 112 | 113 | (if (boundp 'completions-detailed) 114 | (setq completions-detailed t) 115 | ;; Emacs-27< 116 | (setq helm-completions-detailed t)) 117 | 118 | ;;; Helm-adaptive 119 | ;; 120 | (require 'helm-adaptive) 121 | (setq helm-adaptive-history-file nil) 122 | (helm-adaptive-mode 1) 123 | 124 | ;;; Helm-bookmark 125 | ;; 126 | (with-eval-after-load 'helm-bookmark 127 | (customize-set-variable 'helm-bookmark-use-icon t) 128 | (customize-set-variable 'helm-bookmark-annotation-sign "✫")) 129 | 130 | ;;; Helm-utils 131 | ;; 132 | (with-eval-after-load 'helm-utils 133 | ;; Popup buffer-name or filename in grep/moccur/imenu-all etc... 134 | (helm-popup-tip-mode 1) 135 | (setq helm-highlight-matches-around-point-max-lines '(30 . 30) 136 | helm-window-prefer-horizontal-split t) 137 | (add-hook 'find-file-hook 'helm-save-current-pos-to-mark-ring)) 138 | 139 | ;;; Helm-sys 140 | ;; 141 | (helm-top-poll-mode 1) 142 | (setq helm-top-command "env COLUMNS=%s top -b -c -n 1") 143 | 144 | ;;; Helm-ring 145 | ;; 146 | (with-eval-after-load 'helm-ring 147 | (setq helm-kill-ring-threshold 1) 148 | 149 | ;; Actions for helm kill-ring 150 | (defun helm-ring-split-block (string) 151 | (with-temp-buffer 152 | (insert string) 153 | (goto-char (point-min)) 154 | (helm-awhile (read (current-buffer)) 155 | (kill-new (prin1-to-string it))))) 156 | 157 | (defun helm-kill-ring-insert-hunk (hunk) 158 | "Yank string HUNK copied from a diff buffer." 159 | (helm-kill-ring-action-yank-1 160 | (with-temp-buffer 161 | (insert hunk) 162 | (goto-char (point-min)) 163 | (while (re-search-forward "^[+-]" nil t) 164 | (replace-match "")) 165 | (buffer-string)))) 166 | 167 | (add-to-list 'helm-kill-ring-actions '("Split block" . helm-ring-split-block) t) 168 | (add-to-list 'helm-kill-ring-actions '("Insert hunk" . helm-kill-ring-insert-hunk) t) 169 | (define-key helm-kill-ring-map (kbd "C-d") 'helm-kill-ring-run-persistent-delete)) 170 | 171 | ;;; Helm-buffers 172 | ;; 173 | (with-eval-after-load 'helm-buffers 174 | (setq helm-buffers-favorite-modes 175 | (append helm-buffers-favorite-modes '(picture-mode artist-mode)) 176 | helm-buffer-skip-remote-checking t 177 | helm-buffer-max-length 36 178 | helm-buffers-fuzzy-matching t 179 | helm-boring-buffer-regexp-list 180 | '("\\` " "\\`\\*helm" "\\`\\*Echo Area" "\\`\\*Minibuf" 181 | "\\`\\*Messages" "\\`\\*Magit" "\\`\\*git-gutter" "\\`\\*Help" "\\`\\*skitour")) 182 | (customize-set-variable 'helm-buffers-maybe-switch-to-tab t) 183 | (customize-set-variable 'helm-buffers-show-icons t) 184 | 185 | (define-key helm-buffer-map (kbd "C-d") 'helm-buffer-run-kill-persistent)) 186 | 187 | ;;; Helm-files 188 | ;; 189 | (with-eval-after-load 'helm-files 190 | (setq helm-ff-auto-update-initial-value t 191 | helm-ff-allow-non-existing-file-at-point t 192 | helm-ff-candidate-number-limit 5000 193 | helm-trash-remote-files t 194 | helm-dwim-target 'next-window 195 | helm-locate-recursive-dirs-command "locate -i -e --regex '^%s' '%s.*$'" 196 | helm-ff-eshell-unwanted-aliases '("sudo" "cdu" "man" 197 | "gpg-pubkey-export-armor" "gpg-secretkey-export-armor") 198 | helm-file-name-history-hide-deleted t 199 | helm-ff-ignore-following-on-directory t 200 | helm-rsync-progress-bar-function #'helm-rsync-svg-progress-bar) 201 | (customize-set-variable 'helm-find-files-ignore-diacritics t) 202 | 203 | (defun helm-ff-dragon (files) 204 | "Create a small window with FILES ready to drag and drop. 205 | Use this to drop files on externals applications or desktop. 206 | Dropping on emacs buffers with this is not supported. 207 | 208 | Needs `dragon' executable: https://github.com/mwh/dragon." 209 | (interactive (list (helm-marked-candidates))) 210 | (cl-assert (executable-find "dragon") nil "Dragon executable not found") 211 | (apply #'call-process "dragon" nil nil nil "--all" "--and-exit" files)) 212 | (define-key helm-find-files-map (kbd "C-c m") 'helm-ff-dragon) 213 | 214 | (customize-set-variable 'helm-ff-lynx-style-map t) 215 | (define-key helm-read-file-map (kbd "RET") 'helm-ff-RET) 216 | (define-key helm-find-files-map (kbd "C-i") nil) 217 | (define-key helm-find-files-map (kbd "C-d") 'helm-ff-persistent-delete) 218 | 219 | (defun helm-ff-recoll-index-directory (directory) 220 | "Create a recoll index directory from DIRECTORY. 221 | Add the new created directory to `helm-recoll-directories' using the 222 | basename of DIRECTORY as name. 223 | By using `customize-set-variable', a new source is created for this 224 | new directory." 225 | (cl-assert (boundp 'helm-recoll-directories) nil 226 | "Package helm-recoll not installed or configured") 227 | (let* ((bn (helm-basename (expand-file-name directory))) 228 | (index-dir (format "~/.recoll-%s" bn)) 229 | (conf-file (expand-file-name "recoll.conf" index-dir))) 230 | (mkdir index-dir) 231 | (with-current-buffer (find-file-noselect conf-file) 232 | (insert (format "topdirs = %s" (expand-file-name directory))) 233 | (save-buffer) 234 | (kill-buffer)) 235 | (customize-set-variable 'helm-recoll-directories 236 | (append `((,bn . ,index-dir)) helm-recoll-directories)) 237 | (message "Don't forget to index config directory with 'recollindex -c %s'" index-dir))) 238 | 239 | (defun helm-ff-recoll-index-directories (_candidate) 240 | (let ((dirs (helm-marked-candidates))) 241 | (cl-loop for dir in dirs 242 | when (file-directory-p dir) 243 | do (helm-ff-recoll-index-directory dir)))) 244 | 245 | (defun helm-ff-csv2ledger (candidate) 246 | (csv2ledger "Socgen" candidate "/home/thierry/finance/ledger.dat")) 247 | 248 | ;; Add actions to `helm-source-find-files' IF: 249 | (cl-defmethod helm-setup-user-source ((source helm-source-ffiles)) 250 | "Adds additional actions and settings to `helm-find-files'. 251 | - Open info file 252 | - Patch region on directory 253 | - Open in emms 254 | - Recoll directory creation 255 | - Csv2ledger." 256 | ;; Info on .info files 257 | (helm-source-add-action-to-source-if 258 | "Open info file" 259 | (lambda (candidate) (info candidate)) 260 | source 261 | (lambda (candidate) (helm-aif (file-name-extension candidate) 262 | (string= it "info"))) 263 | 1) 264 | ;; Patch region on dir 265 | (helm-source-add-action-to-source-if 266 | "Patch region on directory" 267 | (lambda (_candidate) 268 | (with-helm-current-buffer 269 | (shell-command-on-region (region-beginning) (region-end) 270 | (format "patch -d %s -p1" 271 | helm-ff-default-directory)))) 272 | source 273 | (lambda (_candidate) 274 | (with-helm-current-buffer 275 | (and (or (eq major-mode 'gnus-article-mode) 276 | (eq major-mode 'diff-mode) 277 | (eq major-mode 'mu4e-view-mode)) 278 | (region-active-p)))) 279 | 1) 280 | ;; Emms 281 | (helm-source-add-action-to-source-if 282 | "Open in emms" 283 | (lambda (candidate) 284 | (if (file-directory-p candidate) 285 | (emms-play-directory candidate) 286 | (emms-play-file candidate))) 287 | source 288 | (lambda (candidate) 289 | (or (and (file-directory-p candidate) 290 | (directory-files 291 | candidate 292 | nil ".*\\.\\(mp3\\|ogg\\|flac\\)$" t)) 293 | (string-match-p ".*\\.\\(mp3\\|ogg\\|flac\\)$" candidate))) 294 | 1) 295 | ;; Setup recoll dirs 296 | (when (executable-find "recoll") 297 | (helm-source-add-action-to-source-if 298 | "Recoll index directory" 299 | 'helm-ff-recoll-index-directories 300 | source 301 | 'file-directory-p 302 | 3)) 303 | ;; Csv to ledger 304 | (helm-source-add-action-to-source-if 305 | "Csv2Ledger" 306 | 'helm-ff-csv2ledger 307 | source 308 | (lambda (candidate) 309 | (member (file-name-extension candidate) '("csv"))) 310 | 3)) 311 | 312 | ;; Finally enable Icons in HFF. 313 | (helm-ff-icon-mode 1)) 314 | 315 | ;;; Helm-dictionary 316 | ;; 317 | (with-eval-after-load 'helm-dictionary ; Its autoloads are already loaded. 318 | (setq helm-dictionary-database 319 | '(("en-fr" . "~/helm-dictionary/dic-en-fr.iso") 320 | ("fr-en" . "~/helm-dictionary/dic-fr-en.iso")) 321 | helm-dictionary-online-dicts 322 | '(("translate.reference.com en->fr" . 323 | "http://translate.reference.com/translate?query=%s&src=en&dst=fr") 324 | ("translate.reference.com fr->en" . 325 | "http://translate.reference.com/translate?query=%s&src=fr&dst=en") 326 | ("en.wiktionary.org" . "http://en.wiktionary.org/wiki/%s") 327 | ("fr.wiktionary.org" . "http://fr.wiktionary.org/wiki/%s")) 328 | helm-dictionary-ignore-diacritics t) 329 | (helm-add-to-list 'helm-dictionary-actions '("Sdcv French dictionaries" . helm-dictionary-sdcv) 2) 330 | (helm-add-to-list 'helm-dictionary-actions '("English dictionary" . helm-dictionary-search) 3)) 331 | 332 | (defun helm-dictionary-search (entry) 333 | (let* ((src (helm-get-current-source)) 334 | (name (if (string= (helm-get-attr 'name src) "en-fr") 335 | (helm-dictionary-get-candidate entry 1) 336 | (helm-dictionary-get-candidate entry 2)))) 337 | (setq name (car (split-string name))) 338 | (dictionary-search name))) 339 | 340 | (defvar helm-dictionary-sdcv-directory "/home/thierry/.stardict/") 341 | (defun helm-dictionary-sdcv (entry) 342 | "Search ENTRY in french dictionary. 343 | Need sdcv and stardict-xmlittre packages as dependencies." 344 | (let* ((src (helm-get-current-source)) 345 | (name (if (string= (helm-get-attr 'name src) "en-fr") 346 | (helm-dictionary-get-candidate entry 2) 347 | (helm-dictionary-get-candidate entry 1))) 348 | ;; All dictionaries are copied in separate directories dir1, 349 | ;; dir2 etc... to avoid duplicates in sdcv output. 350 | (dir helm-dictionary-sdcv-directory) 351 | (args '("--non-interactive" "--color" "--data-dir"))) 352 | (when (string-match ", " name) 353 | (setq name (completing-read "Name: " (split-string name ", " t))) 354 | (when (string-match "\\(.*\\) +[[({]" name) 355 | (setq name (match-string 1 name)))) 356 | (with-current-buffer (get-buffer-create "*sdcv*") 357 | (let ((inhibit-read-only t)) 358 | (erase-buffer) 359 | (save-excursion 360 | (apply #'call-process "sdcv" nil t nil (append args (list dir name))) 361 | (ansi-color-apply-on-region (point-min) (point-max))) 362 | (while (re-search-forward (regexp-quote name) nil t) 363 | (add-face-text-property 364 | (match-beginning 0) (match-end 0) 'font-lock-constant-face)) 365 | (goto-char (point-min)) 366 | (fill-region (point-min) (point-max))) 367 | (special-mode)) 368 | (pop-to-buffer "*sdcv*"))) 369 | 370 | ;;; Helm-wikipedia 371 | ;; 372 | (with-eval-after-load 'helm-wikipedia 373 | (setq helm-wikipedia-summary-url 374 | "https://fr.wikipedia.org/w/api.php?action=query&format=json&prop=extracts&titles=%s&exintro=1&explaintext=1&redirects=1" 375 | helm-wikipedia-suggest-url 376 | "https://fr.wikipedia.org/w/api.php?action=opensearch&search=%s")) 377 | 378 | ;;; Helm-descbinds 379 | ;; 380 | (helm-descbinds-mode 1) 381 | 382 | ;;; Helm-lib 383 | ;; 384 | (with-eval-after-load 'helm-lib 385 | (autoload 'isl-search "isl" nil t) 386 | (defun tv:advice-print-table (old-fn &rest args) 387 | (cl-letf (((symbol-function 'cl--print-table) 388 | #'helm-source--cl--print-table)) 389 | (apply old-fn args))) 390 | (advice-add 'push-button :around #'tv:advice-print-table) 391 | (setq helm-scroll-amount 4) 392 | (setq helm-find-function-default-project 393 | '("~/work/emacs/lisp/" "~/work/github/")) 394 | (helm-help-define-key "C-x" 'exchange-point-and-mark) 395 | (helm-help-define-key "C-l" 'recenter-top-bottom) 396 | (helm-help-define-key "C-s" nil) 397 | (helm-help-define-key "C-r" nil) 398 | (helm-help-define-key "C-s" 'isl-search)) 399 | 400 | ;;; Helm-net 401 | ;; 402 | (with-eval-after-load 'helm-net 403 | (setq helm-net-prefer-curl nil 404 | helm-surfraw-duckduckgo-url "https://duckduckgo.com/?q=%s&ke=-1&kf=fw&kl=fr-fr&kr=b&k1=-1&k4=-1" 405 | helm-google-suggest-search-url helm-surfraw-duckduckgo-url)) 406 | 407 | ;;; Helm-external 408 | ;; 409 | (with-eval-after-load 'helm-external 410 | (setq helm-raise-command "wmctrl -xa %s" 411 | helm-default-external-file-browser "thunar")) 412 | 413 | ;;; Helm-grep 414 | ;; 415 | (with-eval-after-load 'helm-grep 416 | (setq helm-pdfgrep-default-read-command 417 | "xreader --page-label=%p '%f'" 418 | helm-grep-default-command 419 | "ack -Hn --color --smart-case --no-group %e -- %p %f" 420 | helm-grep-default-recurse-command 421 | "ack -H --color --smart-case --no-group %e -- %p %f" 422 | helm-grep-ag-command 423 | "rg --color=always --colors 'match:bg:yellow' --colors 'match:fg:black' --smart-case --search-zip --no-heading --line-number %s -- %s %s" 424 | helm-grep-ag-pipe-cmd-switches 425 | '("--colors 'match:bg:yellow' --colors 'match:fg:black'") 426 | helm-grep-git-grep-command 427 | "git --no-pager grep -n%cH --color=always --exclude-standard --no-index --full-name -e %p -- %f") 428 | (set-face-attribute 'helm-grep-match nil :background "yellow" :foreground "black") 429 | (add-hook 'helm-grep-mode-hook 'hl-line-mode) 430 | (define-key helm-grep-map (kbd "C-M-a") 'helm/occur-which-func)) 431 | 432 | ;;; Helm-occur 433 | ;; 434 | (with-eval-after-load 'helm-occur 435 | (setq helm-occur-keep-closest-position t) 436 | (setq helm-occur-match-shorthands t) 437 | (setq helm-occur-candidate-number-limit 500) 438 | (add-hook 'helm-occur-mode-hook 'hl-line-mode) 439 | (define-key helm-occur-map (kbd "C-M-a") 'helm/occur-which-func)) 440 | 441 | ;;; Helm-elisp 442 | ;; 443 | (helm-multi-key-defun helm-multi-lisp-complete-at-point 444 | "Multi key function for completion in emacs lisp buffers. 445 | First call indent, second complete symbol, third complete fname." 446 | '(helm-lisp-indent 447 | helm-lisp-completion-at-point) 448 | 0.3) 449 | (define-key emacs-lisp-mode-map (kbd "TAB") 'helm-multi-lisp-complete-at-point) 450 | (define-key lisp-interaction-mode-map (kbd "TAB") 'helm-multi-lisp-complete-at-point) 451 | 452 | (with-eval-after-load 'helm-elisp 453 | (setq helm-show-completion-display-function #'helm-display-buffer-in-own-frame 454 | helm-apropos-show-short-doc t)) 455 | 456 | ;;; Helm-locate 457 | ;; 458 | (with-eval-after-load 'helm-locate 459 | (setq helm-locate-fuzzy-match nil)) 460 | 461 | ;;; Helm-org 462 | ;; 463 | (with-eval-after-load 'helm-org 464 | (setq helm-org-headings-fontify t)) 465 | 466 | ;;; Helm-emms 467 | ;; 468 | (with-eval-after-load 'helm-emms 469 | (setq helm-emms-use-track-description-function t) 470 | (helm-set-attr 'candidate-number-limit 500 helm-source-emms-dired) 471 | (add-to-list 'helm-emms-music-extensions "mp4")) 472 | 473 | ;;; Helm-find 474 | ;; 475 | (global-set-key (kbd "C-/") 'helm-find) 476 | (with-eval-after-load 'helm-find 477 | (setq helm-find-noerrors t 478 | helm-find-show-full-path-fn #'file-relative-name)) 479 | 480 | ;;; Helm-imenu 481 | ;; 482 | (with-eval-after-load 'helm-imenu 483 | (setq helm-imenu-extra-modes '(org-mode markdown-mode)) 484 | (customize-set-variable 'helm-imenu-lynx-style-map t) 485 | (customize-set-variable 'helm-imenu-use-icon t) 486 | (customize-set-variable 'helm-imenu-hide-item-type-name t)) 487 | 488 | ;;; Helm-misc 489 | ;; 490 | (with-eval-after-load 'helm-misc 491 | ;; Minibuffer history (Rebind to M-s). 492 | (customize-set-variable 'helm-minibuffer-history-key [remap next-matching-history-element])) 493 | 494 | ;;; Helm-epa 495 | ;; 496 | (helm-epa-mode 1) 497 | 498 | ;;; Helm-fd 499 | ;; 500 | (with-eval-after-load 'helm-fd 501 | (setq helm-fd-executable "fdfind" 502 | helm-fd-switches '("--hidden" "--type" "f" "--type" "d" "--color" "always")) 503 | (defun helm-fd-pa (candidate) 504 | (with-helm-buffer 505 | (helm-ff-kill-or-find-buffer-fname 506 | (expand-file-name candidate)))) 507 | (cl-defmethod helm-setup-user-source ((source helm-fd-class)) 508 | (setf (slot-value source 'persistent-action) 'helm-fd-pa))) 509 | 510 | ;;; Helm-ls-git 511 | ;; 512 | (with-eval-after-load 'helm-ls-git 513 | (setq helm-ls-git-delete-branch-on-remote t 514 | helm-ls-git-auto-refresh-at-eob t)) 515 | 516 | ;;; Helm-M-x 517 | ;; 518 | (setq helm-M-x-exclude-unusable-commands-in-mode t) 519 | 520 | ;;; helm-packages 521 | ;; 522 | (with-eval-after-load 'helm-packages 523 | (setq helm-packages-isolate-fn #'helm-packages-isolate-1 524 | helm-packages-default-clone-directory "~/work/") 525 | (defun helm-packages-find-project-after-clone (package directory) 526 | (helm-find-files-1 (file-name-as-directory (expand-file-name package directory)))) 527 | (add-hook 'helm-packages-clone-after-hook #'helm-packages-find-project-after-clone)) 528 | 529 | ;;; Helm-x-icons 530 | ;; 531 | ;; (with-eval-after-load 'helm-x-icons 532 | ;; (customize-set-variable 'helm-x-icons-provider 'nerd-icons)) 533 | 534 | ;;; Helm-command-map 535 | ;; 536 | ;; 537 | (define-key helm-command-map (kbd "g") 'helm-apt-search) 538 | (define-key helm-command-map (kbd "z") 'helm-complex-command-history) 539 | (define-key helm-command-map (kbd "x") 'helm-firefox-bookmarks) 540 | (define-key helm-command-map (kbd "w") 'helm-wikipedia-suggest) 541 | (define-key helm-command-map (kbd "#") 'helm-emms) 542 | (define-key helm-command-map (kbd "I") 'helm-imenu-in-all-buffers) 543 | 544 | ;;; Global-map 545 | ;; 546 | ;; 547 | (global-set-key (kbd "C-h r") 'helm-info-emacs) 548 | (global-set-key (kbd "M-x") 'undefined) 549 | (global-set-key (kbd "M-x") 'helm-M-x) 550 | (global-set-key (kbd "M-y") 'helm-show-kill-ring) 551 | (global-set-key (kbd "C-x C-f") 'helm-find-files) 552 | (global-set-key (kbd "C-c ") 'helm-mark-ring) 553 | (global-set-key [remap bookmark-jump] 'helm-filtered-bookmarks) 554 | (global-set-key (kbd "C-c i") 'helm-imenu) 555 | (global-set-key (kbd "C-c I") 'helm-imenu-in-all-buffers) 556 | (global-set-key (kbd "C-:") 'helm-eval-expression-with-eldoc) 557 | (global-set-key (kbd "C-,") 'helm-calcul-expression) 558 | (global-set-key (kbd "C-h d") 'helm-info-at-point) 559 | (global-set-key (kbd "C-h i") 'helm-info) 560 | (global-set-key (kbd "C-x C-d") 'helm-browse-project) 561 | (global-set-key (kbd "") 'helm-resume) 562 | (global-set-key (kbd "C-h C-f") 'helm-apropos) 563 | (global-set-key (kbd "C-h a") 'helm-apropos) 564 | (global-set-key (kbd "C-h C-d") 'helm-debug-open-last-log) 565 | (global-set-key (kbd " s") 'helm-find) 566 | (global-set-key (kbd "S-") 'helm-execute-kmacro) 567 | (global-set-key (kbd "") nil) 568 | (global-set-key (kbd " o") 'helm-org-agenda-files-headings) 569 | (global-set-key (kbd "M-s") nil) 570 | (global-set-key (kbd "M-s") 'helm-occur-visible-buffers) 571 | (global-set-key (kbd " h") 'helm-emms) 572 | (define-key global-map [remap bookmark-bmenu-list] 'helm-register) 573 | (define-key global-map [remap list-buffers] 'helm-buffers-list) 574 | (define-key global-map [remap dabbrev-expand] 'helm-dabbrev) 575 | (define-key global-map [remap find-tag] 'helm-etags-select) 576 | (define-key global-map [remap xref-find-definitions] 'helm-etags-select) 577 | (define-key global-map (kbd "M-g a") 'helm-do-grep-ag) 578 | (define-key global-map (kbd "M-g l") 'goto-line) 579 | (define-key global-map (kbd "M-g g") 'helm-grep-do-git-grep) 580 | (define-key global-map (kbd "M-g M-g") 'helm-revert-next-error-last-buffer) 581 | (define-key global-map (kbd "M-g i") 'helm-gid) 582 | (define-key global-map (kbd "C-x r p") 'helm-projects-history) 583 | (define-key global-map (kbd "C-x r c") 'helm-addressbook-bookmarks) 584 | (define-key global-map (kbd "C-c t r") 'helm-dictionary) 585 | 586 | ;; Indent or complete with completion-at-point 587 | ;; (setq tab-always-indent 'complete) 588 | 589 | ;; (define-key global-map (kbd "") 'completion-at-point) 590 | 591 | (provide 'init-helm) 592 | 593 | ;;; init-helm.el ends here 594 | -------------------------------------------------------------------------------- /ledger-config.el: -------------------------------------------------------------------------------- 1 | ;;; ledger-config.el --- extend ledger-mode -*- lexical-binding: t -*- 2 | 3 | ;; Code: 4 | 5 | (require 'ledger-mode) 6 | (require 'helm-lib) 7 | (require 'helm-mode) 8 | 9 | (define-key ledger-mode-map (kbd "C-c a l") 'ledger-align-device) 10 | (defvar ledger-default-device "€") 11 | 12 | ;; «Align-euro-device» (to ".Align-euro-device") 13 | ;;;###autoload 14 | (defun ledger-align-device (&optional column) 15 | (interactive "p") 16 | (when (= column 1) (setq column 48)) 17 | (save-excursion 18 | (goto-char (point-min)) 19 | (while (search-forward ledger-default-device nil t) 20 | (backward-char) 21 | (let ((col (current-column)) 22 | (beg (point)) 23 | target-col len) 24 | (skip-chars-forward (concat "-" ledger-default-device "0-9,.")) 25 | (setq len (- (point) beg)) 26 | (setq target-col (- column len)) 27 | (if (< col target-col) 28 | (progn 29 | (goto-char beg) 30 | (insert (make-string (- target-col col) ? ))) 31 | (move-to-column target-col) 32 | (if (looking-back " " (1- (point))) 33 | (delete-char (- col target-col)) 34 | (skip-chars-forward "^ \t") 35 | (delete-horizontal-space) 36 | (insert " "))) 37 | (forward-line))))) 38 | 39 | ;; «ledger-position-at-point» (to ".ledger-position-at-point") 40 | ;;;###autoload 41 | (defun ledger-position (arg) 42 | "Show ledger balance, with prefix-arg insert it at point." 43 | (interactive "P") 44 | (let* ((bal (with-temp-buffer 45 | (apply #'call-process "ledger" nil t nil 46 | (list "-C" "bal" "socgen")) 47 | (split-string (buffer-string) "\n" t))) 48 | (result (car (last bal)))) 49 | (when (string-match "€ [0-9.]*" result) 50 | (setq result (match-string 0 result)) 51 | (if arg 52 | (insert (format "[%s]" result)) 53 | (message "ledger balance: %s" result))))) 54 | 55 | (defun tv:advice-ledger-reconcile-refresh (&rest _args) 56 | "Align euros in reconcile buffer after refreshing with `C-l'." 57 | (save-excursion 58 | (let ((inhibit-read-only t)) 59 | (align-regexp (point-min) (point-max) "\\(\\s-*\\)€" 1 1 nil)))) 60 | (advice-add 'ledger-reconcile-refresh :after #'tv:advice-ledger-reconcile-refresh) 61 | 62 | (defun ledger-reverse-date-from-regexp (regexp) 63 | (let ((ledger-file (getenv "LEDGER_FILE"))) 64 | (cl-assert ledger-file nil "No ledger file found, check your ENV var LEDGER_FILE") 65 | (with-current-buffer (find-file-noselect ledger-file) 66 | (goto-char (point-min)) 67 | (while (re-search-forward regexp nil t) 68 | (let* ((dt (match-string-no-properties 0)) 69 | (split (reverse (split-string dt "/"))) 70 | (new-dt (mapconcat 'identity split "/"))) 71 | (delete-region (pos-bol) (point)) 72 | (insert new-dt)))))) 73 | 74 | ;;;###autoload 75 | (defun ledger-reverse-date-to-us () 76 | (interactive) 77 | (ledger-reverse-date-from-regexp 78 | "^[0-9]\\{2\\}/[0-9]\\{2\\}/[0-9]\\{4\\}")) 79 | 80 | ;;;###autoload 81 | (defun ledger-reverse-date-to-fr () 82 | (interactive) 83 | (ledger-reverse-date-from-regexp 84 | "^[0-9]\\{4\\}/[0-9]\\{2\\}/[0-9]\\{2\\}")) 85 | 86 | ;;;###autoload 87 | (defun ledger-add-expense (date payee categorie type amount) 88 | (interactive 89 | (list (read-string "Date: " (format-time-string "%Y/%m/%d")) 90 | (read-string "Payee: ") 91 | (helm-comp-read "Categorie: " (ledger-collect-categories)) 92 | (helm-comp-read "Type: " '("Visa" "Check" "Tip" "Prelevement")) 93 | (read-string "Amount: "))) 94 | (let ((ledger-file (getenv "LEDGER_FILE")) 95 | numcheck defnumcheck) 96 | (with-current-buffer (find-file-noselect ledger-file) 97 | (goto-char (point-max)) 98 | (when (string= type "Check") 99 | (setq defnumcheck (save-excursion 100 | (when 101 | (re-search-backward 102 | "\\(^[0-9]\\{4\\}/[0-9/]*\\)\\(.*\\)\\(\([0-9]*\)\\)" nil t) 103 | (replace-regexp-in-string "\(\\|\)" "" (match-string 3))))) 104 | (setq defnumcheck (int-to-string (1+ (string-to-number defnumcheck)))) 105 | (setq numcheck (read-string "CheckNumber: " defnumcheck))) 106 | (insert (concat 107 | date " " payee (or (and numcheck (concat " (" numcheck ")")) "") "\n " 108 | "Expenses:" categorie (make-string 8 ? ) "€ " amount "\n " 109 | "Liabilities:Socgen:" type "\n\n")) 110 | (goto-char (point-min)) 111 | (ledger-align-device 1) 112 | (save-buffer) 113 | (pop-to-buffer ledger-file)))) 114 | 115 | ;;;###autoload 116 | (defun ledger-add-income (date payee categorie account amount) 117 | (interactive 118 | (list (read-string "Date: " (format-time-string "%Y/%m/%d")) 119 | (read-string "Payee: ") 120 | (helm-comp-read "Categorie: " (ledger-collect-categories)) 121 | (helm-comp-read "Account: " '("socgen:checking" "socgen:prelevement")) ;; TODO add completion here 122 | (read-string "Amount: "))) 123 | (let ((ledger-file (getenv "LEDGER_FILE"))) 124 | (with-current-buffer (find-file-noselect ledger-file) 125 | (goto-char (point-max)) 126 | (insert (concat 127 | date " " payee "\n " 128 | (if (string= account "socgen:checking") "Assets:" "Liabilities:") 129 | account (make-string 8 ? ) "€ " 130 | (if (string= account "socgen:checking") 131 | amount (int-to-string (- (string-to-number amount)))) 132 | "\n Income:" categorie "\n\n")) 133 | (goto-char (point-min)) 134 | (ledger-align-device 1) 135 | (save-buffer) 136 | (pop-to-buffer ledger-file)))) 137 | 138 | (defun ledger-collect-categories () 139 | (let ((categories '("Alimentation" "Impots" 140 | "Auto:gasoil" "Auto:garage" 141 | "Voyages" "Escalade" 142 | "Livres" "Informatique" 143 | "Loisirs" "Divers" 144 | "Loyers:immovar" "Loyers:big")) 145 | result) 146 | (with-current-buffer (find-file-noselect (getenv "LEDGER_FILE")) 147 | (goto-char (point-min)) 148 | (save-excursion 149 | (while 150 | (re-search-forward 151 | "\\(^ *Expenses\\|Income\\):\\([^ €0-9\n]*\\)" (point-max) t) 152 | (setq result (match-string 2)) 153 | (unless (or (member result categories) 154 | (string= result "")) 155 | (push result categories)))) 156 | categories))) 157 | 158 | ;;;###autoload 159 | (defun ledger-point-entries-in-buffer () 160 | "Point entries from point to end of buffer. 161 | Like C-c C-e but on all entries. 162 | If entries are already pointed, skip." 163 | (interactive) 164 | (while (re-search-forward "^[0-9]\\{4\\}/[0-9]\\{2\\}/[0-9]\\{2\\}" nil t) 165 | (forward-char 1) (unless (looking-at "[*]") (insert "* ")))) 166 | 167 | (defvar csv2ledger-default-input-dir "~/Téléchargements/") 168 | (defvar csv2ledger-default-output-dir "~/finance") 169 | ;;;###autoload 170 | (defun csv2ledger (account infile ofile) 171 | (interactive (list (completing-read "Account: " '("Socgen" "Paypal" "livretA")) 172 | (read-file-name "Input cvs file: " 173 | csv2ledger-default-input-dir 174 | nil nil nil (lambda (f) 175 | (or (file-directory-p f) 176 | (string= (file-name-extension f) "csv")))) 177 | (read-file-name "Output file (.dat): " 178 | csv2ledger-default-output-dir 179 | nil nil nil (lambda (f) 180 | (or (file-directory-p f) 181 | (string= (file-name-extension f) "dat")))))) 182 | (let ((ibuf (find-file-noselect infile)) 183 | (obuf (find-file-noselect ofile)) 184 | beg ov) 185 | (with-current-buffer obuf 186 | (goto-char (point-max)) 187 | (setq beg (point)) 188 | (text-mode)) 189 | (with-current-buffer ibuf 190 | (save-excursion 191 | (goto-char (point-min)) 192 | (while (re-search-forward "^[0-9]+/" nil t) 193 | (let* ((split (split-string (buffer-substring (pos-bol) (pos-eol)) ";" t)) 194 | (date (car split)) 195 | (payee (nth 2 split)) 196 | (amountstr (replace-regexp-in-string "," "." (nth 3 split))) 197 | (amountnum (string-to-number amountstr)) 198 | (deb (< amountnum 0))) 199 | (setq amountstr (replace-regexp-in-string "-" "" amountstr)) 200 | (with-current-buffer obuf 201 | (save-excursion 202 | (insert 203 | (concat date " * " payee "\n " 204 | (if deb 205 | (format "Expenses:unknown € %s\n Liabilities:socgen\n\n" amountstr) 206 | (format "Assets:%s:checking € %s\n Income\n\n" account amountstr)))))))))) 207 | (with-current-buffer obuf 208 | (ledger-mode) 209 | (remove-overlays) 210 | (setq ov (make-overlay beg (point-max))) 211 | (overlay-put ov 'face '((:background "DarkSlateGray" :extend t)))) 212 | (switch-to-buffer obuf) 213 | (ledger-reverse-date-to-us))) 214 | 215 | ;;;###autoload 216 | (defun ledger-exchange-point-an-mark-or-overlay () 217 | (interactive) 218 | (if (region-active-p) 219 | (exchange-point-and-mark) 220 | (helm-aif (overlays-at (point)) 221 | (cond ((eq (overlay-start (car it)) (point)) 222 | (goto-char (next-overlay-change (point))) 223 | (goto-char (next-single-char-property-change (point) 'face)) 224 | (forward-line -1)) 225 | (t 226 | (goto-char (previous-overlay-change (point))))) 227 | (and (delq nil (overlay-lists)) 228 | (goto-char (next-overlay-change (point))))))) 229 | (define-key ledger-mode-map (kbd "C-x C-x") 'ledger-exchange-point-an-mark-or-overlay) 230 | 231 | 232 | (defvar ledger/associations '(("PRELEVEMENT A LA SOURCE REVENUS" . ":impot:prelevement_source") 233 | ("SOLDE IMPOT REVENUS" . ":impot:impot_revenu") 234 | ("REMB IMPOT REVENUS" . ":impot:impot_revenu") 235 | ("MOTIF: CARAC" . ":carac") 236 | ("MOTIF: DECLIC" . ":codevi") 237 | ("GITHUB SPONSORS" . ":thierry:github") 238 | ("IMMOB PATRIMOINE ET FINANCES" . ":loyers:immovar") 239 | ("VIR GIE AFER" . ":afer:racp") 240 | ("PIERVAL SANTE" . ":scpi:pierval") 241 | ("LFREM DISTRI SCPI" . ":scpi:lfrem") 242 | ("AMAZON PAYMENTS COMMERCE ELECTRONIQUE" . ":shopping:amazon") 243 | ("LES QUATRE VALLEES" . ":vétérinaire") 244 | ("CERUTI PONS" . ":vétérinaire") 245 | ("VETO GUILLESTRE" . ":vétérinaire") 246 | ("SAMSE" . ":brico:mont-dauphin") 247 | ("WELDOM EMBRUN" . ":brico:mont-dauphin") 248 | ("GEMAP" . ":brico:mont-dauphin") 249 | ("LOGITEL POUR: Rachel Bourdin" . ":rachel:virement") 250 | ("VIR PERM POUR: Rachel Bourdin" . ":rachel:virement:mensuel") 251 | ("Solimut" . ":assurance:maladie:mutuelle") 252 | ("J LOUIS DAVID" . ":soins:coiffeur_rachel") 253 | ("DELOMPRE CURBILL" . ":soins:estheticienne") 254 | ("BIO ET BIEN ETRE" . ":alimentation:la_vie_claire") 255 | ("AUCHAN" . ":alimentation:auchan") 256 | ("LIDL" . ":alimentation:lidl") 257 | ("INTERMARCHE" . ":alimentation:intermarche") 258 | ("CARREFOUR MARKET" . ":alimentation:carrefour") 259 | ("BOUYGUES" . ":telephone:bouygues") 260 | )) 261 | 262 | ;;;###autoload 263 | (defun ledger/update-associations () 264 | (interactive) 265 | (with-current-buffer (find-file-noselect (getenv "LEDGER_FILE")) 266 | (save-excursion 267 | (cl-loop for (regexp . tag) in ledger/associations 268 | do (progn 269 | (goto-char (point-min)) 270 | (while (re-search-forward regexp nil t) 271 | (when (re-search-forward "\\(Expenses\\|Income\\)\\(:?[^ \n]*\\)\\( *€? *[0-9.]*\\)$" nil t) 272 | (unless (string= tag (match-string 2)) 273 | (replace-match tag t nil nil 2))))))))) 274 | 275 | (provide 'ledger-config) 276 | 277 | ;;; ledger-config.el ends here 278 | -------------------------------------------------------------------------------- /mail-config.el: -------------------------------------------------------------------------------- 1 | ;;; mail-config.el --- Common setting for gnus and mu4e -*- lexical-binding: t -*- 2 | 3 | ;;; code: 4 | 5 | ;; Fontify patches in gnus 6 | ;; Specify path to gnus-patch to use gnus from a not fully configured 7 | ;; emacs (helm.sh). 8 | (require 'gnus-patch "~/elisp/gnus-patch.el") 9 | (advice-add 'gnus-article-prepare-display :after #'gnus-patch:article-treat-patch) 10 | 11 | ;;; Message and smtp settings 12 | ;; 13 | ;; 14 | (setq user-mail-address "thievol@posteo.net") 15 | (setq user-full-name "Thierry Volpiatto") 16 | 17 | ;; Don't send to these addresses in wide reply. 18 | ;; See (info "(message) Wide Reply") 19 | (setq message-dont-reply-to-names 20 | '("notifications@github\\.com" 21 | ".*@noreply\\.github\\.com")) 22 | 23 | ;; Forward sent messages to myself. Posteo/Sent is therefore no more 24 | ;; synchronised, sent messages are copied to /sent locally. This have 25 | ;; the benefit of having all sent mails saved and encrypted on posteo 26 | ;; server. And if I really want to have my sent mails in /Posteo/Sent 27 | ;; I can create a filter on Posteo server to move my own emails to /Sent. 28 | (setq message-default-mail-headers (format "Bcc: %s\n" user-mail-address)) 29 | 30 | ;; [smtpmail-async] Experimental, use `smtpmail-send-it' otherwise. 31 | ;; To debug use `smtpmail-send-it' 32 | (setq message-send-mail-function 'smtpmail-send-it 33 | ;; smtpmail-debug-info t ; Uncomment to debug 34 | ;; smtpmail-debug-verb t ; Uncomment to debug on server 35 | mail-specify-envelope-from t ; Use from field to specify sender name. 36 | mail-envelope-from 'header) ; otherwise `user-mail-address' is used. 37 | 38 | ;; Default settings. 39 | (setq smtpmail-default-smtp-server "posteo.de" 40 | smtpmail-smtp-user user-mail-address 41 | smtpmail-smtp-server "posteo.de" 42 | smtpmail-smtp-service 587) 43 | 44 | (defun tv:message-mode-setup () 45 | ;; (setq tv:message-pre-winconf (current-window-configuration)) 46 | (setq fill-column 72) 47 | (turn-on-auto-fill) 48 | (epa-mail-mode 1) 49 | (define-key epa-mail-mode-map (kbd "C-c C-e l") 'helm-list-epg-keys)) 50 | (add-hook 'message-mode-hook 'tv:message-mode-setup) 51 | 52 | ;; Ne pas demander si on splitte les pa 53 | (setq message-send-mail-partially-limit nil) 54 | 55 | ;;; mm-* settings 56 | ;; 57 | (setq mm-file-name-rewrite-functions 58 | '(mm-file-name-delete-control 59 | mm-file-name-delete-gotchas 60 | mm-file-name-trim-whitespace 61 | mm-file-name-collapse-whitespace 62 | mm-file-name-replace-whitespace)) 63 | 64 | ;; Save mime parts 65 | (defun tv:gnus-mime-parts () 66 | (with-current-buffer gnus-article-buffer 67 | (save-excursion 68 | (goto-char (point-min)) 69 | (cl-loop while (not (eobp)) 70 | for part = (get-text-property (point) 'gnus-data) 71 | for index = (get-text-property (point) 'gnus-part) 72 | when (and part (numberp index)) 73 | collect (cons (or (mm-handle-filename part) 74 | (format "mime-part-%02d" index)) 75 | part) 76 | do (forward-line 1))))) 77 | 78 | (defun tv:gnus-save-mime-parts () 79 | (interactive nil gnus-summary-mode gnus-article-mode) 80 | (let* ((helm-comp-read-use-marked t) 81 | (parts (tv:gnus-mime-parts)) 82 | (files (completing-read "Save mime part(s): " (mapcar 'car parts) nil t))) 83 | (when files 84 | (dolist (f files) 85 | (mm-save-part-to-file 86 | (assoc-default f parts) (expand-file-name f mm-default-directory)))))) 87 | 88 | ;; We can't use directly `completing-read' because the signature of 89 | ;; `gnus-completing-read' which funcall this is not the same (missing predicate). 90 | (defun tv:gnus-emacs-completing-read (prompt collection &optional require-match 91 | _initial-input history def) 92 | "Call standard `completing-read-function'." 93 | (completing-read prompt collection nil require-match nil history def)) 94 | 95 | (with-eval-after-load 'gnus-sum 96 | (setq gnus-completing-read-function #'tv:gnus-emacs-completing-read)) 97 | 98 | ;; Html renderer (shr) 99 | (setq mm-text-html-renderer (if (fboundp 'w3m) 'w3m 'shr)) 100 | (setq shr-color-visible-luminance-min 75) 101 | (setq shr-use-colors nil) 102 | 103 | ;; I use C-c C-c to browse url and RET for scrolling. 104 | (with-eval-after-load 'shr 105 | (define-key shr-map (kbd "RET") nil)) 106 | 107 | (setq mm-inline-text-html-with-w3m-keymap nil 108 | mm-html-inhibit-images t 109 | gnus-inhibit-images t) 110 | 111 | ;; Default directory to save attached files 112 | (setq mm-default-directory "~/download/") 113 | 114 | ;;; Encryption 115 | ;; 116 | ;; Keybinding for signing/encrypting: 117 | ;; `C-c C-m s o' and `C-c C-m c o'. 118 | 119 | ;; To always sign emails 120 | ;; (add-hook 'message-setup-hook 'mml-secure-message-sign) 121 | ;; To always encrypt emails 122 | ;; (add-hook 'message-setup-hook 'mml-secure-message-encrypt) 123 | 124 | ;; force choosing key (completion). 125 | ;; (setq mm-encrypt-option 'guided) 126 | 127 | ;; `mml-secure-openpgp-encrypt-to-self' will encrypt to self only when 128 | ;; using mml* functions but not if for some reasons I use epa*, using 129 | ;; encrypt-to in gpg.conf ensure epa and mml encrypt to self. 130 | (setq mml-secure-openpgp-encrypt-to-self nil ; I use encrypt-to in gpg.conf. 131 | mml-secure-openpgp-sign-with-sender t 132 | mml-secure-openpgp-signers '("0EC56D141D16EF93") 133 | ) 134 | 135 | ;; Using 'known for `mm-verify-option' may hang mu4e or gnus forever 136 | ;; if the key is not found. 137 | (setq mm-verify-option 'known 138 | mm-decrypt-option 'known) 139 | 140 | ;;; Patchs 141 | ;; 142 | (defun tv:curl-url-retrieve (url) 143 | (with-temp-buffer 144 | (call-process "curl" nil t nil "-s" "-L" url) 145 | (buffer-string))) 146 | 147 | (defun tv:show-patch-other-frame (url) 148 | (let ((contents "") 149 | (bufname (file-name-nondirectory url))) 150 | (if (buffer-live-p (get-buffer bufname)) 151 | (progn (switch-to-buffer-other-frame bufname) 152 | (view-mode)) 153 | (setq contents (tv:curl-url-retrieve url)) 154 | (switch-to-buffer-other-frame (get-buffer-create bufname)) 155 | (erase-buffer) 156 | (save-excursion (insert contents)) 157 | (diff-mode) 158 | (view-mode)))) 159 | 160 | (defun tv:browse-url-or-show-patch (arg) 161 | (interactive "P" gnus-article-mode) 162 | (require 'helm-net) 163 | (let ((url (w3m-active-region-or-url-at-point))) 164 | (when url 165 | (if (string-match "\\.\\(patch\\|diff\\)\\'" url) 166 | (tv:show-patch-other-frame (if arg (concat url "?w=1") url)) 167 | (browse-url url))))) 168 | 169 | ;; For some reasons some mails have many null characters at the end, 170 | ;; most of the time these emails come from emacs developers. Seems 171 | ;; these bits come after decrypting mails. 172 | (defun tv:delete-null-chars-from-gnus () 173 | "Delete null characters in gnus article buffer. 174 | Such characters are represented by \"^@\" chars. 175 | They are most of the time at the end of mails sent with Gnus or Rmail. 176 | See https://en.wikipedia.org/wiki/Null_character." 177 | (save-excursion 178 | (let ((inhibit-read-only t)) 179 | (message-goto-body) 180 | ;; WARNING: (emacs bug#44486) 181 | ;; Using ^@ instead of \0 corrupt emacs-lisp buffers 182 | ;; containing special characters such as "à" and may be 183 | ;; others (unicode), this doesn't happen in lisp-interaction 184 | ;; buffers i.e. scratch. 185 | (while (re-search-forward "\0" nil t) 186 | (replace-match ""))))) 187 | (add-hook 'gnus-part-display-hook 'tv:delete-null-chars-from-gnus) 188 | 189 | (defun tv:autocrypt-import-key () 190 | "Import key from autocrypt header to gpg keyring. 191 | Try to import the key only if an autocrypt header is found and if 192 | sender is not one of `autocrypt-peers'. Called interactively with a 193 | prefix arg import the key even if sender is member of 194 | `autocrypt-peers'. 195 | 196 | Mu4e and Gnus hang forever when a key is not found and mail is 197 | signed. When this happen, importing the key from the autocrypt header, 198 | if one may help." 199 | (interactive) 200 | (require 'epg) 201 | ;; `message-fetch-field' removes the newlines, so use `mail-fetch-field'. 202 | (let ((data (mail-fetch-field "Autocrypt" nil t)) 203 | (from (message-sendmail-envelope-from))) 204 | (when data 205 | (with-temp-buffer 206 | (insert data) 207 | (goto-char (point-min)) 208 | (delete-region (point-at-bol) (point-at-eol)) 209 | (insert "-----BEGIN PGP PUBLIC KEY BLOCK-----\n") 210 | (goto-char (point-max)) 211 | (insert "\n-----END PGP PUBLIC KEY BLOCK-----") 212 | (tv:epg-import-keys-region (point-min) (point-max)))))) 213 | ;; (add-hook 'gnus-article-decode-hook 'tv:autocrypt-import-key) 214 | 215 | (defun tv:epg-import-keys-region (start end) 216 | "Same as `epa-import-keys-region' but less verbose and BTW faster." 217 | (let ((context (epg-make-context epa-protocol))) 218 | (message "Autocrypt importing gpg key...") 219 | (condition-case err 220 | (progn 221 | (epg-import-keys-from-string context (buffer-substring start end)) 222 | (message "Autocrypt importing gpg key done")) 223 | (error "Importing from autocrypt failed: %s" (cadr err))))) 224 | 225 | (defun tv:remove-cr () 226 | (when (save-excursion 227 | (message-goto-body) 228 | (re-search-forward "\C-m$" nil t)) 229 | (article-remove-cr))) 230 | (add-hook 'gnus-part-display-hook 'tv:remove-cr) 231 | 232 | 233 | (provide 'mail-config) 234 | 235 | ;;; mail-config.el ends here 236 | -------------------------------------------------------------------------------- /org-config.el: -------------------------------------------------------------------------------- 1 | ;;; org-config.el --- My config for org -*- lexical-binding: t -*- 2 | ;; 3 | 4 | ;;; Code: 5 | 6 | (setq org-directory "~/org") 7 | 8 | ;; auto-fill-mode 9 | ;; (set to 78 in files) 10 | (add-hook 'org-mode-hook 'auto-fill-mode) 11 | 12 | ;; Use-enter-to-follow-links 13 | (setq org-return-follows-link t) 14 | 15 | (add-to-list 'auto-mode-alist '("\\.org\\'" . org-mode)) 16 | (setq org-agenda-files '("~/org")) 17 | 18 | ;; Todo-rules 19 | ;; (find-node "(org)Fast access to TODO states") 20 | (setq org-todo-keywords 21 | '((sequence "TODO(t)" "|" "INPROGRESS(i)" "DONE(d)" "CANCELED(c)" "DEFERRED(s)"))) 22 | 23 | (setq org-todo-keyword-faces 24 | '(("TODO" . ((:foreground "red"))) 25 | ("INPROGRESS" . ((:foreground "yellow"))) 26 | ("BUGREPORT" . ((:foreground "VioletRed4" :weight bold))) 27 | ("FIXED" . ((:foreground "SpringGreen4" :weight bold))) 28 | ("DEFERRED" . shadow) 29 | ("CANCELED" . ((:foreground "blue" :weight bold))))) 30 | 31 | (setq org-log-done 'time) 32 | (setq org-use-fast-todo-selection t) 33 | (setq org-reverse-note-order t) 34 | 35 | ;; Tags-setting 36 | ;; (info "(org)Setting tags") 37 | 38 | (setq org-tag-alist '(("entrainement") 39 | ("climbing") 40 | ("equipement") 41 | ("running") 42 | ("bike") 43 | ("vtt") 44 | ("montagne") 45 | ("cascade") 46 | ("ski") 47 | ("github") 48 | ("helm") 49 | ("async") 50 | ("crypt") 51 | ("home") 52 | ("travel"))) 53 | 54 | ;; org-capture 55 | (setq org-default-notes-file (expand-file-name "notes.org" org-directory) 56 | org-capture-use-agenda-date t) 57 | (setq org-capture-templates 58 | '(("t" "Todo" entry (file+headline "~/org/agenda.org" "Tasks") "** TODO %?\n %i\n %a" :prepend t) 59 | ("n" "Notes" entry (file+headline "~/org/notes.org" "General") "** %^{Title}\n %i\n %a" :prepend t) 60 | ("h" "Helm" entry (file+headline "~/org/notes.org" "Helm") "** %^{Title}\n %i\n %a" :prepend t) 61 | ("e" "Emacs" entry (file+headline "~/org/notes.org" "Emacs") "** %^{Title}\n %i\n %a" :prepend t) 62 | ("l" "Lisp" entry (file+headline "~/org/notes.org" "Elisp") "** %^{Title}\n %i\n %a" :prepend t) 63 | ("p" "Python" entry (file+headline "~/org/notes.org" "Python") "** %^{Title}\n %i\n %a" :prepend t) 64 | ("b" "Bash" entry (file+headline "~/org/notes.org " "Bash") "** %^{Title}\n %i\n %a" :prepend t) 65 | ("L" "Linux" entry (file+headline "~/org/notes.org" "Linux") "** %^{Title}\n %i\n %a" :prepend t))) 66 | 67 | ;; Diary-integration-in-org 68 | (setq org-agenda-include-diary t) 69 | 70 | (defun tv:insert-org-src-keyword () 71 | (interactive) 72 | (if (region-active-p) 73 | (let ((beg (region-beginning)) 74 | (end (region-end))) 75 | (goto-char beg) 76 | (forward-line -1) 77 | (insert "#+begin_src ") 78 | (save-excursion 79 | ;; (insert "\n") 80 | (goto-char end) 81 | (end-of-line) 82 | (insert "\n#+end_src"))) 83 | (insert "#+begin_src ") 84 | (save-excursion (insert "\n#+end_src")))) 85 | 86 | (defun tv:org-headings (arg) 87 | (interactive "P") 88 | (if (eq major-mode 'org-mode) 89 | (helm-org-in-buffer-headings arg) 90 | (helm-org-agenda-files-headings arg))) 91 | 92 | (add-hook 'org-mode-hook 93 | (lambda () 94 | (define-key org-mode-map (kbd " o") 'tv:org-headings) 95 | (define-key org-mode-map (kbd " k") 'tv:insert-org-src-keyword))) 96 | 97 | ;; org-crypt 98 | (org-crypt-use-before-save-magic) 99 | (setq org-crypt-key "08FDB07A7433A7F2") 100 | (setq org-crypt-disable-auto-save t) 101 | (define-key org-mode-map (kbd "C-c e") 'org-encrypt-entry) 102 | (define-key org-mode-map (kbd "C-c d") 'org-decrypt-entry) 103 | 104 | ;; Always show full path of files 105 | (setq org-link-file-path-type 'absolute) 106 | 107 | (setq org-show-context-detail '((default . local))) 108 | 109 | (define-key org-mode-map (kbd "") 'tv:scroll-up) 110 | (define-key org-mode-map (kbd "") 'tv:scroll-down) 111 | (define-key org-mode-map (kbd "") 'tv:scroll-other-up) 112 | (define-key org-mode-map (kbd "") 'tv:scroll-other-down) 113 | (define-key org-mode-map (kbd "C-d") 'tv:delete-char) 114 | (define-key org-mode-map (kbd "") nil) 115 | (define-key org-mode-map (kbd "C-,") nil) 116 | (define-key org-mode-map (kbd "") nil) 117 | (define-key org-mode-map (kbd "") nil) 118 | (define-key org-mode-map (kbd "") nil) 119 | (define-key org-mode-map (kbd "C-c C-i") 'org-table-insert-row) 120 | 121 | ;; Disable org-persist 122 | (when (> emacs-major-version 28) 123 | (with-eval-after-load 'org-persist 124 | (setq org-element-cache-persistent nil) 125 | ;; Thanks Colin! 126 | (defun zz/advice--org-persist (old-fn &rest args) 127 | (let (user-init-file) 128 | (apply old-fn args))) 129 | (advice-add 'org-persist-clear-storage-maybe :around #'zz/advice--org-persist) 130 | (when org-persist--refresh-gc-lock-timer 131 | (cancel-timer org-persist--refresh-gc-lock-timer)))) 132 | 133 | (provide 'org-config) 134 | 135 | ;;; org-config.el ends here 136 | -------------------------------------------------------------------------------- /tv-byzanz.el: -------------------------------------------------------------------------------- 1 | ;;; tv-byzanz.el --- Record Emacs screencast with byzanz. -*- lexical-binding: t -*- 2 | ;; 3 | 4 | ;;; Code: 5 | 6 | (defgroup byzanz-record nil "Record screencast." 7 | :group 'multimedia) 8 | 9 | ;;;###autoload 10 | (defun byzanz-record (file) 11 | "Record a screencast with byzanz." 12 | (interactive "FRecord to file: ") 13 | (let* ((height (number-to-string (+ (frame-pixel-height) 14 | ;; minibuf+mode-line 15 | 40))) 16 | (width (number-to-string (frame-pixel-width))) 17 | (process (start-process "byzanz" "*byzanz log*" 18 | "byzanz-record" 19 | "--exec=sleep 1000000" 20 | "--delay=5" 21 | "-c" "-w" width "-h" height file))) 22 | (byzanz-record-mode 1) 23 | (set-process-sentinel 24 | process (lambda (_proc event) 25 | (when (string= event "finished\n") 26 | (byzanz-record-mode -1) 27 | (message "Screencast recorded to `%s'" file)))))) 28 | 29 | (defun byzanz-record-stop () 30 | "Stop byzanz recording. 31 | Don't bind this to global-map but to `byzanz-record-mode-map' instead." 32 | (interactive) 33 | (call-process "killall" nil nil nil "sleep")) 34 | 35 | (defvar byzanz-record-mode-map 36 | (let ((map (make-sparse-keymap))) 37 | (define-key map (kbd "S-") 'byzanz-record-stop) 38 | map)) 39 | 40 | (define-minor-mode byzanz-record-mode 41 | "A minor mode to stop byzanz-record." 42 | :group 'byzanz-record 43 | :global t 44 | (message "Byzanz started recording, hit `S-' to stop")) 45 | (put 'byzanz-record-mode 'no-helm-mx t) 46 | 47 | (provide 'tv-byzanz) 48 | 49 | ;;; tv-byzanz.el ends here 50 | -------------------------------------------------------------------------------- /tv-save-place.el: -------------------------------------------------------------------------------- 1 | ;;; tv-save-place.el --- Save places. -*- lexical-binding: t -*- 2 | ;; 3 | 4 | ;;; Commentary: 5 | 6 | ;; A simple replacement of saveplace.el 7 | 8 | ;;; Code: 9 | 10 | (eval-when-compile (require 'cl-lib)) 11 | 12 | ;; Places are saved and restored by psession! 13 | (defvar tv-save-place-cache (make-hash-table :test 'equal)) 14 | (defvar tv-save-place-ignore-file-regexps '("\\.git/" "-autoloads.el\\'")) 15 | (defun tv-save-place () 16 | (let ((file (buffer-file-name)) 17 | pos) 18 | (when (and file 19 | (cl-loop for re in tv-save-place-ignore-file-regexps 20 | never (string-match re file))) 21 | (widen) 22 | (setq pos (point)) 23 | (unless (<= pos 1) 24 | (puthash file pos tv-save-place-cache))))) 25 | 26 | (defun tv-save-place-refresh-cache () 27 | (cl-loop for k being the hash-keys of tv-save-place-cache 28 | using (hash-values v) 29 | for buf = (get-buffer (file-name-nondirectory k)) 30 | when (buffer-live-p buf) 31 | do (with-current-buffer buf 32 | (unless (eq (point) v) 33 | (tv-save-place))))) 34 | 35 | (defun tv-save-place-restore-pos () 36 | (let* ((file (buffer-file-name)) 37 | (pos (gethash file tv-save-place-cache))) 38 | (when pos (goto-char pos)))) 39 | 40 | ;;;###autoload 41 | (define-minor-mode tv-save-place-mode 42 | "Save position in files." 43 | :group 'convenience 44 | :global t 45 | (if tv-save-place-mode 46 | (progn 47 | (add-hook 'kill-buffer-hook 'tv-save-place) 48 | (add-hook 'before-revert-hook 'tv-save-place) 49 | (add-hook 'find-file-hook 'tv-save-place-restore-pos 100) 50 | (add-hook 'kill-emacs-hook 'tv-save-place-refresh-cache)) 51 | (remove-hook 'kill-buffer-hook 'tv-save-place) 52 | (remove-hook 'before-revert-hook 'tv-save-place) 53 | (remove-hook 'find-file-hook 'tv-save-place-restore-pos) 54 | (remove-hook 'kill-emacs-hook 'tv-save-place-refresh-cache))) 55 | 56 | (provide 'tv-save-place.el) 57 | 58 | ;;; tv-save-place.el ends here 59 | -------------------------------------------------------------------------------- /tv-utils.el: -------------------------------------------------------------------------------- 1 | ;;; tv-utils.el --- Some useful functions for Emacs. -*- lexical-binding: t -*- 2 | ;; 3 | 4 | ;;; Code: 5 | 6 | (require 'cl-lib) 7 | 8 | (declare-function helm-find-files-1 "ext:helm-files.el") 9 | (declare-function mailcap-extension-to-mime "mailcap.el") 10 | (declare-function calendar-exit "calendar.el") 11 | (declare-function helm-region-active-p "ext:helm-lib.el") 12 | (declare-function helm-basename "ext:helm-lib.el") 13 | (declare-function helm-read-file-name "ext:helm-mode.el") 14 | (declare-function common-lisp-indent-function-1 "cl-indent.el") 15 | (declare-function tv:get-disk-info "ext:dired-extension.el") 16 | (declare-function iterator:circular "ext:iterator.el") 17 | (declare-function iterator:next "ext:iterator.el") 18 | (declare-function helm-fast-remove-dups "ext:helm-lib.el") 19 | (declare-function auth-source-search "auth-source.el") 20 | (declare-function eshell-interactive-process "esh-cmd.el") 21 | (declare-function which-function "which-func.el") 22 | (declare-function tramp-get-completion-function "tramp") 23 | (declare-function help--symbol-completion-table "help-fns.el") 24 | (declare-function org-agenda-mode "org-agenda.el") 25 | (declare-function message-goto-to "message.el") 26 | (declare-function message-insert-header "message.el") 27 | (declare-function message-goto-subject "message.el") 28 | (declare-function help-fns-short-filename "help-fns.el") 29 | (declare-function help-fns--run-describe-functions "help-fns.el") 30 | 31 | (defvar tramp-methods) 32 | (defvar help-fns-describe-variable-functions) 33 | (defvar Info-current-file) 34 | (defvar Info-current-node) 35 | ;;; Sshfs 36 | ;; 37 | ;; 38 | ;;;###autoload 39 | (defun tv:mount-sshfs (&optional arg) 40 | (interactive "P") 41 | (require 'tramp) 42 | (let* ((user (if arg 43 | (read-string "User name: ") 44 | (getenv "USER"))) 45 | (host (completing-read 46 | "Host: " 47 | (delete-dups 48 | (cl-loop with all-methods = (mapcar 'car tramp-methods) 49 | for (f . h) in (tramp-get-completion-function "ssh") 50 | append (cl-loop for e in (funcall f (car h)) 51 | for host = (and (consp e) (cadr e)) 52 | ;; On emacs-27 host may be 53 | ;; ("root" t) in sudo method. 54 | when (and (stringp host) 55 | (not (member host all-methods))) 56 | collect host))))) 57 | (fs (concat host ":/home/" user)) 58 | (mp (concat "~/sshfs/" user))) 59 | (unless (file-directory-p mp) 60 | (make-directory mp t)) 61 | (if (> (length (directory-files 62 | mp nil directory-files-no-dot-files-regexp)) 63 | 0) 64 | (message "Directory %s is busy, mountsshfs aborted" mp) 65 | (if (= (call-process-shell-command 66 | (format "sshfs %s %s" fs mp)) 67 | 0) 68 | (message "%s Mounted successfully on %s" fs mp) 69 | (message "Failed to mount remote filesystem %s on %s" fs mp))))) 70 | 71 | ;;;###autoload 72 | (defun tv:umount-sshfs () 73 | (interactive) 74 | (let ((mp (read-directory-name "Mount point: " "~/sshfs"))) 75 | (if (file-equal-p default-directory mp) 76 | (message "Filesystem is busy can't umount!") 77 | (if (>= (length (cddr (directory-files mp))) 0) 78 | (if (= (call-process-shell-command 79 | (format "fusermount -u %s" mp)) 80 | 0) 81 | (message "%s Successfully unmounted" mp) 82 | (message "Failed to unmount %s" mp)) 83 | (message "No existing remote filesystem to unmount!"))))) 84 | 85 | ;;; move-to-window-line 86 | ;; 87 | ;;;###autoload 88 | (defun screen-top (&optional n) 89 | "Move the point to the top of the screen." 90 | (interactive "p") 91 | (move-to-window-line (or n 0))) 92 | 93 | ;;;###autoload 94 | (defun screen-bottom (&optional n) 95 | "Move the point to the bottom of the screen." 96 | (interactive "P") 97 | (move-to-window-line (- (prefix-numeric-value n)))) 98 | 99 | ;;; switch-other-window 100 | ;; 101 | ;;;###autoload 102 | (defun other-window-backward (&optional n) 103 | "Move backward to other window or frame." 104 | (interactive "p") 105 | (other-window (- n) 0) 106 | (select-frame-set-input-focus (selected-frame))) 107 | 108 | ;;;###autoload 109 | (defun other-window-forward (&optional n) 110 | "Move to other window or frame. 111 | With a prefix arg move N window forward or backward 112 | depending the value of N is positive or negative." 113 | (interactive "p") 114 | (other-window n 0) 115 | (select-frame-set-input-focus (selected-frame))) 116 | 117 | ;;; Eval-region 118 | ;; 119 | ;; 120 | ;;;###autoload 121 | (defun tv:eval-region (beg end) 122 | (interactive "r") 123 | (let ((str (buffer-substring beg end)) 124 | expr 125 | store) 126 | (with-temp-buffer 127 | (save-excursion 128 | (insert str)) 129 | (condition-case _err 130 | (while (setq expr (read (current-buffer))) 131 | (push (eval expr) store)) 132 | (end-of-file nil))) 133 | (message "Evaluated in Region:\n- %s" 134 | (mapconcat 'identity 135 | (mapcar #'(lambda (x) 136 | (format "`%s'" x)) 137 | (reverse store)) 138 | "\n- ")))) 139 | 140 | ;; key-for-calendar 141 | (defvar tv:calendar-alive nil) 142 | ;;;###autoload 143 | (defun tv:toggle-calendar () 144 | (interactive) 145 | (if tv:calendar-alive 146 | (when (get-buffer "*Calendar*") 147 | (with-current-buffer "diary" (save-buffer)) 148 | (calendar-exit)) ; advice reset win conf 149 | ;; In case calendar were called without toggle command 150 | (unless (get-buffer-window "*Calendar*") 151 | (setq tv:calendar-alive (current-window-configuration)) 152 | (calendar)))) 153 | 154 | (defun tv:advice-calendar-exit (&rest _args) 155 | (when tv:calendar-alive 156 | (set-window-configuration tv:calendar-alive) 157 | (setq tv:calendar-alive nil))) 158 | 159 | (advice-add 'calendar-exit :after #'tv:advice-calendar-exit) 160 | 161 | ;;; Insert-pairs 162 | ;; 163 | (setq parens-require-spaces t) 164 | 165 | ;;;###autoload 166 | (defun tv:insert-double-quote (&optional arg) 167 | (interactive "P") 168 | (insert-pair arg ?\" ?\")) 169 | 170 | ;;;###autoload 171 | (defun tv:insert-double-backquote (&optional arg) 172 | (interactive "P") 173 | (insert-pair arg ?\` (if (or (eq major-mode 'emacs-lisp-mode) 174 | (eq major-mode 'lisp-interaction-mode)) 175 | ?\' ?\`))) 176 | 177 | ;;;###autoload 178 | (defun tv:insert-vector (&optional arg) 179 | (interactive "P") 180 | (insert-pair arg ?\[ ?\])) 181 | 182 | ;;;###autoload 183 | (defun tv:move-pair-forward (beg end) 184 | (interactive "r") 185 | (if (region-active-p) 186 | (progn (goto-char beg) (insert "(") 187 | (goto-char (1+ end)) (insert ")")) 188 | (let ((timer (run-with-idle-timer 189 | 5 nil (lambda () (keyboard-quit)))) 190 | action kb com) 191 | (unwind-protect 192 | (catch 'break 193 | (while t 194 | (setq action (read-key 195 | (propertize 196 | "`(': Enclose forward, (any key to exit)." 197 | 'face 'minibuffer-prompt))) 198 | (cl-case action 199 | (?\( 200 | (skip-chars-forward " \n") 201 | (insert "(") 202 | (forward-sexp 1) 203 | (insert ")")) 204 | (t (setq kb (this-command-keys-vector)) 205 | (setq com (lookup-key (current-local-map) kb)) 206 | (if (commandp com) 207 | (call-interactively com) 208 | (setq unread-command-events 209 | (nconc (mapcar 'identity 210 | (this-single-command-raw-keys)) 211 | unread-command-events))) 212 | (throw 'break nil))))) 213 | (cancel-timer timer))))) 214 | 215 | ;;;###autoload 216 | (defun tv:insert-pair-and-close-forward (beg end) 217 | (interactive "r") 218 | (if (region-active-p) 219 | (progn (goto-char beg) (insert "(") 220 | (goto-char (1+ end)) (insert ")")) 221 | (let ((timer (run-with-idle-timer 222 | 5 nil (lambda () (keyboard-quit)))) 223 | action kb com) 224 | (unless (looking-back "(" (1- (point))) (insert "(")) 225 | (unwind-protect 226 | (catch 'break 227 | (while t 228 | (setq action (read-key 229 | (propertize 230 | "`)': Move forward, (any key to exit)." 231 | 'face 'minibuffer-prompt))) 232 | (cl-case action 233 | (?\) 234 | (unless (looking-back "(" (1- (point))) 235 | (delete-char -1)) 236 | (skip-chars-forward " ") 237 | (if (looking-at "(") 238 | (forward-sexp 1) (forward-symbol 1)) 239 | ;; move forward in a list of strings 240 | (skip-chars-forward "\"") 241 | (insert ")")) 242 | (t (setq kb (this-command-keys-vector)) 243 | (setq com (lookup-key (current-local-map) kb)) 244 | (if (commandp com) 245 | (call-interactively com) 246 | (setq unread-command-events 247 | (nconc (mapcar 'identity 248 | (this-single-command-raw-keys)) 249 | unread-command-events))) 250 | (throw 'break nil))))) 251 | (cancel-timer timer))))) 252 | 253 | ;;;###autoload 254 | (defun tv:insert-double-quote-and-close-forward (beg end) 255 | (interactive "r") 256 | (if (region-active-p) 257 | (progn (goto-char beg) (insert "\"") 258 | (goto-char (1+ end)) (insert "\"")) 259 | (let (action kb com 260 | (prompt (and (not (minibufferp)) 261 | "\": Insert, (any key to exit)."))) 262 | (unless prompt (message "\": Insert, (any key to exit).")) 263 | (catch 'break 264 | (while t 265 | (setq action (read-key prompt)) 266 | (cl-case action 267 | (?\" 268 | (skip-chars-forward " \n") 269 | (insert "\"") 270 | (forward-sexp 1) 271 | (insert "\"")) 272 | (t (setq kb (this-command-keys-vector)) 273 | (setq com (lookup-key (current-local-map) kb)) 274 | (if (commandp com) 275 | (call-interactively com) 276 | (setq unread-command-events 277 | (nconc (mapcar 'identity 278 | (this-single-command-raw-keys)) 279 | unread-command-events))) 280 | (throw 'break nil)))))))) 281 | 282 | ;; Kill-backward 283 | ;;;###autoload 284 | (defun tv:kill-whole-line (&optional arg) 285 | "Similar to `kill-whole-line' but don't kill new line. 286 | Also alow killing whole line in a shell prompt without trying 287 | to kill prompt. 288 | When called non interactively, do not delete empty line. 289 | Can be used from any place in the line." 290 | (interactive "p") 291 | (end-of-line) 292 | (let ((end (point)) beg) 293 | (forward-line 0) 294 | (while (get-text-property (point) 'read-only) 295 | (forward-char 1)) 296 | (setq beg (point)) (kill-region beg end)) 297 | (when (and arg (eq (point-at-bol) (point-at-eol))) 298 | (delete-blank-lines) (skip-chars-forward " "))) 299 | 300 | ;; Kill-line 301 | ;;;###autoload 302 | (defun tv:kill-line () 303 | "Like kill-line but when at eol delete whole line. 304 | Ignore text read-only at bol i.e. prompts." 305 | (interactive) 306 | (if (eolp) 307 | (tv:kill-whole-line) 308 | (kill-line))) 309 | 310 | ;; Delete-char-or-region 311 | ;;;###autoload 312 | (defun tv:delete-char (arg) 313 | (interactive "p") 314 | (if (helm-region-active-p) 315 | (delete-region (region-beginning) (region-end)) 316 | (delete-char arg))) 317 | 318 | ;; Check paren errors 319 | ;;;###autoload 320 | (defun tv:check-paren-error () 321 | (interactive) 322 | (require 'pulse) 323 | (catch 'noerror 324 | (condition-case err 325 | (save-excursion 326 | (goto-char (point-min)) 327 | (scan-sexps (point-min) 9999999) 328 | (throw 'noerror (message "No paren error found"))) 329 | (scan-error 330 | (goto-char (caddr err)) 331 | (pulse-momentary-highlight-region (pos-bol) (pos-eol)) 332 | (message "Unbalanced parens around line %s" 333 | (line-number-at-pos)))))) 334 | 335 | ;; Easypg 336 | (defvar epa-armor) 337 | ;;;###autoload 338 | (defun epa-sign-to-armored () 339 | "Create a .asc file." 340 | (interactive) 341 | (let ((epa-armor t)) 342 | (call-interactively 'epa-sign-file))) 343 | 344 | ;; Same as above but usable as alias in eshell 345 | ;;;###autoload 346 | (defun gpg-sign-to-armored (file) 347 | "Create a .asc file." 348 | (let ((epa-armor t)) 349 | (epa-sign-file file nil nil))) 350 | 351 | ;; Usable from eshell as alias 352 | ;;;###autoload 353 | (defun gpg-sign-to-sig (file) 354 | "Create a .sig file." 355 | (epa-sign-file file nil 'detached)) 356 | 357 | ;;;###autoload 358 | (defun tv:gpg-verify-file (gpg-file) 359 | "Meant to be used from eshell alias. 360 | alias gpg-verify tv:gpg-verify-file $1" 361 | (let ((data-file (directory-files 362 | (file-name-directory (expand-file-name gpg-file)) t 363 | (concat (regexp-quote (helm-basename gpg-file t)) "$")))) 364 | (cl-assert (member (file-name-extension gpg-file) '("gpg" "sig" "asc")) 365 | nil "Please select the signed file not the data file") 366 | (cl-assert (null (cdr data-file)) nil "Failed to find data-file") 367 | (setq data-file (car data-file)) 368 | (with-temp-buffer 369 | (if (= (call-process "gpg" nil t nil "--verify" gpg-file data-file) 0) 370 | (buffer-string) 371 | "Gpg error while verifying signature")))) 372 | 373 | ;; Switch indenting lisp style. 374 | ;;;###autoload 375 | (defun toggle-lisp-indent () 376 | (interactive) 377 | (if (memq lisp-indent-function '(common-lisp-indent-function 378 | common-lisp-indent-function-1)) 379 | (progn 380 | (setq lisp-indent-function #'lisp-indent-function) 381 | (message "Switching to Emacs lisp indenting style.")) 382 | (setq lisp-indent-function #'common-lisp-indent-function-1) 383 | (message "Switching to Common lisp indenting style."))) 384 | 385 | ;;; Generate strong passwords. 386 | ;; 387 | (defun tv:shuffle-sequence (seq) 388 | (cl-loop for i from (1- (length seq)) downto 1 389 | do (cl-rotatef (elt seq i) (elt seq (random i))) 390 | finally return seq)) 391 | 392 | ;;;###autoload 393 | (cl-defun tv:genpasswd-1 (&optional (limit 12)) 394 | "Generate strong password of length LIMIT. 395 | LIMIT should be a number divisible by 2, otherwise 396 | the password will be of length (floor LIMIT)." 397 | (cl-loop with alph = ["a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" 398 | "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" 399 | "w" "x" "y" "z" "A" "B" "C" "D" "E" "F" "G" 400 | "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" 401 | "S" "T" "U" "V" "W" "X" "Y" "Z"] 402 | with signs = ["$" "@" "&" "+" "-" "/" "#" "_" "?" "!"] 403 | ;; Divide by 2 because collecting 2 list. 404 | for i from 1 to (floor (/ limit 2)) 405 | for rand1 = (int-to-string (random 9)) 406 | for signsindex = (random (length signs)) 407 | for alphaindex = (random (length alph)) 408 | for rand2 = (aref (tv:shuffle-sequence alph) alphaindex) 409 | for rand3 = (aref (tv:shuffle-sequence signs) signsindex) 410 | ;; Collect a random number between O-9 411 | concat rand1 into ls 412 | ;; collect a random alpha between a-zA-Z. 413 | concat rand2 into ls 414 | concat rand3 into ls 415 | finally return ls)) 416 | 417 | ;;;###autoload 418 | (defun tv:genpasswd (arg) 419 | "Generate a random password of (max 8 ARG) chars. 420 | Use a prefix arg to specify ARG." 421 | (interactive "p") 422 | (let ((newpwd (tv:genpasswd-1 (max 8 arg)))) 423 | (kill-new newpwd) 424 | (message "New pwd `%s' saved to kill ring" newpwd))) 425 | 426 | ;;;###autoload 427 | (defun tv:gen-socgen-passwd () 428 | "Generate a random password of 6 numbers." 429 | (interactive) 430 | (let ((code (mapconcat (lambda (x) (number-to-string x)) 431 | (cl-loop with randoms = nil 432 | while (not (= (length randoms) 6)) 433 | for random = (random 9) 434 | unless (member random randoms) 435 | do (push random randoms) 436 | finally return randoms) 437 | ""))) 438 | (kill-new code) 439 | (message "`%s' copied to kill-ring" code))) 440 | 441 | ;;; Toggle split window vertically/horizontally 442 | ;; 443 | (defvar helm-alive-p) 444 | ;;;###autoload 445 | (defun tv:toggle-window-split () 446 | (interactive) 447 | (unless helm-alive-p 448 | (if (= (length (window-list)) 2) 449 | (let ((buf (current-buffer)) 450 | before-height) 451 | (with-current-buffer buf 452 | (setq before-height (window-height)) 453 | (delete-window) 454 | (set-window-buffer 455 | (select-window (if (= (window-height) before-height) 456 | (split-window-vertically) 457 | (split-window-horizontally))) 458 | buf))) 459 | (user-error "Can toggle split only with two windows")))) 460 | (global-set-key (kbd "C-x C-'") 'tv:toggle-window-split) 461 | 462 | ;;; Rotate windows 463 | ;; 464 | ;; 465 | ;;;###autoload 466 | (defun tv:rotate-windows () 467 | (interactive) 468 | (require 'iterator) 469 | (cl-assert (> (length (window-list)) 1) 470 | nil "Error: Can't rotate with a single window") 471 | (unless helm-alive-p 472 | (cl-loop with wlist1 = (iterator:circular (window-list)) 473 | with wlist2 = (iterator:circular (cdr (window-list))) 474 | with len = (length (window-list)) 475 | for count from 1 476 | for w1 = (iterator:next wlist1) 477 | for b1 = (window-buffer w1) 478 | for s1 = (window-start w1) 479 | for w2 = (iterator:next wlist2) 480 | for b2 = (window-buffer w2) 481 | for s2 = (window-start w2) 482 | while (< count len) 483 | do (progn (set-window-buffer w1 b2) 484 | (set-window-start w1 s2) 485 | (set-window-buffer w2 b1) 486 | (set-window-start w2 s1))))) 487 | (global-set-key (kbd "C-c -") 'tv:rotate-windows) 488 | 489 | ;;;###autoload 490 | (defun tv:kill-kbd (key) 491 | (interactive "kKill `kbd' form: ") 492 | (kill-new (message "(kbd \"%s\")" (help-key-description key nil))) 493 | (message nil)) 494 | 495 | ;;;###autoload 496 | (defun tv:insert-kbd-at-point (key) 497 | (interactive "kInsert `kbd' form: ") 498 | (insert (format "(kbd \"%s\")" (help-key-description key nil))) 499 | (message nil)) 500 | 501 | (cl-defun tv:get-passwd-from-auth-sources (host &key user port) 502 | "Retrieve a password for auth-info file. 503 | Arg `host' is machine in auth-info file." 504 | (let* ((token (auth-source-search :host host :port port :user user)) 505 | (secret (plist-get (car token) :secret))) 506 | (if (functionp secret) (funcall secret) secret))) 507 | 508 | ;; Avoid typing password for sudo in eshell 509 | (defun tv:advice--eshell-send-invisible () 510 | (interactive) ; Don't pass str as argument, to avoid snooping via C-x ESC ESC 511 | (let ((str (read-passwd 512 | (format "%s Password: " 513 | (process-name (eshell-interactive-process))) 514 | nil (tv:get-passwd-from-auth-sources 515 | "default" :user "root" :port "sudo")))) 516 | (if (stringp str) 517 | (process-send-string (eshell-interactive-process) 518 | (concat str "\n")) 519 | (message "Warning: text will be echoed")))) 520 | 521 | ;;; Scroll functions 522 | ;;;###autoload 523 | (defun tv:scroll-down () 524 | (interactive) 525 | (scroll-down -1)) 526 | ;;;###autoload 527 | (defun tv:scroll-up () 528 | (interactive) 529 | (scroll-down 1)) 530 | ;;;###autoload 531 | (defun tv:scroll-other-down () 532 | (interactive) 533 | (scroll-other-window 1)) 534 | ;;;###autoload 535 | (defun tv:scroll-other-up () 536 | (interactive) 537 | (scroll-other-window -1)) 538 | 539 | ;;;###autoload 540 | (defun tv:restore-scratch-buffer () 541 | (unless (buffer-file-name (get-buffer "*scratch*")) 542 | (and (get-buffer "*scratch*") (kill-buffer "*scratch*"))) 543 | (with-current-buffer (find-file-noselect "~/.emacs.d/save-scratch.el") 544 | (rename-buffer "*scratch*") 545 | (lisp-interaction-mode) 546 | (setq lexical-binding t) 547 | (use-local-map lisp-interaction-mode-map)) 548 | (when (or (eq (point-min) (point-max)) 549 | ;; For some reason the scratch buffer have not a zero size. 550 | (<= (buffer-size) 2)) 551 | (insert ";;; -*- coding: utf-8; mode: lisp-interaction; lexical-binding: t -*-\n;;\n;; SCRATCH BUFFER\n;; ==============\n\n"))) 552 | 553 | ;;;###autoload 554 | (defun tv:insert-info-command-from-current-node-at-point () 555 | (interactive) 556 | (require 'info) 557 | (let ((buf (get-buffer "*info*"))) 558 | (when (and buf (buffer-live-p buf)) 559 | (insert 560 | (with-current-buffer "*info*" 561 | (format "(info \"(%s) %s\")" 562 | (file-name-nondirectory Info-current-file) 563 | Info-current-node)))))) 564 | 565 | (defun tv:get-headers-from-string (str) 566 | "Return a list of headers from a mailto link." 567 | (with-temp-buffer 568 | (let (result 569 | (beg 1)) 570 | (save-excursion 571 | (insert 572 | (url-unhex-string str))) 573 | (while (re-search-forward "\\?\\|&" nil t) 574 | (push (buffer-substring-no-properties beg (match-beginning 0)) 575 | result) 576 | (setq beg (match-end 0))) 577 | (unless (eobp) 578 | (push (buffer-substring-no-properties beg (point-max)) 579 | result)) 580 | (nreverse result)))) 581 | 582 | (defun tv:insert-headers-from-string (str) 583 | "Add headers from STR in message buffer. 584 | Used by the Mailto script used from firefox." 585 | (require 'message) 586 | (cl-loop for header in (tv:get-headers-from-string str) 587 | for h = (split-string header "=") 588 | if (cdr h) 589 | do (let ((fn (intern (format "message-goto-%s" (car h))))) 590 | (if (fboundp fn) 591 | (progn (funcall fn) 592 | (insert (format "%s" (cadr h)))) 593 | (insert "\n") 594 | (message-insert-header (intern (car h)) (format "%s" (cadr h))))) 595 | else 596 | do (progn (message-goto-to) 597 | (insert (format "%s" (car h))))) 598 | (message-goto-subject)) 599 | 600 | (defun tv:diametre-plateau (holes dist) 601 | "Return the diameter of crankset with HOLES number separated by DIST mm. 602 | E.g. TROUS=5 and DIST=64.7 => 110" 603 | (let ((L2 (/ dist 2))) 604 | (floor 605 | (* 2 (sqrt 606 | (+ (expt L2 2) 607 | (expt (/ L2 (tan (degrees-to-radians (/ 180 holes)))) 2))))))) 608 | 609 | ;;;###autoload 610 | (defun tv:align-let () 611 | "Align let forms." 612 | (interactive) 613 | (let ((sexp (thing-at-point 'sexp t)) 614 | (bounds (bounds-of-thing-at-point 'sexp)) 615 | (let-regexp "(?\\(([^ ]*\\)\\(\\s-*\\).*$")) 616 | (when sexp 617 | (save-restriction 618 | (narrow-to-region (car bounds) (cdr bounds)) 619 | (let ((max-len 0)) 620 | (save-excursion 621 | (while (re-search-forward let-regexp nil t) 622 | (setq max-len (max (length (match-string 1)) max-len)) 623 | (goto-char (match-end 1)) 624 | (skip-chars-forward " ") 625 | (when (looking-at "'?(") (forward-sexp 1)))) 626 | (while (re-search-forward let-regexp nil t) 627 | (let (bol) 628 | (goto-char (match-end 1)) 629 | (setq bol (bolp)) 630 | (skip-chars-forward "\n \t") 631 | (unless bol 632 | (replace-match 633 | (make-string (1+ (- max-len (length (match-string 1)))) ? ) 634 | t t nil 2))) 635 | (when (looking-at "'?(") (forward-sexp 1)))) 636 | (goto-char (point-min)) 637 | (indent-region (point-min) (point-max)))))) 638 | 639 | ;;; Set extend attr on faces if needed 640 | ;; 641 | (defun tv:extend-faces-matching (regexp) 642 | "Allow setting `extend' attribute on faces matching REGEXP." 643 | (cl-loop for f in (face-list) 644 | for face = (symbol-name f) 645 | when (and (string-match regexp face) 646 | (eq (face-attribute f :extend t 'default) 647 | 'unspecified)) 648 | do (set-face-attribute f nil :extend t))) 649 | 650 | ;;; Replace dots in filenames 651 | ;; 652 | (defun tv:collect-file-exts-in-buffer () 653 | (let ((exts '())) 654 | (save-excursion 655 | (goto-char (point-min)) 656 | (while (not (eobp)) 657 | (let ((ext (file-name-extension 658 | (buffer-substring-no-properties 659 | (point-at-bol) (point-at-eol))))) 660 | (when (and ext (not (member ext exts))) 661 | (push ext exts))) 662 | (forward-line 1))) 663 | exts)) 664 | 665 | (defun tv:normalize-fnames-1 (strings) 666 | (let ((regexp (regexp-opt strings))) 667 | (save-excursion 668 | (goto-char (point-min)) 669 | (while (re-search-forward "[. ]" nil t) 670 | (unless (looking-at-p regexp) 671 | (replace-match (if (save-match-data 672 | ;; "foo_ !bar.txt" 673 | (or (looking-back "[_-] " 1) 674 | ;; "foo !- bar.txt" 675 | (looking-at "[-_]"))) 676 | "" "_"))))))) 677 | 678 | ;;;###autoload 679 | (defun tv:normalize-fnames (&optional edit-exts) 680 | "Replace dots and spaces in filenames by \"_\". 681 | Ignore dots preceding file extension. 682 | 683 | Meant to be used in buffers containg only filenames e.g. wfnames buffers. 684 | With a prefix arg prompt to edit file extensions." 685 | (interactive "P") 686 | (cl-assert (memq major-mode '(wfnames-mode wdired-mode)) nil 687 | "No filenames to modify in this buffer") 688 | (barf-if-buffer-read-only) 689 | (let* ((exts (tv:collect-file-exts-in-buffer)) 690 | (strings (and edit-exts 691 | (read-from-minibuffer 692 | "Strings: " 693 | nil nil nil nil 694 | (mapconcat #'identity exts " "))))) 695 | (when (or exts (and strings (not (string= strings "")))) 696 | (tv:normalize-fnames-1 (if strings 697 | (split-string strings) 698 | exts))))) 699 | 700 | ;; This template needs the lettre package 701 | ;; included in texlive-latex-extra package. 702 | ;;;###autoload 703 | (defun tv:insert-skel-latex-letter () 704 | "Insert a latex skeleton letter in an empty file" 705 | (interactive) 706 | (insert 707 | "\\documentclass[12pt]{lettre}\n" 708 | "\n" 709 | "\n" 710 | "\\usepackage[T1]{fontenc}\n" 711 | "\\usepackage{lmodern}\n" 712 | "\\usepackage{eurosym} % Use \euro for €\n" 713 | "\\usepackage[francais]{babel}\n" 714 | "\\usepackage[utf8]{inputenc}\n" 715 | "\\begin{document}\n" 716 | "\n" 717 | "\\begin{letter}{destinataire\\\\adresse1\\\\adresse2} % nom et addresse destinataire\n" 718 | "\\name{expéditeur}\n" 719 | "\\signature{Thierry Volpiatto}\n" 720 | "\\address{expéditeur\\\\adresse1\\\\adresse2} % nom expéditeur\n" 721 | "\\lieu{ville}\n" 722 | "\\telephone{01~02~03~04~05}\n" 723 | "\\email{thierry@fai.fr}\n" 724 | "\\nofax\n" 725 | "\n" 726 | "\\def\\concname{Objet :~} % ne rien modifier ici\n" 727 | "\\conc{objet de la lettre} % objet modifier ici\n" 728 | "\\opening{Madame, Monsieur,}\n" 729 | "\n" 730 | "% Contenu de la lettre\n" 731 | "\n" 732 | "\\closing{Je vous prie d'agréer, Madame, Monsieur, mes salutations distinguées.}\n" 733 | "\n" 734 | "\\encl{Pièces jointes}\n" 735 | "\n" 736 | "\\ps{PS :~}{Post scritum ici}\n" 737 | "\\end{letter}\n" 738 | "\n" 739 | "\\end{document}\n") 740 | (goto-char (point-min)) 741 | (when (re-search-forward "[\\]begin[{]letter[}]") 742 | (beginning-of-line) 743 | (forward-char 15))) 744 | 745 | (defun tv:speed (hours minutes seconds km) 746 | "Calculate speed in km/h. 747 | The speed is calculated for a distance KM given in kilometers travelled in HOURS 748 | MINUTES SECONDS." 749 | (let* ((s (+ (float seconds) 750 | (* 60 (float minutes)) 751 | (* (* (float hours) 60) 60))) 752 | (m (* 1000 (float km))) 753 | (mps (/ m s))) 754 | ;; Same as (/ (* ms 60 60) 1000). 755 | (* mps 3.6))) 756 | 757 | (defun tv:metre-heure (hours minutes deniv &optional arg) 758 | "Calculate speed in m/h. 759 | The speed is calculated for a distance DENIV given in meters travelled 760 | in HOURS MINUTES." 761 | (interactive (list (read-number "Heure(s): " 0) 762 | (read-number "Minute(s): " 0) 763 | (read-number "Dénivelé (en mètres): " 0) 764 | "\np")) 765 | (let* ((m (float deniv)) 766 | (mns (+ (* hours 60) minutes))) 767 | (if arg 768 | (message "%s en %sh%sm => %sm/h" 769 | deniv hours minutes (floor (/ (* m 60) mns))) 770 | (/ (* m 60) mns)))) 771 | 772 | 773 | (provide 'tv-utils) 774 | 775 | ;; Local Variables: 776 | ;; byte-compile-warnings: (not cl-functions obsolete) 777 | ;; End: 778 | 779 | ;;; tv-utils.el ends here 780 | -------------------------------------------------------------------------------- /wttr-weather.el: -------------------------------------------------------------------------------- 1 | ;;; wttr-weather.el --- wttr.in weather report. -*- lexical-binding: t -*- 2 | ;; 3 | 4 | ;;; Code: 5 | 6 | (require 'ansi-color) 7 | (require 'face-remap) 8 | 9 | (defvar wttr-weather-history nil) 10 | (defvar wttr-weather-default-location "Guillestre") 11 | (defvar wttr-weather-last-location nil) 12 | 13 | (defgroup wttr-weather nil 14 | "Wttr.in weather emacs interface." 15 | :group 'convenience 16 | :prefix "wttr-weather-") 17 | 18 | (defface wttr-weather-buffer-face 19 | '((t :family "Liberation Mono")) 20 | "Default face for the weather display buffer." 21 | :group 'wttr-weather) 22 | 23 | ;;;###autoload 24 | (defun wttr-weather (place) 25 | "Weather forecast with wttr.in. 26 | With a prefix arg refresh buffer if some. 27 | See ." 28 | (interactive (list (read-string (format "Place (%s): " 29 | wttr-weather-default-location) 30 | nil 31 | 'wttr-weather-history 32 | wttr-weather-default-location))) 33 | (let ((buf (get-buffer-create (format "*wttr.in %s*" place)))) 34 | (switch-to-buffer buf) 35 | (set-buffer buf) 36 | (setq buffer-face-mode-face 'wttr-weather-buffer-face) 37 | (when current-prefix-arg 38 | (set (make-local-variable 'wttr-weather-last-location) nil)) 39 | (unless wttr-weather-last-location 40 | (wttr-weather-update place) 41 | (wttr-weather-mode) 42 | (set (make-local-variable 'wttr-weather-last-location) place)))) 43 | 44 | (defun wttr-weather-update (place) 45 | (let* ((inhibit-read-only t) 46 | ansi 47 | (data 48 | (with-temp-buffer 49 | (call-process 50 | "curl" nil '(t t) nil 51 | "-s" (format "fr.wttr.in/%s?m" (replace-regexp-in-string " " "+" place))) 52 | (goto-char (point-min)) 53 | ;; Try to replace 256 colors seq like this 54 | ;; "\033[38;5;226m" => "\033[33m" or sequence ending with 55 | ;; ;5m (animated) which Emacs-28 replace by a crapy box. 56 | ;; "\033[38;5;228;5m" => "\033[33m". 57 | ;; Thanks to Jim Porter for explanations in Emacs bug#54774. 58 | (while (re-search-forward "\\(38;5;\\([0-9]+\\);?[0-9]?\\)m" nil t) 59 | ;; If we have ansi sequences, that's mean we had weather 60 | ;; output, otherwise we have a simple message notifying 61 | ;; weather report is not available. 62 | (setq ansi t) 63 | ;; Need a 256 color ansi library, emacs supports only basic 64 | ;; ansi colors as now, so replace all 38;5 foreground 65 | ;; specs by simple ansi sequences. 66 | ;; Emacs-29 supports 256 color but still have bad support for 67 | ;; animated ansi sequences, so better use basic colors. 68 | (replace-match (pcase (match-string 2) 69 | ("190" "31") ;; red 70 | ((or "118" "154") "32") ;; green 71 | ((or "226" "228") "33") ;; yellow 72 | ("202" "34") ;; blue 73 | ("214" "35") ;; magenta 74 | ((or "220" "111") "36") ;; cyan 75 | ("208" "37") ;; white 76 | (_ "0")) ;; Avoid box face 77 | t t nil 1)) 78 | (ansi-color-apply (buffer-string))))) 79 | (erase-buffer) 80 | (save-excursion 81 | (if data 82 | (insert data) 83 | ;; Probaly check error status instead (it is 52). 84 | (insert "Empy reply from server")) 85 | (forward-line -1) 86 | (when (and ansi ; Keep notification when no weather report. 87 | (re-search-backward "^$" nil t)) 88 | (delete-region (point) (point-max)))) 89 | (while (re-search-forward "\\s\\" (pos-eol) t) (replace-match "")) 90 | (goto-char (pos-eol)) 91 | (insert (format-time-string " le %d/%m/%Y à %H:%M:%S")))) 92 | 93 | (defun wttr-weather-revert-fn (_ignore-auto _no_confirm) 94 | (wttr-weather-update wttr-weather-last-location)) 95 | 96 | (define-derived-mode wttr-weather-mode 97 | special-mode "wttr" 98 | "Mode used to display wttr-weather buffer." 99 | (buffer-face-mode 1) 100 | (make-local-variable 'wttr-weather-last-location) 101 | (set (make-local-variable 'revert-buffer-function) 'wttr-weather-revert-fn)) 102 | (put 'wttr-weather-mode 'no-helm-mx t) 103 | 104 | (provide 'wttr-weather) 105 | 106 | ;;; wttr-weather.el ends here 107 | --------------------------------------------------------------------------------