| commit | author | age | ||
| 5cb5f7 | 1 | ;;; helm-misc.el --- Various functions for helm -*- lexical-binding: t -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2012 ~ 2018 Thierry Volpiatto <thierry.volpiatto@gmail.com> | |
| 4 | ||
| 5 | ;; This program is free software; you can redistribute it and/or modify | |
| 6 | ;; it under the terms of the GNU General Public License as published by | |
| 7 | ;; the Free Software Foundation, either version 3 of the License, or | |
| 8 | ;; (at your option) any later version. | |
| 9 | ||
| 10 | ;; This program is distributed in the hope that it will be useful, | |
| 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 13 | ;; GNU General Public License for more details. | |
| 14 | ||
| 15 | ;; You should have received a copy of the GNU General Public License | |
| 16 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
| 17 | ||
| 18 | ;;; Code: | |
| 19 | (require 'cl-lib) | |
| 20 | (require 'helm) | |
| 21 | (require 'helm-help) | |
| 22 | (require 'helm-types) | |
| 23 | ||
| 24 | (declare-function display-time-world-display "time.el") | |
| 25 | (defvar display-time-world-list) | |
| 26 | (declare-function LaTeX-math-mode "ext:latex.el") | |
| 27 | (declare-function jabber-chat-with "ext:jabber.el") | |
| 28 | (declare-function jabber-read-account "ext:jabber.el") | |
| 29 | ||
| 30 | ||
| 31 | (defgroup helm-misc nil | |
| 32 | "Various Applications and libraries for Helm." | |
| 33 | :group 'helm) | |
| 34 | ||
| 35 | (defcustom helm-time-zone-home-location "Paris" | |
| 36 | "The time zone of your home" | |
| 37 | :group 'helm-misc | |
| 38 | :type 'string) | |
| 39 | ||
| 40 | (defcustom helm-timezone-actions | |
| 41 | '(("Set timezone env (TZ)" . (lambda (candidate) | |
| 42 | (setenv "TZ" candidate)))) | |
| 43 | "Actions for helm-timezone." | |
| 44 | :group 'helm-misc | |
| 45 | :type '(alist :key-type string :value-type function)) | |
| 46 | ||
| 47 | (defface helm-time-zone-current | |
| 48 | '((t (:foreground "green"))) | |
| 49 | "Face used to colorize current time in `helm-world-time'." | |
| 50 | :group 'helm-misc) | |
| 51 | ||
| 52 | (defface helm-time-zone-home | |
| 53 | '((t (:foreground "red"))) | |
| 54 | "Face used to colorize home time in `helm-world-time'." | |
| 55 | :group 'helm-misc) | |
| 56 | ||
| 57 | ||
| 58 | ||
| 59 | ;;; Latex completion | |
| 60 | ;; | |
| 61 | ;; Test | |
| 62 | ;; (setq LaTeX-math-menu '("Math" | |
| 63 | ;; ["foo" val0 t] | |
| 64 | ;; ("bar" | |
| 65 | ;; ["baz" val1 t]) | |
| 66 | ;; ("aze" | |
| 67 | ;; ["zer" val2 t]) | |
| 68 | ;; ("AMS" | |
| 69 | ;; ("rec" | |
| 70 | ;; ["fer" val3 t]) | |
| 71 | ;; ("rty" | |
| 72 | ;; ["der" val4 t])) | |
| 73 | ;; ("ABC" | |
| 74 | ;; ("xcv" | |
| 75 | ;; ["sdf" val5 t]) | |
| 76 | ;; ("dfg" | |
| 77 | ;; ["fgh" val6 t])))) | |
| 78 | ;; (helm-latex-math-candidates) | |
| 79 | ;; => | |
| 80 | ;; (("foo" . val0) | |
| 81 | ;; ("baz" . val1) | |
| 82 | ;; ("zer" . val2) | |
| 83 | ;; ("fer" . val3) | |
| 84 | ;; ("der" . val4) | |
| 85 | ;; ("sdf" . val5) | |
| 86 | ;; ("fgh" . val6)) | |
| 87 | ||
| 88 | (defvar LaTeX-math-menu) | |
| 89 | (defun helm-latex-math-candidates () | |
| 90 | (cl-labels ((helm-latex--math-collect (L) | |
| 91 | (cond ((vectorp L) | |
| 92 | (list (cons (aref L 0) (aref L 1)))) | |
| 93 | ((listp L) | |
| 94 | (cl-loop for a in L nconc | |
| 95 | (helm-latex--math-collect a)))))) | |
| 96 | (helm-latex--math-collect LaTeX-math-menu))) | |
| 97 | ||
| 98 | (defvar helm-source-latex-math | |
| 99 | (helm-build-sync-source "Latex Math Menu" | |
| 100 | :init (lambda () | |
| 101 | (with-helm-current-buffer | |
| 102 | (LaTeX-math-mode 1))) | |
| 103 | :candidate-number-limit 9999 | |
| 104 | :candidates 'helm-latex-math-candidates | |
| 105 | :action (lambda (candidate) | |
| 106 | (call-interactively candidate)))) | |
| 107 | ||
| 108 | ||
| 109 | ;;; Jabber Contacts (jabber.el) | |
| 110 | (defun helm-jabber-online-contacts () | |
| 111 | "List online Jabber contacts." | |
| 112 | (with-no-warnings | |
| 113 | (cl-loop for item in (jabber-concat-rosters) | |
| 114 | when (get item 'connected) | |
| 115 | collect | |
| 116 | (if (get item 'name) | |
| 117 | (cons (get item 'name) item) | |
| 118 | (cons (symbol-name item) item))))) | |
| 119 | ||
| 120 | (defvar helm-source-jabber-contacts | |
| 121 | (helm-build-sync-source "Jabber Contacts" | |
| 122 | :init (lambda () (require 'jabber)) | |
| 123 | :candidates (lambda () (mapcar 'car (helm-jabber-online-contacts))) | |
| 124 | :action (lambda (x) | |
| 125 | (jabber-chat-with | |
| 126 | (jabber-read-account) | |
| 127 | (symbol-name | |
| 128 | (cdr (assoc x (helm-jabber-online-contacts)))))))) | |
| 129 | ||
| 130 | ;;; World time | |
| 131 | ;; | |
| 132 | (defvar zoneinfo-style-world-list) | |
| 133 | (defvar legacy-style-world-list) | |
| 134 | ||
| 135 | (defun helm-time-zone-transformer (candidates _source) | |
| 136 | (cl-loop for i in candidates | |
| 137 | for (z . p) in display-time-world-list | |
| 138 | collect | |
| 139 | (cons | |
| 140 | (cond ((string-match (format-time-string "%H:%M" (current-time)) i) | |
| 141 | (propertize i 'face 'helm-time-zone-current)) | |
| 142 | ((string-match helm-time-zone-home-location i) | |
| 143 | (propertize i 'face 'helm-time-zone-home)) | |
| 144 | (t i)) | |
| 145 | z))) | |
| 146 | ||
| 147 | (defvar helm-source-time-world | |
| 148 | (helm-build-in-buffer-source "Time World List" | |
| 149 | :init (lambda () | |
| 150 | (require 'time) | |
| 151 | (unless (and display-time-world-list | |
| 152 | (listp display-time-world-list)) | |
| 153 | ;; adapted from `time--display-world-list' from | |
| 154 | ;; emacs-27 for compatibility as | |
| 155 | ;; `display-time-world-list' is set by default to t. | |
| 156 | (setq display-time-world-list | |
| 157 | ;; Determine if zoneinfo style timezones are | |
| 158 | ;; supported by testing that America/New York and | |
| 159 | ;; Europe/London return different timezones. | |
| 160 | (let ((nyt (format-time-string "%z" nil "America/New_York")) | |
| 161 | (gmt (format-time-string "%z" nil "Europe/London"))) | |
| 162 | (if (string-equal nyt gmt) | |
| 163 | legacy-style-world-list | |
| 164 | zoneinfo-style-world-list))))) | |
| 165 | :data (lambda () | |
| 166 | (with-temp-buffer | |
| 167 | (display-time-world-display display-time-world-list) | |
| 168 | (buffer-string))) | |
| 169 | :action 'helm-timezone-actions | |
| 170 | :filtered-candidate-transformer 'helm-time-zone-transformer)) | |
| 171 | ||
| 172 | ;;; Commands | |
| 173 | ;; | |
| 174 | (defun helm-call-interactively (cmd-or-name) | |
| 175 | "Execute CMD-OR-NAME as Emacs command. | |
| 176 | It is added to `extended-command-history'. | |
| 177 | `helm-current-prefix-arg' is used as the command's prefix argument." | |
| 178 | (setq extended-command-history | |
| 179 | (cons (helm-stringify cmd-or-name) | |
| 180 | (delete (helm-stringify cmd-or-name) extended-command-history))) | |
| 181 | (let ((current-prefix-arg helm-current-prefix-arg) | |
| 182 | (cmd (helm-symbolify cmd-or-name))) | |
| 183 | (if (stringp (symbol-function cmd)) | |
| 184 | (execute-kbd-macro (symbol-function cmd)) | |
| 185 | (setq this-command cmd) | |
| 186 | (call-interactively cmd)))) | |
| 187 | ||
| 188 | ;;; Minibuffer History | |
| 189 | ;; | |
| 190 | ;; | |
| 191 | (defvar helm-minibuffer-history-map | |
| 192 | (let ((map (make-sparse-keymap))) | |
| 193 | (set-keymap-parent map helm-map) | |
| 194 | (define-key map [remap helm-minibuffer-history] 'undefined) | |
| 195 | map)) | |
| 196 | ||
| 197 | (defcustom helm-minibuffer-history-must-match t | |
| 198 | "Allow inserting non matching elements when nil or 'confirm." | |
| 199 | :group 'helm-misc | |
| 200 | :type '(choice | |
| 201 | (const :tag "Must match" t) | |
| 202 | (const :tag "Confirm" 'confirm) | |
| 203 | (const :tag "Always allow" nil))) | |
| 204 | ||
| 205 | ;;; Shell history | |
| 206 | ;; | |
| 207 | ;; | |
| 208 | (defun helm-comint-input-ring-action (candidate) | |
| 209 | "Default action for comint history." | |
| 210 | (with-helm-current-buffer | |
| 211 | (delete-region (comint-line-beginning-position) (point-max)) | |
| 212 | (insert candidate))) | |
| 213 | ||
| 214 | (defvar helm-source-comint-input-ring | |
| 215 | (helm-build-sync-source "Comint history" | |
| 216 | :candidates (lambda () | |
| 217 | (with-helm-current-buffer | |
| 218 | (ring-elements comint-input-ring))) | |
| 219 | :action 'helm-comint-input-ring-action) | |
| 220 | "Source that provide helm completion against `comint-input-ring'.") | |
| 221 | ||
| 222 | ||
| 223 | ;;; Helm ratpoison UI | |
| 224 | ;; | |
| 225 | ;; | |
| 226 | (defvar helm-source-ratpoison-commands | |
| 227 | (helm-build-in-buffer-source "Ratpoison Commands" | |
| 228 | :init 'helm-ratpoison-commands-init | |
| 229 | :action (helm-make-actions | |
| 230 | "Execute the command" 'helm-ratpoison-commands-execute) | |
| 231 | :display-to-real 'helm-ratpoison-commands-display-to-real | |
| 232 | :candidate-number-limit 999999)) | |
| 233 | ||
| 234 | (defun helm-ratpoison-commands-init () | |
| 235 | (unless (helm-candidate-buffer) | |
| 236 | (with-current-buffer (helm-candidate-buffer 'global) | |
| 237 | ;; with ratpoison prefix key | |
| 238 | (save-excursion | |
| 239 | (call-process "ratpoison" nil (current-buffer) nil "-c" "help")) | |
| 240 | (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) | |
| 241 | (replace-match "<ratpoison> \\1: \\2")) | |
| 242 | (goto-char (point-max)) | |
| 243 | ;; direct binding | |
| 244 | (save-excursion | |
| 245 | (call-process "ratpoison" nil (current-buffer) nil "-c" "help top")) | |
| 246 | (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) | |
| 247 | (replace-match "\\1: \\2"))))) | |
| 248 | ||
| 249 | (defun helm-ratpoison-commands-display-to-real (display) | |
| 250 | (and (string-match ": " display) | |
| 251 | (substring display (match-end 0)))) | |
| 252 | ||
| 253 | (defun helm-ratpoison-commands-execute (candidate) | |
| 254 | (call-process "ratpoison" nil nil nil "-ic" candidate)) | |
| 255 | ||
| 256 | ;;; Helm stumpwm UI | |
| 257 | ;; | |
| 258 | ;; | |
| 259 | (defvar helm-source-stumpwm-commands | |
| 260 | (helm-build-in-buffer-source "Stumpwm Commands" | |
| 261 | :init 'helm-stumpwm-commands-init | |
| 262 | :action (helm-make-actions | |
| 263 | "Execute the command" 'helm-stumpwm-commands-execute) | |
| 264 | :candidate-number-limit 999999)) | |
| 265 | ||
| 266 | (defun helm-stumpwm-commands-init () | |
| 267 | (with-current-buffer (helm-candidate-buffer 'global) | |
| 268 | (save-excursion | |
| 269 | (call-process "stumpish" nil (current-buffer) nil "commands")) | |
| 270 | (while (re-search-forward "[ ]*\\([^ ]+\\)[ ]*\n?" nil t) | |
| 271 | (replace-match "\n\\1\n")) | |
| 272 | (delete-blank-lines) | |
| 273 | (sort-lines nil (point-min) (point-max)) | |
| 274 | (goto-char (point-max)))) | |
| 275 | ||
| 276 | (defun helm-stumpwm-commands-execute (candidate) | |
| 277 | (call-process "stumpish" nil nil nil candidate)) | |
| 278 | ||
| 279 | ;;;###autoload | |
| 280 | (defun helm-world-time () | |
| 281 | "Preconfigured `helm' to show world time. | |
| 282 | Default action change TZ environment variable locally to emacs." | |
| 283 | (interactive) | |
| 284 | (helm-other-buffer 'helm-source-time-world "*helm world time*")) | |
| 285 | ||
| 286 | ;;;###autoload | |
| 287 | (defun helm-insert-latex-math () | |
| 288 | "Preconfigured helm for latex math symbols completion." | |
| 289 | (interactive) | |
| 290 | (helm-other-buffer 'helm-source-latex-math "*helm latex*")) | |
| 291 | ||
| 292 | ;;;###autoload | |
| 293 | (defun helm-ratpoison-commands () | |
| 294 | "Preconfigured `helm' to execute ratpoison commands." | |
| 295 | (interactive) | |
| 296 | (helm-other-buffer 'helm-source-ratpoison-commands | |
| 297 | "*helm ratpoison commands*")) | |
| 298 | ||
| 299 | ;;;###autoload | |
| 300 | (defun helm-stumpwm-commands() | |
| 301 | "Preconfigured helm for stumpwm commands." | |
| 302 | (interactive) | |
| 303 | (helm-other-buffer 'helm-source-stumpwm-commands | |
| 304 | "*helm stumpwm commands*")) | |
| 305 | ||
| 306 | ;;;###autoload | |
| 307 | (defun helm-minibuffer-history () | |
| 308 | "Preconfigured `helm' for `minibuffer-history'." | |
| 309 | (interactive) | |
| 310 | (cl-assert (minibuffer-window-active-p (selected-window)) nil | |
| 311 | "Error: Attempt to use minibuffer history outside a minibuffer") | |
| 312 | (let* ((enable-recursive-minibuffers t) | |
| 313 | (query-replace-p (or (eq last-command 'query-replace) | |
| 314 | (eq last-command 'query-replace-regexp))) | |
| 315 | (elm (helm-comp-read "pattern: " | |
| 316 | (cl-loop for i in | |
| 317 | (symbol-value minibuffer-history-variable) | |
| 318 | unless (string= "" i) collect i into history | |
| 319 | finally return | |
| 320 | (if (consp (car history)) | |
| 321 | (mapcar 'prin1-to-string history) | |
| 322 | history)) | |
| 323 | :header-name | |
| 324 | (lambda (name) | |
| 325 | (format "%s (%s)" name minibuffer-history-variable)) | |
| 326 | :buffer "*helm minibuffer-history*" | |
| 327 | :must-match helm-minibuffer-history-must-match | |
| 328 | :multiline t | |
| 329 | :keymap helm-minibuffer-history-map | |
| 330 | :allow-nest t))) | |
| 331 | ;; Fix issue #1667 with emacs-25+ `query-replace-from-to-separator'. | |
| 332 | (when (and (boundp 'query-replace-from-to-separator) query-replace-p) | |
| 333 | (let ((pos (string-match "\0" elm))) | |
| 334 | (and pos | |
| 335 | (add-text-properties | |
| 336 | pos (1+ pos) | |
| 337 | `(display ,query-replace-from-to-separator separator t) | |
| 338 | elm)))) | |
| 339 | (delete-minibuffer-contents) | |
| 340 | (insert elm))) | |
| 341 | ||
| 342 | ;;;###autoload | |
| 343 | (defun helm-comint-input-ring () | |
| 344 | "Preconfigured `helm' that provide completion of `comint' history." | |
| 345 | (interactive) | |
| 346 | (when (derived-mode-p 'comint-mode) | |
| 347 | (helm :sources 'helm-source-comint-input-ring | |
| 348 | :input (buffer-substring-no-properties (comint-line-beginning-position) | |
| 349 | (point-at-eol)) | |
| 350 | :buffer "*helm comint history*"))) | |
| 351 | ||
| 352 | ||
| 353 | (provide 'helm-misc) | |
| 354 | ||
| 355 | ;; Local Variables: | |
| 356 | ;; byte-compile-warnings: (not obsolete) | |
| 357 | ;; coding: utf-8 | |
| 358 | ;; indent-tabs-mode: nil | |
| 359 | ;; End: | |
| 360 | ||
| 361 | ;;; helm-misc.el ends here | |
