-
Notifications
You must be signed in to change notification settings - Fork 0
/
irchat-uah-cache.el
104 lines (90 loc) · 3.12 KB
/
irchat-uah-cache.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
;;; -*- emacs-lisp -*-
;;;
;;; see file irchat-copyright.el for change log and copyright info
;;;
;;; Nick to user-at-host cache by jsl.
;;; Modifications by tri.
;;;
;;; Created : Mon Mar 10 17:07:39 1997 tri
;;; Integrated to Irchat : Sun Oct 19 1997 tri
;;;
(eval-when-compile
(require 'irchat-inlines))
(eval-and-compile
(require 'irchat-vars))
(defconst irchat-nick-to-uah-vector-length 256
"*Vector length")
(defvar irchat-nick-to-uah-pos 0
"Current update position")
(defvar irchat-nick-to-uah-vector nil
"*Vector to store nick to user-at-host mappings")
(defun irchat-nick-to-uah-init ()
(setq irchat-nick-to-uah-vector
(make-vector irchat-nick-to-uah-vector-length (list "" "" 'invalid)))
(setq irchat-nick-to-uah-pos 0))
(defun irchat-nick-to-uah-append (nick uah &optional type)
"Append NICK UAH tuple into the vector"
(if (null irchat-nick-to-uah-vector)
(irchat-nick-to-uah-init))
(if (null type)
(setq type 'unknown))
(if (and (stringp nick)
(stringp uah)
(> (length nick) 0)
(> (length uah) 0))
(progn
(aset irchat-nick-to-uah-vector irchat-nick-to-uah-pos
(list nick uah type))
(setq irchat-nick-to-uah-pos (mod (+ irchat-nick-to-uah-pos 1)
irchat-nick-to-uah-vector-length)))))
(defun irchat-nick-to-uah-raw (nick)
"Find uah and uah-type associated with NICK from cache if possible."
(if (null irchat-nick-to-uah-vector)
(irchat-nick-to-uah-init))
(let ((pos (if (= irchat-nick-to-uah-pos 0)
(- irchat-nick-to-uah-vector-length 1)
(- irchat-nick-to-uah-pos 1))))
(while (and (not (string-ci-equal nick (car (elt irchat-nick-to-uah-vector
pos))))
(not (= pos irchat-nick-to-uah-pos)))
(setq pos (if (= pos 0)
(- irchat-nick-to-uah-vector-length 1)
(- pos 1))))
(let ((n (nth 0 (elt irchat-nick-to-uah-vector pos)))
(u (nth 1 (elt irchat-nick-to-uah-vector pos)))
(m (nth 2 (elt irchat-nick-to-uah-vector pos))))
(if (and (string-ci-equal nick n)
(not (equal m 'invalid))
(stringp u)
(> (length u) 0))
(list u m)
nil))))
(defun irchat-nick-to-uah (nick)
"Find uah associated with NICK from cache if possible."
(let ((r (irchat-nick-to-uah-raw nick)))
(if (null r)
nil
(nth 0 r))))
(defun irchat-convert-uah-to-ignore-list (uah)
"Convert UAH-string to list of regexps to be ignored."
(let ((usr nil)
(dom nil))
(cond ((string-match "^\\([^ \t@][^ \t@]*\\)@[^ \t@][^ \t@]*\\.\\([^ \t@.][^ \t@.]*\\.[^ \t@.][^ \t@.]*\\)$"
uah)
(setq usr (substring uah (match-beginning 1) (match-end 1)))
(setq dom (substring uah (match-beginning 2) (match-end 2))))
((string-match "^\\([^ \t@][^ \t@]*\\)@\\([^ \t@.][^ \t@.]*\\.[^ \t@.][^ \t@.]*\\)$"
uah)
(setq usr (substring uah (match-beginning 1) (match-end 1)))
(setq dom (substring uah (match-beginning 2) (match-end 2)))))
(if (and usr dom)
(progn
(setq usr (regexp-quote usr))
(setq dom (regexp-quote dom))
(list (format "%s@%s" usr dom) (format "%s@.*\\.%s" usr dom)))
(list (regexp-quote uah)))))
(eval-and-compile
(provide 'irchat-uah-cache))
;;;
;;; eof
;;;