-
Notifications
You must be signed in to change notification settings - Fork 23
/
window-purpose-utils.el
129 lines (106 loc) · 4.33 KB
/
window-purpose-utils.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
;;; window-purpose-utils.el --- Utilities -*- lexical-binding: t -*-
;; Copyright (C) 2015-2021 Bar Magal & contributors
;; Author: Bar Magal
;; Package: purpose
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Utilities used in the Purpose package
;;; Code:
(require 'cl-lib)
(defcustom purpose-message-on-p nil
"If non-nil, `purpose-message' will produce a message.
Toggling this on will cause Purpose to produce some debug messages."
:group 'purpose
:type 'boolean
:package-version '(window-purpose . "1.2"))
(defun purpose-message (format-string &rest args)
"Produce a message if `purpose-message-on-p' is non-nil.
The message is produced with the `message' function. In any case,
return the formatted string. FORMAT-STRING and ARGS are passed to
`message' or `format' as is."
(if purpose-message-on-p
(apply #'message format-string args)
(apply #'format format-string args)))
;; define our (limited) version of alist-get
(defun purpose-alist-get (key alist &optional default _remove)
"Get KEY's value in ALIST.
If no such key, return DEFAULT.
When setting KEY's value, if the new value is equal to DEFAULT and
REMOVE is non-nil, then delete the KEY instead."
(let ((entry (assq key alist)))
(if entry
(cdr entry)
default)))
(defun purpose-alist-set (key value alist)
"Set VALUE to be the value associated to KEY in ALIST.
This doesn't change the original alist, but returns a modified copy."
(cons (cons key value)
(purpose-alist-del key alist)))
(defun purpose-alist-del (key alist)
"Delete KEY from ALIST.
This doesn't change the original alist, but returns a modified copy."
;; we could use any value instead of 0, as long as we used it instead
;; of 0 in both places
(cl-remove-if #'(lambda (entry)
(eq key (car entry)))
alist))
(defun purpose-flatten (seq)
"Turn a list of lists (SEQ) to one concatenated list."
(apply #'append seq))
(defun purpose-alist-combine (&rest alists)
"Combine ALISTS into one alist.
If several alists have the same key, the entry from the first alist with
that key is used. Example:
(purpose-alist-combine '((a . 1) (b . 2)) '((a . 3) (c . 4)))
=> '((a . 1) (b . 2) (c . 4))"
;; (purpose-flatten alists)
(let ((result nil))
(dolist (alist alists)
(dolist (element alist)
(unless (assoc (car element) result)
(setq result (purpose-alist-set (car element)
(cdr element)
result)))))
result))
(defun purpose-plist-values (plist)
"Return only the values of PLIST, as a list.
PLIST is a property list.
Example:
(plist-values '(:foo 1 :bar 2)) -> (1 2)"
(cl-loop for i from 0
for item in plist
when (cl-oddp i) collect item))
(defun purpose--iter-hash (function table)
"Like `maphash', but return a list the results of calling FUNCTION
for each entry in hash-table TABLE."
(let (results)
(maphash #'(lambda (key value)
(push (funcall function key value) results))
table)
results))
;; taken from http://emacs.stackexchange.com/a/7405/6533, credit to Jordon Biondo
(defun purpose--call-stack ()
"Return the current call stack frames."
(let ((frames)
(frame)
(index 5))
(while (setq frame (backtrace-frame index))
(push frame frames)
(cl-incf index))
(cl-remove-if-not 'car frames)))
;; taken from http://emacs.stackexchange.com/a/7405/6533, credit to Jordon Biondo
(defun purpose--function-stack ()
"Like `purpose--call-stack' but is a list of only the function names."
(butlast (mapcar 'cl-second (purpose--call-stack))))
(provide 'window-purpose-utils)
;;; window-purpose-utils.el ends here