From 3328a62d42ff3ca62c31366a4cd0cfd38a3ec663 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 15 Jan 2015 00:01:32 -0500 Subject: Create and implement comparator creation macro This obsoletes `sx--<'. --- sx-question-list.el | 10 +++++----- sx.el | 24 +++++++++++++++++------- 2 files changed, 22 insertions(+), 12 deletions(-) diff --git a/sx-question-list.el b/sx-question-list.el index 1b7fe5a..5909156 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -322,11 +322,11 @@ into consideration. ;; Add a setter to protect the value. :group 'sx-question-list) -(defun sx-question-list--date-more-recent-p (x y) - "Non-nil if tabulated-entry X is newer than Y." - (sx--< - sx-question-list-date-sort-method - (car x) (car y) #'>)) +(sx--create-comparator sx-question-list--date-more-recent-p + "Non-nil if tabulated-entry A is newer than B." + > (lambda (x) + (cdr (assoc sx-question-list-date-sort-method + (car x))))) ;;; Keybinds diff --git a/sx.el b/sx.el index e080271..87907de 100644 --- a/sx.el +++ b/sx.el @@ -259,6 +259,23 @@ whenever BODY evaluates to nil." :filter (lambda (&optional _) (when (progn ,@body) ,def))))) +(defmacro sx--create-comparator (name doc compare-func get-func) + "Define a new comparator called NAME with documentation DOC. +COMPARE-FUNC is a function that takes the return value of +GET-FUNC and performs the actual comparison." + (declare (indent 1) (doc-string 2)) + (let ((gpf (intern (format " %S--get-prop-function" name))) + (cf (intern (format " %S--compare-function" name)))) + ;; Leading space to hide from completion systems + `(progn + ;; In using `defalias', the macro supports both function + ;; symbols and lambda expressions. + (defalias ',gpf ,get-func) + (defalias ',cf ,compare-func) + (defun ,name (a b) + ,doc + (,cf (,gpf a) (,gpf b)))))) + ;;; Printing request data (defvar sx--overlays nil @@ -349,13 +366,6 @@ Run after `sx-init--internal-hook'." This is used internally to set initial values for variables such as filters.") -(defun sx--< (property x y &optional predicate) - "Non-nil if PROPERTY attribute of alist X is less than that of Y. -With optional argument PREDICATE, use it instead of `<'." - (funcall (or predicate #'<) - (cdr (assoc property x)) - (cdr (assoc property y)))) - (defmacro sx-init-variable (variable value &optional setter) "Set VARIABLE to VALUE using SETTER. SETTER should be a function of two arguments. If SETTER is nil, -- cgit v1.2.3 From 8e9983d1c9edab01335e3923bb5b50ad5a91ed1f Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 15 Jan 2015 00:09:31 -0500 Subject: Abstract sorting function --- sx-question-print.el | 6 +----- sx-question.el | 7 +++++++ 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index 737844a..210f99a 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -180,11 +180,7 @@ QUESTION must be a data structure returned by `json-read'." (sx-question-mode--print-section question) (sx-assoc-let question (mapc #'sx-question-mode--print-section - (cl-sort .answers - ;; Highest-voted first. @TODO: custom sorting - (lambda (a b) - (> (cdr (assoc 'score a)) - (cdr (assoc 'score b))))))) + (cl-sort .answers #'sx-answer-higher-score-p))) (insert "\n\n ") (insert-text-button "Write an Answer" :type 'sx-button-answer) ;; Go up diff --git a/sx-question.el b/sx-question.el index b9fc78a..d624f45 100644 --- a/sx-question.el +++ b/sx-question.el @@ -187,6 +187,13 @@ If no cache exists for it, initialize one with SITE." "Formats TAG for display." (concat "[" tag "]")) + +;;; Question Mode Answer-Sorting Functions + +(sx--create-comparator sx-answer-higher-score-p + "Return t if answer A has a higher score than answer B." + #'> (lambda (x) (cdr (assoc 'score x)))) + (provide 'sx-question) ;;; sx-question.el ends here -- cgit v1.2.3 From 9b093f7a7a02e31dc6985619f5277ee945f6f90d Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 15 Jan 2015 00:22:04 -0500 Subject: Small bugfix Everything must now be a proper function. --- sx-question-list.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sx-question-list.el b/sx-question-list.el index 5909156..cb5bc33 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -324,9 +324,9 @@ into consideration. (sx--create-comparator sx-question-list--date-more-recent-p "Non-nil if tabulated-entry A is newer than B." - > (lambda (x) - (cdr (assoc sx-question-list-date-sort-method - (car x))))) + #'> (lambda (x) + (cdr (assoc sx-question-list-date-sort-method + (car x))))) ;;; Keybinds -- cgit v1.2.3 From fe912f7a4871f7beedeafe5f29feb57ca65ecc47 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 15 Jan 2015 00:22:33 -0500 Subject: Abstract sorting function into customizable option --- sx-question-print.el | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/sx-question-print.el b/sx-question-print.el index 210f99a..c19b0c3 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -166,6 +166,15 @@ replaced with the comment." :type 'boolean :group 'sx-question-mode) +(defcustom sx-question-mode-answer-sort-function + #'sx-answer-higher-score-p + "Function used to sort answers in the question buffer." + :type '(choice + (const :tag "Higher-scoring first" sx-answer-higher-score-p) + (const :tag "Older first" sx-answer-older-p) + (const :tag "More active first" sx-answer-more-active-p)) + :group 'sx-question-mode) + ;;; Functions ;;;; Printing the general structure @@ -180,7 +189,7 @@ QUESTION must be a data structure returned by `json-read'." (sx-question-mode--print-section question) (sx-assoc-let question (mapc #'sx-question-mode--print-section - (cl-sort .answers #'sx-answer-higher-score-p))) + (cl-sort .answers sx-question-list--sort-answer-function))) (insert "\n\n ") (insert-text-button "Write an Answer" :type 'sx-button-answer) ;; Go up -- cgit v1.2.3 From 087ff1fdf3c4d42510d59a91659f166763baec57 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 15 Jan 2015 00:22:51 -0500 Subject: Add more sorting functions --- sx-question.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/sx-question.el b/sx-question.el index d624f45..7c687e8 100644 --- a/sx-question.el +++ b/sx-question.el @@ -194,6 +194,14 @@ If no cache exists for it, initialize one with SITE." "Return t if answer A has a higher score than answer B." #'> (lambda (x) (cdr (assoc 'score x)))) +(sx--create-comparator sx-answer-older-p + "Return t if answer A was posted later than answer B." + #'< (lambda (x) (cdr (assoc 'creation_date x)))) + +(sx--create-comparator sx-answer-more-active-p + "Return t if answer A was updated after answer B." + #'> (lambda (x) (cdr (assoc 'last_activity_date x)))) + (provide 'sx-question) ;;; sx-question.el ends here -- cgit v1.2.3 From 67f1cd1dc24560a21eef8186590020d26d9e55d7 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 15 Jan 2015 00:26:14 -0500 Subject: Fix letbinding `gpf' used to stand for `get-property-function', but this was abstracted into a `get-function'. The letbinding was never changed. This commit also conveniently allows me to say: Fix #226. --- sx.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/sx.el b/sx.el index 87907de..1cfba12 100644 --- a/sx.el +++ b/sx.el @@ -264,17 +264,17 @@ whenever BODY evaluates to nil." COMPARE-FUNC is a function that takes the return value of GET-FUNC and performs the actual comparison." (declare (indent 1) (doc-string 2)) - (let ((gpf (intern (format " %S--get-prop-function" name))) - (cf (intern (format " %S--compare-function" name)))) + (let ((gf (intern (format " %S--get-prop-function" name))) + (cf (intern (format " %S--compare-function" name)))) ;; Leading space to hide from completion systems `(progn ;; In using `defalias', the macro supports both function ;; symbols and lambda expressions. - (defalias ',gpf ,get-func) - (defalias ',cf ,compare-func) + (defalias ',gf ,get-func) + (defalias ',cf ,compare-func) (defun ,name (a b) ,doc - (,cf (,gpf a) (,gpf b)))))) + (,cf (,gf a) (,gf b)))))) ;;; Printing request data -- cgit v1.2.3 From b9eab6419e514fc6e1ce3096892bccd8a8ffb121 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 16 Jan 2015 00:40:26 -0500 Subject: Use assq instead of assoc --- sx-question-list.el | 3 +-- sx-question.el | 6 +++--- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/sx-question-list.el b/sx-question-list.el index cb5bc33..41bebda 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -325,8 +325,7 @@ into consideration. (sx--create-comparator sx-question-list--date-more-recent-p "Non-nil if tabulated-entry A is newer than B." #'> (lambda (x) - (cdr (assoc sx-question-list-date-sort-method - (car x))))) + (cdr (assq sx-question-list-date-sort-method (car x))))) ;;; Keybinds diff --git a/sx-question.el b/sx-question.el index 7c687e8..e199966 100644 --- a/sx-question.el +++ b/sx-question.el @@ -192,15 +192,15 @@ If no cache exists for it, initialize one with SITE." (sx--create-comparator sx-answer-higher-score-p "Return t if answer A has a higher score than answer B." - #'> (lambda (x) (cdr (assoc 'score x)))) + #'> (lambda (x) (cdr (assq 'score x)))) (sx--create-comparator sx-answer-older-p "Return t if answer A was posted later than answer B." - #'< (lambda (x) (cdr (assoc 'creation_date x)))) + #'< (lambda (x) (cdr (assq 'creation_date x)))) (sx--create-comparator sx-answer-more-active-p "Return t if answer A was updated after answer B." - #'> (lambda (x) (cdr (assoc 'last_activity_date x)))) + #'> (lambda (x) (cdr (assq 'last_activity_date x)))) (provide 'sx-question) ;;; sx-question.el ends here -- cgit v1.2.3 From 7470438d4455e38e4f7b749579470d4af2b66751 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 16 Jan 2015 00:43:21 -0500 Subject: Change older-p to newer-p Older functions generally have more votes anyway -- new answers need initial the attention. --- sx-question-print.el | 2 +- sx-question.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index c19b0c3..031e06b 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -171,7 +171,7 @@ replaced with the comment." "Function used to sort answers in the question buffer." :type '(choice (const :tag "Higher-scoring first" sx-answer-higher-score-p) - (const :tag "Older first" sx-answer-older-p) + (const :tag "Newer first" sx-answer-newer-p) (const :tag "More active first" sx-answer-more-active-p)) :group 'sx-question-mode) diff --git a/sx-question.el b/sx-question.el index e199966..e39634b 100644 --- a/sx-question.el +++ b/sx-question.el @@ -194,9 +194,9 @@ If no cache exists for it, initialize one with SITE." "Return t if answer A has a higher score than answer B." #'> (lambda (x) (cdr (assq 'score x)))) -(sx--create-comparator sx-answer-older-p +(sx--create-comparator sx-answer-newer-p "Return t if answer A was posted later than answer B." - #'< (lambda (x) (cdr (assq 'creation_date x)))) + #'> (lambda (x) (cdr (assq 'creation_date x)))) (sx--create-comparator sx-answer-more-active-p "Return t if answer A was updated after answer B." -- cgit v1.2.3 From 6c4e7c6b95e8bd7d83e5d0f868d9fb3a70c7a974 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 16 Jan 2015 00:45:35 -0500 Subject: Don't define aliases with comparators The aliases were created in the fear that runtime would be slower to interpret the duplicated lambda expressions for get-func. After testing, this was found not to be the case. `funcall' is a much nicer solution. --- sx.el | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/sx.el b/sx.el index 1cfba12..829570f 100644 --- a/sx.el +++ b/sx.el @@ -264,17 +264,14 @@ whenever BODY evaluates to nil." COMPARE-FUNC is a function that takes the return value of GET-FUNC and performs the actual comparison." (declare (indent 1) (doc-string 2)) - (let ((gf (intern (format " %S--get-prop-function" name))) - (cf (intern (format " %S--compare-function" name)))) - ;; Leading space to hide from completion systems - `(progn - ;; In using `defalias', the macro supports both function - ;; symbols and lambda expressions. - (defalias ',gf ,get-func) - (defalias ',cf ,compare-func) - (defun ,name (a b) - ,doc - (,cf (,gf a) (,gf b)))))) + `(progn + ;; In using `defalias', the macro supports both function + ;; symbols and lambda expressions. + (defun ,name (a b) + ,doc + (funcall ,compare-func + (funcall ,get-func a) + (funcall ,get-func b))))) ;;; Printing request data -- cgit v1.2.3