mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-17 5cb5f70b1872a757e93ea333b0e2dca50c6c8957
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