204 lines
7.2 KiB
EmacsLisp
204 lines
7.2 KiB
EmacsLisp
;;; sx-user.el --- handling and printing user information -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2014 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:
|