/
sx-user.el
203 lines (178 loc) · 7.17 KB
/
sx-user.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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
;;; sx-user.el --- handling and printing user information -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2018 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; 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:
;;; Code:
(require 'sx)
(require 'sx-button)
(defgroup sx-user nil
"How users are displayed by SX."
:prefix "sx-user-"
:tag "SX User"
:group 'sx)
(defcustom sx-question-mode-fallback-user
'(
(about_me . "")
(accept_rate . -1)
(account_id . -1)
(age . -1)
(answer_count . -1)
(badge_counts . ((bronze . -1) (silver . -1) (gold . -1)))
(creation_date . -1)
(display_name . "(unknown user)")
(down_vote_count . -1)
(is_employee . nil)
(last_access_date . -1)
(last_modified_date . -1)
(link . "")
(location . "")
(profile_image . ":(")
(question_count . -1)
(reputation . -1)
(reputation_change_day . -1)
(reputation_change_month . -1)
(reputation_change_quarter . -1)
(reputation_change_week . -1)
(reputation_change_year . -1)
(timed_penalty_date . -1)
(up_vote_count . -1)
(user_id . -1)
(user_type . does_not_exist)
(view_count . -1)
(website_url . "")
)
"The structure used to represent missing user information.
NOOTE: SX relies on this variable containing all necessary user
information. You may edit any of its fields, but you'll run into
errors if you remove them."
:type '(alist :options ((about_me string)
(accept_rate integer)
(account_id integer)
(age integer)
(answer_count integer)
(badge_counts alist)
(creation_date integer)
(display_name string)
(down_vote_count integer)
(is_employee boolean)
(last_access_date integer)
(last_modified_date integer)
(link string)
(location string)
(profile_image string)
(question_count integer)
(reputation integer)
(reputation_change_day integer)
(reputation_change_month integer)
(reputation_change_quarter integer)
(reputation_change_week integer)
(reputation_change_year integer)
(timed_penalty_date integer)
(up_vote_count integer)
(user_id integer)
(user_type symbol)
(view_count integer)
(website_url string)))
:group 'sx-user)
;;; Text properties
(defface sx-user-name
'((t :inherit font-lock-builtin-face))
"Face used for user names."
:group 'sx-user)
(defface sx-user-reputation
'((t :inherit font-lock-comment-face))
"Face used for user reputations."
:group 'sx-user)
(defface sx-user-accept-rate
'((t))
"Face used for user accept-rates."
:group 'sx-user)
(defvar sx-user--format-property-alist
`((?d button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name)
(?n button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name)
(?@ button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name)
(?r face sx-user-reputation)
(?a face sx-user-accept-rate))
"Alist relating % constructs with text properties.
See `sx-user--format'.")
;;; Formatting function
(defun sx-user--format (format-string user)
"Use FORMAT-STRING to format the user object USER.
The value is a copy of FORMAT-STRING, but with certain constructs
replaced by text that describes the specified USER:
%d is the display name.
%@ is the display name in a format suitable for @mentions.
%l is the link to the profile.
%r is the reputation.
%a is the accept rate.
The string replaced in each of these construct is also given the
text-properties specified in `sx-user--format-property-alist'.
Specially, %d and %@ are turned into buttons with the
`sx-button-user' category."
(sx-assoc-let (append user sx-question-mode-fallback-user)
(let* ((text (sx-format-replacements
format-string
`((?d . ,\.display_name)
(?n . ,\.display_name)
(?l . ,\.link)
(?r . ,\.reputation)
(?a . ,\.accept_rate)
(?@ . ,(when (string-match "%@" format-string)
(sx-user--@name .display_name)))
)
sx-user--format-property-alist)))
(if (< 0 (string-width .link))
(propertize text
;; For visiting and stuff.
'sx-button-url .link
'sx-button-copy .link)
text))))
;;; @name conversion
(defconst sx-user--ascii-replacement-list
'(("[:space:]" . "")
("àåáâäãåą" . "a")
("èéêëę" . "e")
("ìíîïı" . "i")
("òóôõöøőð" . "o")
("ùúûüŭů" . "u")
("çćčĉ" . "c")
("żźž" . "z")
("śşšŝ" . "s")
("ñń" . "n")
("ýÿ" . "y")
("ğĝ" . "g")
("ř" . "r")
("ł" . "l")
("đ" . "d")
("ß" . "ss")
("Þ" . "th")
("ĥ" . "h")
("ĵ" . "j")
("^[:ascii:]" . ""))
"List of replacements to use for non-ascii characters.
Used to convert user names into @mentions.")
(defun sx-user--@name (display-name)
"Convert DISPLAY-NAME into an @mention.
In order to correctly @mention the user, all whitespace is
removed from DISPLAY-NAME and a series of unicode conversions are
performed before it is returned.
See `sx-user--ascii-replacement-list'.
If all you need is the @name, this is very slightly faster than
using `sx-user--format', but it doesn't do any sanity checking."
(concat "@" (sx--recursive-replace
sx-user--ascii-replacement-list display-name)))
(provide 'sx-user)
;;; sx-user.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End: