1;;; gnus-gl.el --- an interface to GroupLens for Gnus 2 3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 4;; 2004, 2005, 2006, 2007 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., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, 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: %-23,23n%]%) %s\n" 135 "*The line format spec in summary GroupLens mode buffers.") 136 137(defvar grouplens-pseudonym "" 138 "User's pseudonym. 139This 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. 171Setting this variable to -2 would have the following effect on 172GroupLens scores: 173 174 1 --> -2 175 2 --> -1 176 3 --> 0 177 4 --> 1 178 5 --> 2 179 180The reason is that a user might want to do this is to combine 181GroupLens 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. 185The 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. 189GroupLens 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. 219If 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. 345See the gnus variable `gnus-score-find-score-files-function'. 346 347*Note:* If you want to use grouplens scores along with calculated scores, 348you should see the offset and scale variables. At this point, I don't 349recommend 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. 674If 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 (gnus-make-local-hook 'gnus-select-article-hook) 814 (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local) 815 (gnus-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;;; arch-tag: 6f1bab2c-c2a3-4764-9ef6-0714cd5902a4 860;;; gnus-gl.el ends here 861