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:
|