| 1 | ;;; gnus-gl.el --- an interface to GroupLens for Gnus |
| 2 | |
| 3 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 |
| 4 | ;; Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Brad Miller <bmiller@cs.umn.edu> |
| 7 | ;; Keywords: news, score |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 14 | ;; any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 24 | ;; Boston, MA 02111-1307, USA. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | |
| 28 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 29 | ;; GroupLens software and documentation is copyright (c) 1995 by Paul |
| 30 | ;; Resnick (Massachusetts Institute of Technology); Brad Miller, John |
| 31 | ;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota), |
| 32 | ;; and David Maltz (Carnegie-Mellon University). |
| 33 | ;; |
| 34 | ;; Permission to use, copy, modify, and distribute this documentation |
| 35 | ;; for non-commercial and commercial purposes without fee is hereby |
| 36 | ;; granted provided that this copyright notice and permission notice |
| 37 | ;; appears in all copies and that the names of the individuals and |
| 38 | ;; institutions holding this copyright are not used in advertising or |
| 39 | ;; publicity pertaining to this software without specific, written |
| 40 | ;; prior permission. The copyright holders make no representations |
| 41 | ;; about the suitability of this software and documentation for any |
| 42 | ;; purpose. It is provided ``as is'' without express or implied |
| 43 | ;; warranty. |
| 44 | ;; |
| 45 | ;; The copyright holders request that they be notified of |
| 46 | ;; modifications of this code. Please send electronic mail to |
| 47 | ;; grouplens@cs.umn.edu for more information or to announce derived |
| 48 | ;; works. |
| 49 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 50 | ;; Author: Brad Miller |
| 51 | ;; |
| 52 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 53 | ;; |
| 54 | ;; User Documentation: |
| 55 | ;; To use GroupLens you must load this file. |
| 56 | ;; You must also register a pseudonym with the Better Bit Bureau. |
| 57 | ;; http://www.cs.umn.edu/Research/GroupLens |
| 58 | ;; |
| 59 | ;; ---------------- For your .emacs or .gnus file ---------------- |
| 60 | ;; |
| 61 | ;; As of version 2.5, grouplens now works as a minor mode of |
| 62 | ;; gnus-summary-mode. To get make that work you just need a couple of |
| 63 | ;; hooks. |
| 64 | ;; (setq gnus-use-grouplens t) |
| 65 | ;; (setq grouplens-pseudonym "") |
| 66 | ;; (setq grouplens-bbb-host "grouplens.cs.umn.edu") |
| 67 | ;; |
| 68 | ;; (setq gnus-summary-default-score 0) |
| 69 | ;; |
| 70 | ;; USING GROUPLENS |
| 71 | ;; How do I Rate an article?? |
| 72 | ;; Before you type n to go to the next article, hit a number from 1-5 |
| 73 | ;; Type r in the summary buffer and you will be prompted. |
| 74 | ;; Note that when you're in grouplens-minor-mode 'r' masks the |
| 75 | ;; usual reply binding for 'r' |
| 76 | ;; |
| 77 | ;; What if, Gasp, I find a bug??? |
| 78 | ;; Please type M-x gnus-gl-submit-bug-report. This will set up a |
| 79 | ;; mail buffer with the state of variables and buffers that will help |
| 80 | ;; me debug the problem. A short description up front would help too! |
| 81 | ;; |
| 82 | ;; How do I display the prediction for an article: |
| 83 | ;; If you set the gnus-summary-line-format as shown above, the score |
| 84 | ;; (prediction) will be shown automatically. |
| 85 | ;; |
| 86 | ;; |
| 87 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 88 | ;; Programmer Notes |
| 89 | ;; 10/9/95 |
| 90 | ;; gnus-scores-articles contains the articles |
| 91 | ;; When scoring is done, the call tree looks something like: |
| 92 | ;; gnus-possibly-score-headers |
| 93 | ;; ==> gnus-score-headers |
| 94 | ;; ==> gnus-score-load-file |
| 95 | ;; ==> get-all-mids (from the eval form) |
| 96 | ;; |
| 97 | ;; it would be nice to have one that gets called after all the other |
| 98 | ;; headers have been scored. |
| 99 | ;; we may want a variable gnus-grouplens-scale-factor |
| 100 | ;; and gnus-grouplens-offset this would probably be either -3 or 0 |
| 101 | ;; to make the scores centered around zero or not. |
| 102 | ;; Notes 10/12/95 |
| 103 | ;; According to Lars, Norse god of gnus, the simple way to insert a |
| 104 | ;; call to an external function is to have a function added to the |
| 105 | ;; variable gnus-score-find-files-function This new function |
| 106 | ;; gnus-grouplens-score-alist will return a core alist that |
| 107 | ;; has (("message-id" ("<message-id-xxxx>" score) ("<message-id-xxxy>" score)) |
| 108 | ;; This seems like it would be pretty inefficient, though workable. |
| 109 | ;; |
| 110 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 111 | ;; TODO |
| 112 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 113 | ;; |
| 114 | ;; 3. Add some more ways to rate messages |
| 115 | ;; 4. Better error handling for token timeouts. |
| 116 | ;; |
| 117 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 118 | ;; bugs |
| 119 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 120 | ;; |
| 121 | |
| 122 | ;;; Code: |
| 123 | |
| 124 | (eval-when-compile (require 'cl)) |
| 125 | |
| 126 | (require 'gnus-score) |
| 127 | (require 'gnus) |
| 128 | |
| 129 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 130 | ;;;; User variables |
| 131 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 132 | |
| 133 | (defvar gnus-summary-grouplens-line-format |
| 134 | "%U\%R\%z%l%I\%(%[%4L: %-20,20n%]%) %s\n" |
| 135 | "*The line format spec in summary GroupLens mode buffers.") |
| 136 | |
| 137 | (defvar grouplens-pseudonym "" |
| 138 | "User's pseudonym. |
| 139 | This pseudonym is obtained during the registration process") |
| 140 | |
| 141 | (defvar grouplens-bbb-host "grouplens.cs.umn.edu" |
| 142 | "Host where the bbbd is running.") |
| 143 | |
| 144 | (defvar grouplens-bbb-port 9000 |
| 145 | "Port where the bbbd is listening.") |
| 146 | |
| 147 | (defvar grouplens-newsgroups |
| 148 | '("comp.groupware" "comp.human-factors" "comp.lang.c++" |
| 149 | "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy" |
| 150 | "comp.os.linux.announce" "comp.os.linux.answers" |
| 151 | "comp.os.linux.development" "comp.os.linux.development.apps" |
| 152 | "comp.os.linux.development.system" "comp.os.linux.hardware" |
| 153 | "comp.os.linux.help" "comp.os.linux.m68k" "comp.os.linux.misc" |
| 154 | "comp.os.linux.networking" "comp.os.linux.setup" "comp.os.linux.x" |
| 155 | "mn.general" "rec.arts.movies" "rec.arts.movies.current-films" |
| 156 | "rec.food.recipes" "rec.humor") |
| 157 | "*Groups that are part of the GroupLens experiment.") |
| 158 | |
| 159 | (defvar grouplens-prediction-display 'prediction-spot |
| 160 | "valid values are: |
| 161 | prediction-spot -- an * corresponding to the prediction between 1 and 5, |
| 162 | confidence-interval -- a numeric confidence interval |
| 163 | prediction-bar -- |##### | the longer the bar, the better the article, |
| 164 | confidence-bar -- | ----- } the prediction is in the middle of the bar, |
| 165 | confidence-spot -- ) * | the spot gets bigger with more confidence, |
| 166 | prediction-num -- plain-old numeric value, |
| 167 | confidence-plus-minus -- prediction +/i confidence") |
| 168 | |
| 169 | (defvar grouplens-score-offset 0 |
| 170 | "Offset the prediction by this value. |
| 171 | Setting this variable to -2 would have the following effect on |
| 172 | GroupLens scores: |
| 173 | |
| 174 | 1 --> -2 |
| 175 | 2 --> -1 |
| 176 | 3 --> 0 |
| 177 | 4 --> 1 |
| 178 | 5 --> 2 |
| 179 | |
| 180 | The reason is that a user might want to do this is to combine |
| 181 | GroupLens predictions with scores calculated by other score methods.") |
| 182 | |
| 183 | (defvar grouplens-score-scale-factor 1 |
| 184 | "This variable allows the user to magnify the effect of GroupLens scores. |
| 185 | The scale factor is applied after the offset.") |
| 186 | |
| 187 | (defvar gnus-grouplens-override-scoring 'override |
| 188 | "Tell GroupLens to override the normal Gnus scoring mechanism. |
| 189 | GroupLens scores can be combined with gnus scores in one of three ways. |
| 190 | 'override -- just use grouplens predictions for grouplens groups |
| 191 | 'combine -- combine grouplens scores with gnus scores |
| 192 | 'separate -- treat grouplens scores completely separate from gnus") |
| 193 | |
| 194 | |
| 195 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 196 | ;;;; Program global variables |
| 197 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 198 | (defvar grouplens-bbb-token nil |
| 199 | "Current session token number.") |
| 200 | |
| 201 | (defvar grouplens-bbb-process nil |
| 202 | "Process Id of current bbbd network stream process.") |
| 203 | |
| 204 | (defvar grouplens-bbb-buffer nil |
| 205 | "Buffer associated with the BBBD process.") |
| 206 | |
| 207 | (defvar grouplens-rating-alist nil |
| 208 | "Current set of message-id rating pairs.") |
| 209 | |
| 210 | (defvar grouplens-current-hashtable nil |
| 211 | "A hashtable to hold predictions from the BBB.") |
| 212 | |
| 213 | (defvar grouplens-current-group nil) |
| 214 | |
| 215 | ;;(defvar bbb-alist nil) |
| 216 | |
| 217 | (defvar bbb-timeout-secs 10 |
| 218 | "Number of seconds to wait for some response from the BBB. |
| 219 | If this times out we give up and assume that something has died..." ) |
| 220 | |
| 221 | (defvar grouplens-previous-article nil |
| 222 | "Message-ID of the last article read.") |
| 223 | |
| 224 | (defvar bbb-read-point) |
| 225 | (defvar bbb-response-point) |
| 226 | |
| 227 | (defun bbb-renew-hash-table () |
| 228 | (setq grouplens-current-hashtable (make-vector 100 0))) |
| 229 | |
| 230 | (bbb-renew-hash-table) |
| 231 | |
| 232 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 233 | ;;;; Utility Functions |
| 234 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 235 | |
| 236 | (defun bbb-connect-to-bbbd (host port) |
| 237 | (unless grouplens-bbb-buffer |
| 238 | (setq grouplens-bbb-buffer |
| 239 | (gnus-get-buffer-create (format " *BBBD trace: %s*" host))) |
| 240 | (save-excursion |
| 241 | (set-buffer grouplens-bbb-buffer) |
| 242 | (make-local-variable 'bbb-read-point) |
| 243 | (make-local-variable 'bbb-response-point) |
| 244 | (setq bbb-read-point (point-min)))) |
| 245 | |
| 246 | ;; if an old process is still running for some reason, kill it |
| 247 | (when grouplens-bbb-process |
| 248 | (ignore-errors |
| 249 | (when (eq 'open (process-status grouplens-bbb-process)) |
| 250 | (set-process-buffer grouplens-bbb-process nil) |
| 251 | (delete-process grouplens-bbb-process)))) |
| 252 | |
| 253 | ;; clear the trace buffer of old output |
| 254 | (save-excursion |
| 255 | (set-buffer grouplens-bbb-buffer) |
| 256 | (erase-buffer)) |
| 257 | |
| 258 | ;; open the connection to the server |
| 259 | (catch 'done |
| 260 | (condition-case error |
| 261 | (setq grouplens-bbb-process |
| 262 | (open-network-stream "BBBD" grouplens-bbb-buffer host port)) |
| 263 | (error (gnus-message 3 "Error: Failed to connect to BBB") |
| 264 | nil)) |
| 265 | (and (null grouplens-bbb-process) |
| 266 | (throw 'done nil)) |
| 267 | (save-excursion |
| 268 | (set-buffer grouplens-bbb-buffer) |
| 269 | (setq bbb-read-point (point-min)) |
| 270 | (or (bbb-read-response grouplens-bbb-process) |
| 271 | (throw 'done nil)))) |
| 272 | |
| 273 | ;; return the process |
| 274 | grouplens-bbb-process) |
| 275 | |
| 276 | (defun bbb-send-command (process command) |
| 277 | (goto-char (point-max)) |
| 278 | (insert command) |
| 279 | (insert "\r\n") |
| 280 | (setq bbb-read-point (point)) |
| 281 | (setq bbb-response-point (point)) |
| 282 | (set-marker (process-mark process) (point)) ; process output also comes here |
| 283 | (process-send-string process command) |
| 284 | (process-send-string process "\r\n") |
| 285 | (process-send-eof process)) |
| 286 | |
| 287 | (defun bbb-read-response (process) |
| 288 | "This function eats the initial response of OK or ERROR from the BBB." |
| 289 | (let ((case-fold-search nil) |
| 290 | match-end) |
| 291 | (goto-char bbb-read-point) |
| 292 | (while (and (not (search-forward "\r\n" nil t)) |
| 293 | (accept-process-output process bbb-timeout-secs)) |
| 294 | (goto-char bbb-read-point)) |
| 295 | (setq match-end (point)) |
| 296 | (goto-char bbb-read-point) |
| 297 | (setq bbb-read-point match-end) |
| 298 | (looking-at "OK"))) |
| 299 | |
| 300 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 301 | ;;;; Login Functions |
| 302 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 303 | (defun bbb-login () |
| 304 | "return the token number if login is successful, otherwise return nil." |
| 305 | (interactive) |
| 306 | (setq grouplens-bbb-token nil) |
| 307 | (if (not (equal grouplens-pseudonym "")) |
| 308 | (let ((bbb-process |
| 309 | (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) |
| 310 | (if bbb-process |
| 311 | (save-excursion |
| 312 | (set-buffer (process-buffer bbb-process)) |
| 313 | (bbb-send-command bbb-process |
| 314 | (concat "login " grouplens-pseudonym)) |
| 315 | (if (bbb-read-response bbb-process) |
| 316 | (setq grouplens-bbb-token (bbb-extract-token-number)) |
| 317 | (gnus-message 3 "Error: GroupLens login failed"))))) |
| 318 | (gnus-message 3 "Error: you must set a pseudonym")) |
| 319 | grouplens-bbb-token) |
| 320 | |
| 321 | (defun bbb-extract-token-number () |
| 322 | (let ((token-pos (search-forward "token=" nil t))) |
| 323 | (when (looking-at "[0-9]+") |
| 324 | (buffer-substring token-pos (match-end 0))))) |
| 325 | |
| 326 | (gnus-add-shutdown 'bbb-logout 'gnus) |
| 327 | |
| 328 | (defun bbb-logout () |
| 329 | "logout of bbb session." |
| 330 | (when grouplens-bbb-token |
| 331 | (let ((bbb-process |
| 332 | (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) |
| 333 | (when bbb-process |
| 334 | (save-excursion |
| 335 | (set-buffer (process-buffer bbb-process)) |
| 336 | (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token)) |
| 337 | (bbb-read-response bbb-process)))))) |
| 338 | |
| 339 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 340 | ;;;; Get Predictions |
| 341 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 342 | |
| 343 | (defun bbb-build-mid-scores-alist (groupname) |
| 344 | "this function can be called as part of the function to return the list of score files to use. |
| 345 | See the gnus variable gnus-score-find-score-files-function. |
| 346 | |
| 347 | *Note:* If you want to use grouplens scores along with calculated scores, |
| 348 | you should see the offset and scale variables. At this point, I don't |
| 349 | recommend using both scores and grouplens predictions together." |
| 350 | (setq grouplens-current-group groupname) |
| 351 | (when (member groupname grouplens-newsgroups) |
| 352 | (setq grouplens-previous-article nil) |
| 353 | ;; scores-alist should be a list of lists: |
| 354 | ;; ((("message-id" ("<mid1>" score1 nil s) ("<mid2> score2 nil s)))) |
| 355 | ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value |
| 356 | (list |
| 357 | (list |
| 358 | (list (append (list "message-id") |
| 359 | (bbb-get-predictions (bbb-get-all-mids) groupname))))))) |
| 360 | |
| 361 | (defun bbb-get-predictions (midlist groupname) |
| 362 | "Ask the bbb for predictions, and build up the score alist." |
| 363 | (gnus-message 5 "Fetching Predictions...") |
| 364 | (if grouplens-bbb-token |
| 365 | (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host |
| 366 | grouplens-bbb-port))) |
| 367 | (when bbb-process |
| 368 | (save-excursion |
| 369 | (set-buffer (process-buffer bbb-process)) |
| 370 | (bbb-send-command bbb-process |
| 371 | (bbb-build-predict-command midlist groupname |
| 372 | grouplens-bbb-token)) |
| 373 | (if (bbb-read-response bbb-process) |
| 374 | (bbb-get-prediction-response bbb-process) |
| 375 | (gnus-message 1 "Invalid Token, login and try again") |
| 376 | (ding))))) |
| 377 | (gnus-message 3 "Error: You are not logged in to a BBB") |
| 378 | (ding))) |
| 379 | |
| 380 | (defun bbb-get-all-mids () |
| 381 | (mapcar (function (lambda (x) (mail-header-id x))) gnus-newsgroup-headers)) |
| 382 | |
| 383 | (defun bbb-build-predict-command (mlist grpname token) |
| 384 | (concat "getpredictions " token " " grpname "\r\n" |
| 385 | (mapconcat 'identity mlist "\r\n") "\r\n.\r\n")) |
| 386 | |
| 387 | (defun bbb-get-prediction-response (process) |
| 388 | (let ((case-fold-search nil)) |
| 389 | (goto-char bbb-read-point) |
| 390 | (while (and (not (search-forward ".\r\n" nil t)) |
| 391 | (accept-process-output process bbb-timeout-secs)) |
| 392 | (goto-char bbb-read-point)) |
| 393 | (goto-char (+ bbb-response-point 4));; we ought to be right before OK |
| 394 | (bbb-build-response-alist))) |
| 395 | |
| 396 | ;; build-response-alist assumes that the cursor has been positioned at |
| 397 | ;; the first line of the list of mid/rating pairs. |
| 398 | (defun bbb-build-response-alist () |
| 399 | (let (resp mid pred) |
| 400 | (while |
| 401 | (cond |
| 402 | ((looking-at "\\(<.*>\\) :nopred=") |
| 403 | ;;(push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp) |
| 404 | (forward-line 1) |
| 405 | t) |
| 406 | ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)") |
| 407 | (setq mid (bbb-get-mid) |
| 408 | pred (bbb-get-pred)) |
| 409 | (push `(,mid ,pred nil s) resp) |
| 410 | (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh)) |
| 411 | grouplens-current-hashtable) |
| 412 | (forward-line 1) |
| 413 | t) |
| 414 | ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)") |
| 415 | (setq mid (bbb-get-mid) |
| 416 | pred (bbb-get-pred)) |
| 417 | (push `(,mid ,pred nil s) resp) |
| 418 | (gnus-sethash mid (list pred 0 0) grouplens-current-hashtable) |
| 419 | (forward-line 1) |
| 420 | t) |
| 421 | (t nil))) |
| 422 | resp)) |
| 423 | |
| 424 | ;; these "get" functions assume that there is an active match lying |
| 425 | ;; around. Where the first parenthesized expression is the |
| 426 | ;; message-id, and the second is the prediction, the third and fourth |
| 427 | ;; are the confidence interval |
| 428 | ;; |
| 429 | ;; Since gnus assumes that scores are integer values?? we round the |
| 430 | ;; prediction. |
| 431 | (defun bbb-get-mid () |
| 432 | (buffer-substring (match-beginning 1) (match-end 1))) |
| 433 | |
| 434 | (defun bbb-get-pred () |
| 435 | (let ((tpred (string-to-number (buffer-substring (match-beginning 2) |
| 436 | (match-end 2))))) |
| 437 | (if (> tpred 0) |
| 438 | (round (* grouplens-score-scale-factor |
| 439 | (+ grouplens-score-offset tpred))) |
| 440 | 1))) |
| 441 | |
| 442 | (defun bbb-get-confl () |
| 443 | (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) |
| 444 | |
| 445 | (defun bbb-get-confh () |
| 446 | (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) |
| 447 | |
| 448 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 449 | ;;;; Prediction Display |
| 450 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 451 | (defconst grplens-rating-range 4.0) |
| 452 | (defconst grplens-maxrating 5) |
| 453 | (defconst grplens-minrating 1) |
| 454 | (defconst grplens-predstringsize 12) |
| 455 | |
| 456 | (defvar gnus-tmp-score) |
| 457 | (defun bbb-grouplens-score (header) |
| 458 | (if (eq gnus-grouplens-override-scoring 'separate) |
| 459 | (bbb-grouplens-other-score header) |
| 460 | (let* ((rate-string (make-string 12 ?\ )) |
| 461 | (mid (mail-header-id header)) |
| 462 | (hashent (gnus-gethash mid grouplens-current-hashtable)) |
| 463 | (iscore gnus-tmp-score) |
| 464 | (low (car (cdr hashent))) |
| 465 | (high (car (cdr (cdr hashent))))) |
| 466 | (aset rate-string 0 ?|) |
| 467 | (aset rate-string 11 ?|) |
| 468 | (unless (member grouplens-current-group grouplens-newsgroups) |
| 469 | (unless (equal grouplens-prediction-display 'prediction-num) |
| 470 | (cond ((< iscore 0) |
| 471 | (setq iscore 1)) |
| 472 | ((> iscore 5) |
| 473 | (setq iscore 5)))) |
| 474 | (setq low 0) |
| 475 | (setq high 0)) |
| 476 | (if (and (bbb-valid-score iscore) |
| 477 | (not (null mid))) |
| 478 | (cond |
| 479 | ;; prediction-spot |
| 480 | ((equal grouplens-prediction-display 'prediction-spot) |
| 481 | (setq rate-string (bbb-fmt-prediction-spot rate-string iscore))) |
| 482 | ;; confidence-interval |
| 483 | ((equal grouplens-prediction-display 'confidence-interval) |
| 484 | (setq rate-string (bbb-fmt-confidence-interval iscore low high))) |
| 485 | ;; prediction-bar |
| 486 | ((equal grouplens-prediction-display 'prediction-bar) |
| 487 | (setq rate-string (bbb-fmt-prediction-bar rate-string iscore))) |
| 488 | ;; confidence-bar |
| 489 | ((equal grouplens-prediction-display 'confidence-bar) |
| 490 | (setq rate-string (format "| %4.2f |" iscore))) |
| 491 | ;; confidence-spot |
| 492 | ((equal grouplens-prediction-display 'confidence-spot) |
| 493 | (setq rate-string (format "| %4.2f |" iscore))) |
| 494 | ;; prediction-num |
| 495 | ((equal grouplens-prediction-display 'prediction-num) |
| 496 | (setq rate-string (bbb-fmt-prediction-num iscore))) |
| 497 | ;; confidence-plus-minus |
| 498 | ((equal grouplens-prediction-display 'confidence-plus-minus) |
| 499 | (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high)) |
| 500 | ) |
| 501 | (t (gnus-message 3 "Invalid prediction display type"))) |
| 502 | (aset rate-string 5 ?N) (aset rate-string 6 ?A)) |
| 503 | rate-string))) |
| 504 | |
| 505 | ;; Gnus user format function that doesn't depend on |
| 506 | ;; bbb-build-mid-scores-alist being used as the score function, but is |
| 507 | ;; instead called from gnus-select-group-hook. -- LAB |
| 508 | (defun bbb-grouplens-other-score (header) |
| 509 | (if (not (member grouplens-current-group grouplens-newsgroups)) |
| 510 | ;; Return an empty string |
| 511 | "" |
| 512 | (let* ((rate-string (make-string 12 ?\ )) |
| 513 | (mid (mail-header-id header)) |
| 514 | (hashent (gnus-gethash mid grouplens-current-hashtable)) |
| 515 | (pred (or (nth 0 hashent) 0)) |
| 516 | (low (nth 1 hashent)) |
| 517 | (high (nth 2 hashent))) |
| 518 | ;; Init rate-string |
| 519 | (aset rate-string 0 ?|) |
| 520 | (aset rate-string 11 ?|) |
| 521 | (unless (equal grouplens-prediction-display 'prediction-num) |
| 522 | (cond ((< pred 0) |
| 523 | (setq pred 1)) |
| 524 | ((> pred 5) |
| 525 | (setq pred 5)))) |
| 526 | ;; If no entry in BBB hash mark rate string as NA and return |
| 527 | (cond |
| 528 | ((null hashent) |
| 529 | (aset rate-string 5 ?N) |
| 530 | (aset rate-string 6 ?A) |
| 531 | rate-string) |
| 532 | |
| 533 | ((equal grouplens-prediction-display 'prediction-spot) |
| 534 | (bbb-fmt-prediction-spot rate-string pred)) |
| 535 | |
| 536 | ((equal grouplens-prediction-display 'confidence-interval) |
| 537 | (bbb-fmt-confidence-interval pred low high)) |
| 538 | |
| 539 | ((equal grouplens-prediction-display 'prediction-bar) |
| 540 | (bbb-fmt-prediction-bar rate-string pred)) |
| 541 | |
| 542 | ((equal grouplens-prediction-display 'confidence-bar) |
| 543 | (format "| %4.2f |" pred)) |
| 544 | |
| 545 | ((equal grouplens-prediction-display 'confidence-spot) |
| 546 | (format "| %4.2f |" pred)) |
| 547 | |
| 548 | ((equal grouplens-prediction-display 'prediction-num) |
| 549 | (bbb-fmt-prediction-num pred)) |
| 550 | |
| 551 | ((equal grouplens-prediction-display 'confidence-plus-minus) |
| 552 | (bbb-fmt-confidence-plus-minus pred low high)) |
| 553 | |
| 554 | (t |
| 555 | (gnus-message 3 "Invalid prediction display type") |
| 556 | (aset rate-string 0 ?|) |
| 557 | (aset rate-string 11 ?|) |
| 558 | rate-string))))) |
| 559 | |
| 560 | (defun bbb-valid-score (score) |
| 561 | (or (equal grouplens-prediction-display 'prediction-num) |
| 562 | (and (>= score grplens-minrating) |
| 563 | (<= score grplens-maxrating)))) |
| 564 | |
| 565 | (defun bbb-requires-confidence (format-type) |
| 566 | (or (equal format-type 'confidence-plus-minus) |
| 567 | (equal format-type 'confidence-spot) |
| 568 | (equal format-type 'confidence-interval))) |
| 569 | |
| 570 | (defun bbb-have-confidence (clow chigh) |
| 571 | (not (or (null clow) |
| 572 | (null chigh)))) |
| 573 | |
| 574 | (defun bbb-fmt-prediction-spot (rate-string score) |
| 575 | (aset rate-string |
| 576 | (round (* (/ (- score grplens-minrating) grplens-rating-range) |
| 577 | (+ (- grplens-predstringsize 4) 1.49))) |
| 578 | ?*) |
| 579 | rate-string) |
| 580 | |
| 581 | (defun bbb-fmt-confidence-interval (score low high) |
| 582 | (if (bbb-have-confidence low high) |
| 583 | (format "|%4.2f-%4.2f |" low high) |
| 584 | (bbb-fmt-prediction-num score))) |
| 585 | |
| 586 | (defun bbb-fmt-confidence-plus-minus (score low high) |
| 587 | (if (bbb-have-confidence low high) |
| 588 | (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0)) |
| 589 | (bbb-fmt-prediction-num score))) |
| 590 | |
| 591 | (defun bbb-fmt-prediction-bar (rate-string score) |
| 592 | (let* ((i 1) |
| 593 | (step (/ grplens-rating-range (- grplens-predstringsize 4))) |
| 594 | (half-step (/ step 2)) |
| 595 | (loc (- grplens-minrating half-step))) |
| 596 | (while (< i (- grplens-predstringsize 2)) |
| 597 | (if (> score loc) |
| 598 | (aset rate-string i ?#) |
| 599 | (aset rate-string i ?\ )) |
| 600 | (setq i (+ i 1)) |
| 601 | (setq loc (+ loc step))) |
| 602 | ) |
| 603 | rate-string) |
| 604 | |
| 605 | (defun bbb-fmt-prediction-num (score) |
| 606 | (format "| %4.2f |" score)) |
| 607 | |
| 608 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 609 | ;;;; Put Ratings |
| 610 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 611 | |
| 612 | (defun bbb-put-ratings () |
| 613 | (if (and grouplens-bbb-token |
| 614 | grouplens-rating-alist |
| 615 | (member gnus-newsgroup-name grouplens-newsgroups)) |
| 616 | (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host |
| 617 | grouplens-bbb-port)) |
| 618 | (rate-command (bbb-build-rate-command grouplens-rating-alist))) |
| 619 | (if bbb-process |
| 620 | (save-excursion |
| 621 | (set-buffer (process-buffer bbb-process)) |
| 622 | (gnus-message 5 "Sending Ratings...") |
| 623 | (bbb-send-command bbb-process rate-command) |
| 624 | (if (bbb-read-response bbb-process) |
| 625 | (setq grouplens-rating-alist nil) |
| 626 | (gnus-message 1 |
| 627 | "Token timed out: call bbb-login and quit again") |
| 628 | (ding)) |
| 629 | (gnus-message 5 "Sending Ratings...Done")) |
| 630 | (gnus-message 3 "No BBB connection"))) |
| 631 | (setq grouplens-rating-alist nil))) |
| 632 | |
| 633 | (defun bbb-build-rate-command (rate-alist) |
| 634 | (concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n" |
| 635 | (mapconcat '(lambda (this) ; form (mid . (score . time)) |
| 636 | (concat (car this) |
| 637 | " :rating=" (cadr this) ".00" |
| 638 | " :time=" (cddr this))) |
| 639 | rate-alist "\r\n") |
| 640 | "\r\n.\r\n")) |
| 641 | |
| 642 | ;; Interactive rating functions. |
| 643 | (defun bbb-summary-rate-article (rating &optional midin) |
| 644 | (interactive "nRating: ") |
| 645 | (when (member gnus-newsgroup-name grouplens-newsgroups) |
| 646 | (let ((mid (or midin (bbb-get-current-id)))) |
| 647 | (if (and rating |
| 648 | (>= rating grplens-minrating) |
| 649 | (<= rating grplens-maxrating) |
| 650 | mid) |
| 651 | (let ((oldrating (assoc mid grouplens-rating-alist))) |
| 652 | (if oldrating |
| 653 | (setcdr oldrating (cons rating 0)) |
| 654 | (push `(,mid . (,rating . 0)) grouplens-rating-alist)) |
| 655 | (gnus-summary-mark-article nil (int-to-string rating))) |
| 656 | (gnus-message 3 "Invalid rating"))))) |
| 657 | |
| 658 | (defun grouplens-next-unread-article (rating) |
| 659 | "Select unread article after current one." |
| 660 | (interactive "P") |
| 661 | (when rating |
| 662 | (bbb-summary-rate-article rating)) |
| 663 | (gnus-summary-next-unread-article)) |
| 664 | |
| 665 | (defun grouplens-best-unread-article (rating) |
| 666 | "Select unread article after current one." |
| 667 | (interactive "P") |
| 668 | (when rating |
| 669 | (bbb-summary-rate-article rating)) |
| 670 | (gnus-summary-best-unread-article)) |
| 671 | |
| 672 | (defun grouplens-summary-catchup-and-exit (rating) |
| 673 | "Mark all articles not marked as unread in this newsgroup as read, then exit. |
| 674 | If prefix argument ALL is non-nil, all articles are marked as read." |
| 675 | (interactive "P") |
| 676 | (when rating |
| 677 | (bbb-summary-rate-article rating)) |
| 678 | (if (numberp rating) |
| 679 | (gnus-summary-catchup-and-exit) |
| 680 | (gnus-summary-catchup-and-exit rating))) |
| 681 | |
| 682 | (defun grouplens-score-thread (score) |
| 683 | "Raise the score of the articles in the current thread with SCORE." |
| 684 | (interactive "nRating: ") |
| 685 | (let (e) |
| 686 | (save-excursion |
| 687 | (let ((articles (gnus-summary-articles-in-thread)) |
| 688 | article) |
| 689 | (while (setq article (pop articles)) |
| 690 | (gnus-summary-goto-subject article) |
| 691 | (bbb-summary-rate-article score |
| 692 | (mail-header-id |
| 693 | (gnus-summary-article-header article))))) |
| 694 | (setq e (point))) |
| 695 | (let ((gnus-summary-check-current t)) |
| 696 | (or (zerop (gnus-summary-next-subject 1 t)) |
| 697 | (goto-char e)))) |
| 698 | (gnus-summary-recenter) |
| 699 | (gnus-summary-position-point) |
| 700 | (gnus-set-mode-line 'summary)) |
| 701 | |
| 702 | (defun bbb-exit-group () |
| 703 | (bbb-put-ratings) |
| 704 | (bbb-renew-hash-table)) |
| 705 | |
| 706 | (defun bbb-get-current-id () |
| 707 | (if gnus-current-headers |
| 708 | (mail-header-id gnus-current-headers) |
| 709 | (gnus-message 3 "You must select an article before you rate it"))) |
| 710 | |
| 711 | (defun bbb-grouplens-group-p (group) |
| 712 | "Say whether GROUP is a GroupLens group." |
| 713 | (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" "")) |
| 714 | |
| 715 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 716 | ;; TIME SPENT READING |
| 717 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 718 | (defvar grouplens-current-starting-time nil) |
| 719 | |
| 720 | (defun grouplens-start-timer () |
| 721 | (setq grouplens-current-starting-time (current-time))) |
| 722 | |
| 723 | (defun grouplens-elapsed-time () |
| 724 | (let ((et (bbb-time-float (current-time)))) |
| 725 | (- et (bbb-time-float grouplens-current-starting-time)))) |
| 726 | |
| 727 | (defun bbb-time-float (timeval) |
| 728 | (+ (* (car timeval) 65536) |
| 729 | (cadr timeval))) |
| 730 | |
| 731 | (defun grouplens-do-time () |
| 732 | (when (member gnus-newsgroup-name grouplens-newsgroups) |
| 733 | (when grouplens-previous-article |
| 734 | (let ((elapsed-time (grouplens-elapsed-time)) |
| 735 | (oldrating (assoc grouplens-previous-article |
| 736 | grouplens-rating-alist))) |
| 737 | (if (not oldrating) |
| 738 | (push `(,grouplens-previous-article . (0 . ,elapsed-time)) |
| 739 | grouplens-rating-alist) |
| 740 | (setcdr oldrating (cons (cadr oldrating) elapsed-time))))) |
| 741 | (grouplens-start-timer) |
| 742 | (setq grouplens-previous-article (bbb-get-current-id)))) |
| 743 | |
| 744 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 745 | ;; BUG REPORTING |
| 746 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 747 | |
| 748 | (defconst gnus-gl-version "gnus-gl.el 2.50") |
| 749 | (defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu") |
| 750 | (defun gnus-gl-submit-bug-report () |
| 751 | "Submit via mail a bug report on gnus-gl." |
| 752 | (interactive) |
| 753 | (require 'reporter) |
| 754 | (reporter-submit-bug-report gnus-gl-maintainer-address |
| 755 | (concat "gnus-gl.el " gnus-gl-version) |
| 756 | (list 'grouplens-pseudonym |
| 757 | 'grouplens-bbb-host |
| 758 | 'grouplens-bbb-port |
| 759 | 'grouplens-newsgroups |
| 760 | 'grouplens-bbb-token |
| 761 | 'grouplens-bbb-process |
| 762 | 'grouplens-current-group |
| 763 | 'grouplens-previous-article) |
| 764 | nil |
| 765 | 'gnus-gl-get-trace)) |
| 766 | |
| 767 | (defun gnus-gl-get-trace () |
| 768 | "Insert the contents of the BBBD trace buffer." |
| 769 | (when grouplens-bbb-buffer |
| 770 | (insert-buffer-substring grouplens-bbb-buffer))) |
| 771 | |
| 772 | ;; |
| 773 | ;; GroupLens minor mode |
| 774 | ;; |
| 775 | |
| 776 | (defvar gnus-grouplens-mode nil |
| 777 | "Minor mode for providing a GroupLens interface in Gnus summary buffers.") |
| 778 | |
| 779 | (defvar gnus-grouplens-mode-map nil) |
| 780 | |
| 781 | (unless gnus-grouplens-mode-map |
| 782 | (setq gnus-grouplens-mode-map (make-keymap)) |
| 783 | (gnus-define-keys |
| 784 | gnus-grouplens-mode-map |
| 785 | "n" grouplens-next-unread-article |
| 786 | "r" bbb-summary-rate-article |
| 787 | "k" grouplens-score-thread |
| 788 | "c" grouplens-summary-catchup-and-exit |
| 789 | "," grouplens-best-unread-article)) |
| 790 | |
| 791 | (defun gnus-grouplens-make-menu-bar () |
| 792 | (unless (boundp 'gnus-grouplens-menu) |
| 793 | (easy-menu-define |
| 794 | gnus-grouplens-menu gnus-grouplens-mode-map "" |
| 795 | '("GroupLens" |
| 796 | ["Login" bbb-login t] |
| 797 | ["Rate" bbb-summary-rate-article t] |
| 798 | ["Next article" grouplens-next-unread-article t] |
| 799 | ["Best article" grouplens-best-unread-article t] |
| 800 | ["Raise thread" grouplens-score-thread t] |
| 801 | ["Report bugs" gnus-gl-submit-bug-report t])))) |
| 802 | |
| 803 | (defun gnus-grouplens-mode (&optional arg) |
| 804 | "Minor mode for providing a GroupLens interface in Gnus summary buffers." |
| 805 | (interactive "P") |
| 806 | (when (and (eq major-mode 'gnus-summary-mode) |
| 807 | (member gnus-newsgroup-name grouplens-newsgroups)) |
| 808 | (make-local-variable 'gnus-grouplens-mode) |
| 809 | (setq gnus-grouplens-mode |
| 810 | (if (null arg) (not gnus-grouplens-mode) |
| 811 | (> (prefix-numeric-value arg) 0))) |
| 812 | (when gnus-grouplens-mode |
| 813 | (make-local-hook 'gnus-select-article-hook) |
| 814 | (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local) |
| 815 | (make-local-hook 'gnus-exit-group-hook) |
| 816 | (add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local) |
| 817 | (make-local-variable 'gnus-score-find-score-files-function) |
| 818 | |
| 819 | (cond |
| 820 | ((eq gnus-grouplens-override-scoring 'combine) |
| 821 | ;; either add bbb-buld-mid-scores-alist to a list |
| 822 | ;; or make a list |
| 823 | (if (listp gnus-score-find-score-files-function) |
| 824 | (setq gnus-score-find-score-files-function |
| 825 | (append 'bbb-build-mid-scores-alist |
| 826 | gnus-score-find-score-files-function)) |
| 827 | (setq gnus-score-find-score-files-function |
| 828 | (list gnus-score-find-score-files-function |
| 829 | 'bbb-build-mid-scores-alist)))) |
| 830 | ;; leave the gnus-score-find-score-files variable alone |
| 831 | ((eq gnus-grouplens-override-scoring 'separate) |
| 832 | (add-hook 'gnus-select-group-hook |
| 833 | (lambda () |
| 834 | (bbb-get-predictions (bbb-get-all-mids) |
| 835 | gnus-newsgroup-name)))) |
| 836 | ;; default is to override |
| 837 | (t |
| 838 | (setq gnus-score-find-score-files-function |
| 839 | 'bbb-build-mid-scores-alist))) |
| 840 | |
| 841 | ;; Change how summary lines look |
| 842 | (make-local-variable 'gnus-summary-line-format) |
| 843 | (make-local-variable 'gnus-summary-line-format-spec) |
| 844 | (setq gnus-summary-line-format gnus-summary-grouplens-line-format) |
| 845 | (setq gnus-summary-line-format-spec nil) |
| 846 | (gnus-update-format-specifications nil 'summary) |
| 847 | (gnus-update-summary-mark-positions) |
| 848 | |
| 849 | ;; Set up the menu. |
| 850 | (when (and menu-bar-mode |
| 851 | (gnus-visual-p 'grouplens-menu 'menu)) |
| 852 | (gnus-grouplens-make-menu-bar)) |
| 853 | (gnus-add-minor-mode |
| 854 | 'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map) |
| 855 | (gnus-run-hooks 'gnus-grouplens-mode-hook)))) |
| 856 | |
| 857 | (provide 'gnus-gl) |
| 858 | |
| 859 | ;;; gnus-gl.el ends here |