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