erc-backend.el 79 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018
  1. ;;; erc-backend.el --- Backend network communication for ERC
  2. ;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
  3. ;; Filename: erc-backend.el
  4. ;; Author: Lawrence Mitchell <wence@gmx.li>
  5. ;; Maintainer: emacs-devel@gnu.org
  6. ;; Created: 2004-05-7
  7. ;; Keywords: IRC chat client internet
  8. ;; This file is part of GNU Emacs.
  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 3 of the License, or
  12. ;; (at your option) any later version.
  13. ;; GNU Emacs is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. ;; GNU General Public License for more details.
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  19. ;;; Commentary:
  20. ;; This file defines backend network communication handlers for ERC.
  21. ;;
  22. ;; How things work:
  23. ;;
  24. ;; You define a new handler with `define-erc-response-handler'. This
  25. ;; defines a function, a corresponding hook variable, and populates a
  26. ;; global hash table `erc-server-responses' with a map from response
  27. ;; to hook variable. See the function documentation for more
  28. ;; information.
  29. ;;
  30. ;; Upon receiving a line from the server, `erc-parse-server-response'
  31. ;; is called on it.
  32. ;;
  33. ;; A line generally looks like:
  34. ;;
  35. ;; LINE := ':' SENDER ' ' COMMAND ' ' (COMMAND-ARGS ' ')* ':' CONTENTS
  36. ;; SENDER := Not ':' | ' '
  37. ;; COMMAND := Not ':' | ' '
  38. ;; COMMAND-ARGS := Not ':' | ' '
  39. ;;
  40. ;; This gets parsed and stuffed into an `erc-response' struct. You
  41. ;; can access the fields of the struct with:
  42. ;;
  43. ;; COMMAND --- `erc-response.command'
  44. ;; COMMAND-ARGS --- `erc-response.command-args'
  45. ;; CONTENTS --- `erc-response.contents'
  46. ;; SENDER --- `erc-response.sender'
  47. ;; LINE --- `erc-response.unparsed'
  48. ;;
  49. ;; WARNING, WARNING!!
  50. ;; It's probably not a good idea to destructively modify the list
  51. ;; of command-args in your handlers, since other functions down the
  52. ;; line may well need to access the arguments too.
  53. ;;
  54. ;; That is, unless you're /absolutely/ sure that your handler doesn't
  55. ;; invoke some other function that needs to use COMMAND-ARGS, don't do
  56. ;; something like
  57. ;;
  58. ;; (while (erc-response.command-args parsed)
  59. ;; (let ((a (pop (erc-response.command-args parsed))))
  60. ;; ...))
  61. ;;
  62. ;; The parsed response is handed over to
  63. ;; `erc-handle-parsed-server-response', which checks whether it should
  64. ;; carry out duplicate suppression, and then runs `erc-call-hooks'.
  65. ;; `erc-call-hooks' retrieves the relevant hook variable from
  66. ;; `erc-server-responses' and runs it.
  67. ;;
  68. ;; Most handlers then destructure the parsed response in some way
  69. ;; (depending on what the handler is, the arguments have different
  70. ;; meanings), and generally display something, usually using
  71. ;; `erc-display-message'.
  72. ;;; TODO:
  73. ;; o Generalize the display-line code so that we can use it to
  74. ;; display the stuff we send, as well as the stuff we receive.
  75. ;; Then, move all display-related code into another backend-like
  76. ;; file, erc-display.el, say.
  77. ;;
  78. ;; o Clean up the handlers using new display code (has to be written
  79. ;; first).
  80. ;;; History:
  81. ;; 2004/05/10 -- Handler bodies taken out of erc.el and ported to new
  82. ;; interface.
  83. ;; 2005-08-13 -- Moved sending commands from erc.el.
  84. ;;; Code:
  85. (require 'erc-compat)
  86. (eval-when-compile (require 'cl-lib))
  87. ;; There's a fairly strong mutual dependency between erc.el and erc-backend.el.
  88. ;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the
  89. ;; reverse is true:
  90. (provide 'erc-backend)
  91. (require 'erc)
  92. ;;;; Variables and options
  93. (defvar erc-server-responses (make-hash-table :test #'equal)
  94. "Hashtable mapping server responses to their handler hooks.")
  95. (cl-defstruct (erc-response (:conc-name erc-response.))
  96. (unparsed "" :type string)
  97. (sender "" :type string)
  98. (command "" :type string)
  99. (command-args '() :type list)
  100. (contents "" :type string))
  101. ;;; User data
  102. (defvar erc-server-current-nick nil
  103. "Nickname on the current server.
  104. Use `erc-current-nick' to access this.")
  105. (make-variable-buffer-local 'erc-server-current-nick)
  106. ;;; Server attributes
  107. (defvar erc-server-process nil
  108. "The process object of the corresponding server connection.")
  109. (make-variable-buffer-local 'erc-server-process)
  110. (defvar erc-session-server nil
  111. "The server name used to connect to for this session.")
  112. (make-variable-buffer-local 'erc-session-server)
  113. (defvar erc-session-connector nil
  114. "The function used to connect to this session (nil for the default).")
  115. (make-variable-buffer-local 'erc-session-connector)
  116. (defvar erc-session-port nil
  117. "The port used to connect to.")
  118. (make-variable-buffer-local 'erc-session-port)
  119. (defvar erc-server-announced-name nil
  120. "The name the server announced to use.")
  121. (make-variable-buffer-local 'erc-server-announced-name)
  122. (defvar erc-server-version nil
  123. "The name and version of the server's ircd.")
  124. (make-variable-buffer-local 'erc-server-version)
  125. (defvar erc-server-parameters nil
  126. "Alist listing the supported server parameters.
  127. This is only set if the server sends 005 messages saying what is
  128. supported on the server.
  129. Entries are of the form:
  130. (PARAMETER . VALUE)
  131. or
  132. (PARAMETER) if no value is provided.
  133. Some examples of possible parameters sent by servers:
  134. CHANMODES=b,k,l,imnpst - list of supported channel modes
  135. CHANNELLEN=50 - maximum length of channel names
  136. CHANTYPES=#&!+ - supported channel prefixes
  137. CHARMAPPING=rfc1459 - character mapping used for nickname and channels
  138. KICKLEN=160 - maximum allowed kick message length
  139. MAXBANS=30 - maximum number of bans per channel
  140. MAXCHANNELS=10 - maximum number of channels allowed to join
  141. NETWORK=EFnet - the network identifier
  142. NICKLEN=9 - maximum allowed length of nicknames
  143. PREFIX=(ov)@+ - list of channel modes and the user prefixes if user has mode
  144. RFC2812 - server supports RFC 2812 features
  145. SILENCE=10 - supports the SILENCE command, maximum allowed number of entries
  146. TOPICLEN=160 - maximum allowed topic length
  147. WALLCHOPS - supports sending messages to all operators in a channel")
  148. (make-variable-buffer-local 'erc-server-parameters)
  149. ;;; Server and connection state
  150. (defvar erc-server-ping-timer-alist nil
  151. "Mapping of server buffers to their specific ping timer.")
  152. (defvar erc-server-connected nil
  153. "Non-nil if the current buffer has been used by ERC to establish
  154. an IRC connection.
  155. If you wish to determine whether an IRC connection is currently
  156. active, use the `erc-server-process-alive' function instead.")
  157. (make-variable-buffer-local 'erc-server-connected)
  158. (defvar erc-server-reconnect-count 0
  159. "Number of times we have failed to reconnect to the current server.")
  160. (make-variable-buffer-local 'erc-server-reconnect-count)
  161. (defvar erc-server-quitting nil
  162. "Non-nil if the user requests a quit.")
  163. (make-variable-buffer-local 'erc-server-quitting)
  164. (defvar erc-server-reconnecting nil
  165. "Non-nil if the user requests an explicit reconnect, and the
  166. current IRC process is still alive.")
  167. (make-variable-buffer-local 'erc-server-reconnecting)
  168. (defvar erc-server-timed-out nil
  169. "Non-nil if the IRC server failed to respond to a ping.")
  170. (make-variable-buffer-local 'erc-server-timed-out)
  171. (defvar erc-server-banned nil
  172. "Non-nil if the user is denied access because of a server ban.")
  173. (make-variable-buffer-local 'erc-server-banned)
  174. (defvar erc-server-error-occurred nil
  175. "Non-nil if the user triggers some server error.")
  176. (make-variable-buffer-local 'erc-server-error-occurred)
  177. (defvar erc-server-lines-sent nil
  178. "Line counter.")
  179. (make-variable-buffer-local 'erc-server-lines-sent)
  180. (defvar erc-server-last-peers '(nil . nil)
  181. "Last peers used, both sender and receiver.
  182. Those are used for /MSG destination shortcuts.")
  183. (make-variable-buffer-local 'erc-server-last-peers)
  184. (defvar erc-server-last-sent-time nil
  185. "Time the message was sent.
  186. This is useful for flood protection.")
  187. (make-variable-buffer-local 'erc-server-last-sent-time)
  188. (defvar erc-server-last-ping-time nil
  189. "Time the last ping was sent.
  190. This is useful for flood protection.")
  191. (make-variable-buffer-local 'erc-server-last-ping-time)
  192. (defvar erc-server-last-received-time nil
  193. "Time the last message was received from the server.
  194. This is useful for detecting hung connections.")
  195. (make-variable-buffer-local 'erc-server-last-received-time)
  196. (defvar erc-server-lag nil
  197. "Calculated server lag time in seconds.
  198. This variable is only set in a server buffer.")
  199. (make-variable-buffer-local 'erc-server-lag)
  200. (defvar erc-server-filter-data nil
  201. "The data that arrived from the server
  202. but has not been processed yet.")
  203. (make-variable-buffer-local 'erc-server-filter-data)
  204. (defvar erc-server-duplicates (make-hash-table :test 'equal)
  205. "Internal variable used to track duplicate messages.")
  206. (make-variable-buffer-local 'erc-server-duplicates)
  207. ;; From Circe
  208. (defvar erc-server-processing-p nil
  209. "Non-nil when we're currently processing a message.
  210. When ERC receives a private message, it sets up a new buffer for
  211. this query. These in turn, though, do start flyspell. This
  212. involves starting an external process, in which case Emacs will
  213. wait - and when it waits, it does accept other stuff from, say,
  214. network exceptions. So, if someone sends you two messages
  215. quickly after each other, ispell is started for the first, but
  216. might take long enough for the second message to be processed
  217. first.")
  218. (make-variable-buffer-local 'erc-server-processing-p)
  219. (defvar erc-server-flood-last-message 0
  220. "When we sent the last message.
  221. See `erc-server-flood-margin' for an explanation of the flood
  222. protection algorithm.")
  223. (make-variable-buffer-local 'erc-server-flood-last-message)
  224. (defvar erc-server-flood-queue nil
  225. "The queue of messages waiting to be sent to the server.
  226. See `erc-server-flood-margin' for an explanation of the flood
  227. protection algorithm.")
  228. (make-variable-buffer-local 'erc-server-flood-queue)
  229. (defvar erc-server-flood-timer nil
  230. "The timer to resume sending.")
  231. (make-variable-buffer-local 'erc-server-flood-timer)
  232. ;;; IRC protocol and misc options
  233. (defgroup erc-server nil
  234. "Parameters for dealing with IRC servers."
  235. :group 'erc)
  236. (defcustom erc-server-auto-reconnect t
  237. "Non-nil means that ERC will attempt to reestablish broken connections.
  238. Reconnection will happen automatically for any unexpected disconnection."
  239. :group 'erc-server
  240. :type 'boolean)
  241. (defcustom erc-server-reconnect-attempts 2
  242. "The number of times that ERC will attempt to reestablish a
  243. broken connection, or t to always attempt to reconnect.
  244. This only has an effect if `erc-server-auto-reconnect' is non-nil."
  245. :group 'erc-server
  246. :type '(choice (const :tag "Always reconnect" t)
  247. integer))
  248. (defcustom erc-server-reconnect-timeout 1
  249. "The amount of time, in seconds, that ERC will wait between
  250. successive reconnect attempts.
  251. If a key is pressed while ERC is waiting, it will stop waiting."
  252. :group 'erc-server
  253. :type 'number)
  254. (defcustom erc-split-line-length 440
  255. "The maximum length of a single message.
  256. If a message exceeds this size, it is broken into multiple ones.
  257. IRC allows for lines up to 512 bytes. Two of them are CR LF.
  258. And a typical message looks like this:
  259. :nicky!uhuser@host212223.dialin.fnordisp.net PRIVMSG #lazybastards :Hello!
  260. You can limit here the maximum length of the \"Hello!\" part.
  261. Good luck."
  262. :type 'integer
  263. :group 'erc-server)
  264. (defcustom erc-coding-system-precedence '(utf-8 undecided)
  265. "List of coding systems to be preferred when receiving a string from the server.
  266. This will only be consulted if the coding system in
  267. `erc-server-coding-system' is `undecided'."
  268. :group 'erc-server
  269. :version "24.1"
  270. :type '(repeat coding-system))
  271. (defcustom erc-server-coding-system (if (and (fboundp 'coding-system-p)
  272. (coding-system-p 'undecided)
  273. (coding-system-p 'utf-8))
  274. '(utf-8 . undecided)
  275. nil)
  276. "The default coding system for incoming and outgoing text.
  277. This is either a coding system, a cons, a function, or nil.
  278. If a cons, the encoding system for outgoing text is in the car
  279. and the decoding system for incoming text is in the cdr. The most
  280. interesting use for this is to put `undecided' in the cdr. This
  281. means that `erc-coding-system-precedence' will be consulted, and the
  282. first match there will be used.
  283. If a function, it is called with the argument `target' and should
  284. return a coding system or a cons as described above.
  285. If you need to send non-ASCII text to people not using a client that
  286. does decoding on its own, you must tell ERC what encoding to use.
  287. Emacs cannot guess it, since it does not know what the people on the
  288. other end of the line are using."
  289. :group 'erc-server
  290. :type '(choice (const :tag "None" nil)
  291. coding-system
  292. (cons (coding-system :tag "encoding" :value utf-8)
  293. (coding-system :tag "decoding" :value undecided))
  294. function))
  295. (defcustom erc-encoding-coding-alist nil
  296. "Alist of target regexp and coding-system pairs to use.
  297. This overrides `erc-server-coding-system' depending on the
  298. current target as returned by `erc-default-target'.
  299. Example: If you know that the channel #linux-ru uses the coding-system
  300. `cyrillic-koi8', then add '(\"#linux-ru\" . cyrillic-koi8) to the
  301. alist."
  302. :group 'erc-server
  303. :type '(repeat (cons (string :tag "Target")
  304. coding-system)))
  305. (defcustom erc-server-connect-function 'open-network-stream
  306. "Function used to initiate a connection.
  307. It should take same arguments as `open-network-stream' does."
  308. :group 'erc-server
  309. :type 'function)
  310. (defcustom erc-server-prevent-duplicates '("301")
  311. "Either nil or a list of strings.
  312. Each string is a IRC message type, like PRIVMSG or NOTICE.
  313. All Message types in that list of subjected to duplicate prevention."
  314. :type '(choice (const nil) (list string))
  315. :group 'erc-server)
  316. (defcustom erc-server-duplicate-timeout 60
  317. "The time allowed in seconds between duplicate messages.
  318. If two identical messages arrive within this value of one another, the second
  319. isn't displayed."
  320. :type 'integer
  321. :group 'erc-server)
  322. (defcustom erc-server-timestamp-format "%Y-%m-%d %T"
  323. "Timestamp format used with server response messages.
  324. This string is processed using `format-time-string'."
  325. :version "24.3"
  326. :type 'string
  327. :group 'erc-server)
  328. ;;; Flood-related
  329. ;; Most of this is courtesy of Jorgen Schaefer and Circe
  330. ;; (http://www.nongnu.org/circe)
  331. (defcustom erc-server-flood-margin 10
  332. "A margin on how much excess data we send.
  333. The flood protection algorithm of ERC works like the one
  334. detailed in RFC 2813, section 5.8 \"Flood control of clients\".
  335. * If `erc-server-flood-last-message' is less than the current
  336. time, set it equal.
  337. * While `erc-server-flood-last-message' is less than
  338. `erc-server-flood-margin' seconds ahead of the current
  339. time, send a message, and increase
  340. `erc-server-flood-last-message' by
  341. `erc-server-flood-penalty' for each message."
  342. :type 'integer
  343. :group 'erc-server)
  344. (defcustom erc-server-flood-penalty 3
  345. "How much we penalize a message.
  346. See `erc-server-flood-margin' for an explanation of the flood
  347. protection algorithm."
  348. :type 'integer
  349. :group 'erc-server)
  350. ;; Ping handling
  351. (defcustom erc-server-send-ping-interval 30
  352. "Interval of sending pings to the server, in seconds.
  353. If this is set to nil, pinging the server is disabled."
  354. :group 'erc-server
  355. :type '(choice (const :tag "Disabled" nil)
  356. (integer :tag "Seconds")))
  357. (defcustom erc-server-send-ping-timeout 120
  358. "If the time between ping and response is greater than this, reconnect.
  359. The time is in seconds.
  360. This must be greater than or equal to the value for
  361. `erc-server-send-ping-interval'.
  362. If this is set to nil, never try to reconnect."
  363. :group 'erc-server
  364. :type '(choice (const :tag "Disabled" nil)
  365. (integer :tag "Seconds")))
  366. (defvar erc-server-ping-handler nil
  367. "This variable holds the periodic ping timer.")
  368. (make-variable-buffer-local 'erc-server-ping-handler)
  369. ;;;; Helper functions
  370. ;; From Circe
  371. (defun erc-split-line (longline)
  372. "Return a list of lines which are not too long for IRC.
  373. The length is specified in `erc-split-line-length'.
  374. Currently this is called by `erc-send-input'."
  375. (if (< (length longline)
  376. erc-split-line-length)
  377. (list longline)
  378. (with-temp-buffer
  379. (insert longline)
  380. (let ((fill-column erc-split-line-length))
  381. (fill-region (point-min) (point-max)
  382. nil t))
  383. (split-string (buffer-string) "\n"))))
  384. ;; Used by CTCP functions
  385. (defun erc-upcase-first-word (str)
  386. "Upcase the first word in STR."
  387. (with-temp-buffer
  388. (insert str)
  389. (goto-char (point-min))
  390. (upcase-word 1)
  391. (buffer-string)))
  392. (defun erc-server-setup-periodical-ping (buffer)
  393. "Set up a timer to periodically ping the current server.
  394. The current buffer is given by BUFFER."
  395. (with-current-buffer buffer
  396. (and erc-server-ping-handler (erc-cancel-timer erc-server-ping-handler))
  397. (when erc-server-send-ping-interval
  398. (setq erc-server-ping-handler (run-with-timer
  399. 4 erc-server-send-ping-interval
  400. #'erc-server-send-ping
  401. buffer))
  402. (setq erc-server-ping-timer-alist (cons (cons buffer
  403. erc-server-ping-handler)
  404. erc-server-ping-timer-alist)))))
  405. (defun erc-server-process-alive (&optional buffer)
  406. "Return non-nil when BUFFER has an `erc-server-process' open or running."
  407. (with-current-buffer (or buffer (current-buffer))
  408. (and erc-server-process
  409. (processp erc-server-process)
  410. (memq (process-status erc-server-process) '(run open)))))
  411. ;;;; Connecting to a server
  412. (defun erc-server-connect (server port buffer)
  413. "Perform the connection and login using the specified SERVER and PORT.
  414. We will store server variables in the buffer given by BUFFER."
  415. (let ((msg (erc-format-message 'connect ?S server ?p port)))
  416. (message "%s" msg)
  417. (let ((process (funcall erc-server-connect-function
  418. (format "erc-%s-%s" server port)
  419. nil server port)))
  420. (unless (processp process)
  421. (error "Connection attempt failed"))
  422. (message "%s...done" msg)
  423. ;; Misc server variables
  424. (with-current-buffer buffer
  425. (setq erc-server-process process)
  426. (setq erc-server-quitting nil)
  427. (setq erc-server-reconnecting nil)
  428. (setq erc-server-timed-out nil)
  429. (setq erc-server-banned nil)
  430. (setq erc-server-error-occurred nil)
  431. (let ((time (erc-current-time)))
  432. (setq erc-server-last-sent-time time)
  433. (setq erc-server-last-ping-time time)
  434. (setq erc-server-last-received-time time))
  435. (setq erc-server-lines-sent 0)
  436. ;; last peers (sender and receiver)
  437. (setq erc-server-last-peers '(nil . nil)))
  438. ;; we do our own encoding and decoding
  439. (when (fboundp 'set-process-coding-system)
  440. (set-process-coding-system process 'raw-text))
  441. ;; process handlers
  442. (set-process-sentinel process 'erc-process-sentinel)
  443. (set-process-filter process 'erc-server-filter-function)
  444. (set-process-buffer process buffer)))
  445. (erc-log "\n\n\n********************************************\n")
  446. (message "%s" (erc-format-message
  447. 'login ?n
  448. (with-current-buffer buffer (erc-current-nick))))
  449. ;; wait with script loading until we receive a confirmation (first
  450. ;; MOTD line)
  451. (if (eq erc-server-connect-function 'open-network-stream-nowait)
  452. ;; it's a bit unclear otherwise that it's attempting to establish a
  453. ;; connection
  454. (erc-display-message nil nil buffer "Opening connection..\n")
  455. (erc-login)))
  456. (defun erc-server-reconnect ()
  457. "Reestablish the current IRC connection.
  458. Make sure you are in an ERC buffer when running this."
  459. (let ((buffer (erc-server-buffer)))
  460. (unless (buffer-live-p buffer)
  461. (if (eq major-mode 'erc-mode)
  462. (setq buffer (current-buffer))
  463. (error "Reconnect must be run from an ERC buffer")))
  464. (with-current-buffer buffer
  465. (erc-update-mode-line)
  466. (erc-set-active-buffer (current-buffer))
  467. (setq erc-server-last-sent-time 0)
  468. (setq erc-server-lines-sent 0)
  469. (let ((erc-server-connect-function (or erc-session-connector
  470. 'open-network-stream)))
  471. (erc-open erc-session-server erc-session-port erc-server-current-nick
  472. erc-session-user-full-name t erc-session-password)))))
  473. (defun erc-server-filter-function (process string)
  474. "The process filter for the ERC server."
  475. (with-current-buffer (process-buffer process)
  476. (setq erc-server-last-received-time (erc-current-time))
  477. ;; If you think this is written in a weird way - please refer to the
  478. ;; docstring of `erc-server-processing-p'
  479. (if erc-server-processing-p
  480. (setq erc-server-filter-data
  481. (if erc-server-filter-data
  482. (concat erc-server-filter-data string)
  483. string))
  484. ;; This will be true even if another process is spawned!
  485. (let ((erc-server-processing-p t))
  486. (setq erc-server-filter-data (if erc-server-filter-data
  487. (concat erc-server-filter-data
  488. string)
  489. string))
  490. (while (and erc-server-filter-data
  491. (string-match "[\n\r]+" erc-server-filter-data))
  492. (let ((line (substring erc-server-filter-data
  493. 0 (match-beginning 0))))
  494. (setq erc-server-filter-data
  495. (if (= (match-end 0)
  496. (length erc-server-filter-data))
  497. nil
  498. (substring erc-server-filter-data
  499. (match-end 0))))
  500. (erc-log-irc-protocol line nil)
  501. (erc-parse-server-response process line)))))))
  502. (defsubst erc-server-reconnect-p (event)
  503. "Return non-nil if ERC should attempt to reconnect automatically.
  504. EVENT is the message received from the closed connection process."
  505. (or erc-server-reconnecting
  506. (and erc-server-auto-reconnect
  507. (not erc-server-banned)
  508. (not erc-server-error-occurred)
  509. ;; make sure we don't infinitely try to reconnect, unless the
  510. ;; user wants that
  511. (or (eq erc-server-reconnect-attempts t)
  512. (and (integerp erc-server-reconnect-attempts)
  513. (< erc-server-reconnect-count
  514. erc-server-reconnect-attempts)))
  515. (or erc-server-timed-out
  516. (not (string-match "^deleted" event)))
  517. ;; open-network-stream-nowait error for connection refused
  518. (not (string-match "^failed with code 111" event)))))
  519. (defun erc-process-sentinel-2 (event buffer)
  520. "Called when `erc-process-sentinel-1' has detected an unexpected disconnect."
  521. (if (not (buffer-live-p buffer))
  522. (erc-update-mode-line)
  523. (with-current-buffer buffer
  524. (let ((reconnect-p (erc-server-reconnect-p event)))
  525. (erc-display-message nil 'error (current-buffer)
  526. (if reconnect-p 'disconnected
  527. 'disconnected-noreconnect))
  528. (if (not reconnect-p)
  529. ;; terminate, do not reconnect
  530. (progn
  531. (erc-display-message nil 'error (current-buffer)
  532. 'terminated ?e event)
  533. ;; Update mode line indicators
  534. (erc-update-mode-line)
  535. (set-buffer-modified-p nil))
  536. ;; reconnect
  537. (condition-case err
  538. (progn
  539. (setq erc-server-reconnecting nil)
  540. (erc-server-reconnect)
  541. (setq erc-server-reconnect-count 0))
  542. (error (when (buffer-live-p buffer)
  543. (set-buffer buffer)
  544. (if (integerp erc-server-reconnect-attempts)
  545. (setq erc-server-reconnect-count
  546. (1+ erc-server-reconnect-count))
  547. (message "%s ... %s"
  548. "Reconnecting until we succeed"
  549. "kill the ERC server buffer to stop"))
  550. (if (numberp erc-server-reconnect-timeout)
  551. (run-at-time erc-server-reconnect-timeout nil
  552. #'erc-process-sentinel-2
  553. event buffer)
  554. (error (concat "`erc-server-reconnect-timeout'"
  555. " must be a number")))))))))))
  556. (defun erc-process-sentinel-1 (event buffer)
  557. "Called when `erc-process-sentinel' has decided that we're disconnecting.
  558. Determine whether user has quit or whether erc has been terminated.
  559. Conditionally try to reconnect and take appropriate action."
  560. (with-current-buffer buffer
  561. (if erc-server-quitting
  562. ;; normal quit
  563. (progn
  564. (erc-display-message nil 'error (current-buffer) 'finished)
  565. ;; Update mode line indicators
  566. (erc-update-mode-line)
  567. ;; Kill server buffer if user wants it
  568. (set-buffer-modified-p nil)
  569. (when erc-kill-server-buffer-on-quit
  570. (kill-buffer (current-buffer))))
  571. ;; unexpected disconnect
  572. (erc-process-sentinel-2 event buffer))))
  573. (defun erc-process-sentinel (cproc event)
  574. "Sentinel function for ERC process."
  575. (let ((buf (process-buffer cproc)))
  576. (when (buffer-live-p buf)
  577. (with-current-buffer buf
  578. (erc-log (format
  579. "SENTINEL: proc: %S status: %S event: %S (quitting: %S)"
  580. cproc (process-status cproc) event erc-server-quitting))
  581. (if (string-match "^open" event)
  582. ;; newly opened connection (no wait)
  583. (erc-login)
  584. ;; assume event is 'failed
  585. (erc-with-all-buffers-of-server cproc nil
  586. (setq erc-server-connected nil))
  587. (when erc-server-ping-handler
  588. (progn (erc-cancel-timer erc-server-ping-handler)
  589. (setq erc-server-ping-handler nil)))
  590. (run-hook-with-args 'erc-disconnected-hook
  591. (erc-current-nick) (system-name) "")
  592. ;; Remove the prompt
  593. (goto-char (or (marker-position erc-input-marker) (point-max)))
  594. (forward-line 0)
  595. (erc-remove-text-properties-region (point) (point-max))
  596. (delete-region (point) (point-max))
  597. ;; Decide what to do with the buffer
  598. ;; Restart if disconnected
  599. (erc-process-sentinel-1 event buf))))))
  600. ;;;; Sending messages
  601. (defun erc-coding-system-for-target (target)
  602. "Return the coding system or cons cell appropriate for TARGET.
  603. This is determined via `erc-encoding-coding-alist' or
  604. `erc-server-coding-system'."
  605. (unless target (setq target (erc-default-target)))
  606. (or (when target
  607. (let ((case-fold-search t))
  608. (catch 'match
  609. (dolist (pat erc-encoding-coding-alist)
  610. (when (string-match (car pat) target)
  611. (throw 'match (cdr pat)))))))
  612. (and (functionp erc-server-coding-system)
  613. (funcall erc-server-coding-system target))
  614. erc-server-coding-system))
  615. (defun erc-decode-string-from-target (str target)
  616. "Decode STR as appropriate for TARGET.
  617. This is indicated by `erc-encoding-coding-alist', defaulting to the value of
  618. `erc-server-coding-system'."
  619. (unless (stringp str)
  620. (setq str ""))
  621. (let ((coding (erc-coding-system-for-target target)))
  622. (when (consp coding)
  623. (setq coding (cdr coding)))
  624. (when (eq coding 'undecided)
  625. (let ((codings (detect-coding-string str))
  626. (precedence erc-coding-system-precedence))
  627. (while (and precedence
  628. (not (memq (car precedence) codings)))
  629. (pop precedence))
  630. (when precedence
  631. (setq coding (car precedence)))))
  632. (erc-decode-coding-string str coding)))
  633. ;; proposed name, not used by anything yet
  634. (defun erc-send-line (text display-fn)
  635. "Send TEXT to the current server. Wrapping and flood control apply.
  636. Use DISPLAY-FN to show the results."
  637. (mapc (lambda (line)
  638. (erc-server-send line)
  639. (funcall display-fn))
  640. (erc-split-line text)))
  641. ;; From Circe, with modifications
  642. (defun erc-server-send (string &optional forcep target)
  643. "Send STRING to the current server.
  644. If FORCEP is non-nil, no flood protection is done - the string is
  645. sent directly. This might cause the messages to arrive in a wrong
  646. order.
  647. If TARGET is specified, look up encoding information for that
  648. channel in `erc-encoding-coding-alist' or
  649. `erc-server-coding-system'.
  650. See `erc-server-flood-margin' for an explanation of the flood
  651. protection algorithm."
  652. (erc-log (concat "erc-server-send: " string "(" (buffer-name) ")"))
  653. (setq erc-server-last-sent-time (erc-current-time))
  654. (let ((encoding (erc-coding-system-for-target target)))
  655. (when (consp encoding)
  656. (setq encoding (car encoding)))
  657. (if (erc-server-process-alive)
  658. (erc-with-server-buffer
  659. (let ((str (concat string "\r\n")))
  660. (if forcep
  661. (progn
  662. (setq erc-server-flood-last-message
  663. (+ erc-server-flood-penalty
  664. erc-server-flood-last-message))
  665. (erc-log-irc-protocol str 'outbound)
  666. (condition-case err
  667. (progn
  668. ;; Set encoding just before sending the string
  669. (when (fboundp 'set-process-coding-system)
  670. (set-process-coding-system erc-server-process
  671. 'raw-text encoding))
  672. (process-send-string erc-server-process str))
  673. ;; See `erc-server-send-queue' for full
  674. ;; explanation of why we need this condition-case
  675. (error nil)))
  676. (setq erc-server-flood-queue
  677. (append erc-server-flood-queue
  678. (list (cons str encoding))))
  679. (erc-server-send-queue (current-buffer))))
  680. t)
  681. (message "ERC: No process running")
  682. nil)))
  683. (defun erc-server-send-ping (buf)
  684. "Send a ping to the IRC server buffer in BUF.
  685. Additionally, detect whether the IRC process has hung."
  686. (if (buffer-live-p buf)
  687. (with-current-buffer buf
  688. (if (and erc-server-send-ping-timeout
  689. (>
  690. (erc-time-diff (erc-current-time)
  691. erc-server-last-received-time)
  692. erc-server-send-ping-timeout))
  693. (progn
  694. ;; if the process is hung, kill it
  695. (setq erc-server-timed-out t)
  696. (delete-process erc-server-process))
  697. (erc-server-send (format "PING %.0f" (erc-current-time)))))
  698. ;; remove timer if the server buffer has been killed
  699. (let ((timer (assq buf erc-server-ping-timer-alist)))
  700. (when timer
  701. (erc-cancel-timer (cdr timer))
  702. (setcdr timer nil)))))
  703. ;; From Circe
  704. (defun erc-server-send-queue (buffer)
  705. "Send messages in `erc-server-flood-queue'.
  706. See `erc-server-flood-margin' for an explanation of the flood
  707. protection algorithm."
  708. (with-current-buffer buffer
  709. (let ((now (erc-current-time)))
  710. (when erc-server-flood-timer
  711. (erc-cancel-timer erc-server-flood-timer)
  712. (setq erc-server-flood-timer nil))
  713. (when (< erc-server-flood-last-message
  714. now)
  715. (setq erc-server-flood-last-message now))
  716. (while (and erc-server-flood-queue
  717. (< erc-server-flood-last-message
  718. (+ now erc-server-flood-margin)))
  719. (let ((msg (caar erc-server-flood-queue))
  720. (encoding (cdar erc-server-flood-queue)))
  721. (setq erc-server-flood-queue (cdr erc-server-flood-queue)
  722. erc-server-flood-last-message
  723. (+ erc-server-flood-last-message
  724. erc-server-flood-penalty))
  725. (erc-log-irc-protocol msg 'outbound)
  726. (erc-log (concat "erc-server-send-queue: "
  727. msg "(" (buffer-name buffer) ")"))
  728. (when (erc-server-process-alive)
  729. (condition-case err
  730. ;; Set encoding just before sending the string
  731. (progn
  732. (when (fboundp 'set-process-coding-system)
  733. (set-process-coding-system erc-server-process
  734. 'raw-text encoding))
  735. (process-send-string erc-server-process msg))
  736. ;; Sometimes the send can occur while the process is
  737. ;; being killed, which results in a weird SIGPIPE error.
  738. ;; Catch this and ignore it.
  739. (error nil)))))
  740. (when erc-server-flood-queue
  741. (setq erc-server-flood-timer
  742. (run-at-time (+ 0.2 erc-server-flood-penalty)
  743. nil #'erc-server-send-queue buffer))))))
  744. (defun erc-message (message-command line &optional force)
  745. "Send LINE to the server as a privmsg or a notice.
  746. MESSAGE-COMMAND should be either \"PRIVMSG\" or \"NOTICE\".
  747. If the target is \",\", the last person you've got a message from will
  748. be used. If the target is \".\", the last person you've sent a message
  749. to will be used."
  750. (cond
  751. ((string-match "^\\s-*\\(\\S-+\\) ?\\(.*\\)" line)
  752. (let ((tgt (match-string 1 line))
  753. (s (match-string 2 line)))
  754. (erc-log (format "cmd: MSG(%s): [%s] %s" message-command tgt s))
  755. (cond
  756. ((string= tgt ",")
  757. (if (car erc-server-last-peers)
  758. (setq tgt (car erc-server-last-peers))
  759. (setq tgt nil)))
  760. ((string= tgt ".")
  761. (if (cdr erc-server-last-peers)
  762. (setq tgt (cdr erc-server-last-peers))
  763. (setq tgt nil))))
  764. (cond
  765. (tgt
  766. (setcdr erc-server-last-peers tgt)
  767. (erc-server-send (format "%s %s :%s" message-command tgt s)
  768. force))
  769. (t
  770. (erc-display-message nil 'error (current-buffer) 'no-target))))
  771. t)
  772. (t nil)))
  773. ;;; CTCP
  774. (defun erc-send-ctcp-message (tgt l &optional force)
  775. "Send CTCP message L to TGT.
  776. If TGT is nil the message is not sent.
  777. The command must contain neither a prefix nor a trailing `\\n'.
  778. See also `erc-server-send'."
  779. (let ((l (erc-upcase-first-word l)))
  780. (cond
  781. (tgt
  782. (erc-log (format "erc-send-CTCP-message: [%s] %s" tgt l))
  783. (erc-server-send (format "PRIVMSG %s :\C-a%s\C-a" tgt l)
  784. force)))))
  785. (defun erc-send-ctcp-notice (tgt l &optional force)
  786. "Send CTCP notice L to TGT.
  787. If TGT is nil the message is not sent.
  788. The command must contain neither a prefix nor a trailing `\\n'.
  789. See also `erc-server-send'."
  790. (let ((l (erc-upcase-first-word l)))
  791. (cond
  792. (tgt
  793. (erc-log (format "erc-send-CTCP-notice: [%s] %s" tgt l))
  794. (erc-server-send (format "NOTICE %s :\C-a%s\C-a" tgt l)
  795. force)))))
  796. ;;;; Handling responses
  797. (defun erc-parse-server-response (proc string)
  798. "Parse and act upon a complete line from an IRC server.
  799. PROC is the process (connection) from which STRING was received.
  800. PROCs `process-buffer' is `current-buffer' when this function is called."
  801. (unless (string= string "") ;; Ignore empty strings
  802. (save-match-data
  803. (let ((posn (if (eq (aref string 0) ?:)
  804. (string-match " " string)
  805. 0))
  806. (msg (make-erc-response :unparsed string)))
  807. (setf (erc-response.sender msg)
  808. (if (eq posn 0)
  809. erc-session-server
  810. (substring string 1 posn)))
  811. (setf (erc-response.command msg)
  812. (let* ((bposn (string-match "[^ \n]" string posn))
  813. (eposn (string-match " " string bposn)))
  814. (setq posn (and eposn
  815. (string-match "[^ \n]" string eposn)))
  816. (substring string bposn eposn)))
  817. (while (and posn
  818. (not (eq (aref string posn) ?:)))
  819. (push (let* ((bposn posn)
  820. (eposn (string-match " " string bposn)))
  821. (setq posn (and eposn
  822. (string-match "[^ \n]" string eposn)))
  823. (substring string bposn eposn))
  824. (erc-response.command-args msg)))
  825. (when posn
  826. (let ((str (substring string (1+ posn))))
  827. (push str (erc-response.command-args msg))))
  828. (setf (erc-response.contents msg)
  829. (car (erc-response.command-args msg)))
  830. (setf (erc-response.command-args msg)
  831. (nreverse (erc-response.command-args msg)))
  832. (erc-decode-parsed-server-response msg)
  833. (erc-handle-parsed-server-response proc msg)))))
  834. (defun erc-decode-parsed-server-response (parsed-response)
  835. "Decode a pre-parsed PARSED-RESPONSE before it can be handled.
  836. If there is a channel name in `erc-response.command-args', decode
  837. `erc-response' according to this channel name and
  838. `erc-encoding-coding-alist', or use `erc-server-coding-system'
  839. for decoding."
  840. (let ((args (erc-response.command-args parsed-response))
  841. (decode-target nil)
  842. (decoded-args ()))
  843. (dolist (arg args nil)
  844. (when (string-match "^[#&].*" arg)
  845. (setq decode-target arg)))
  846. (when (stringp decode-target)
  847. (setq decode-target (erc-decode-string-from-target decode-target nil)))
  848. (setf (erc-response.unparsed parsed-response)
  849. (erc-decode-string-from-target
  850. (erc-response.unparsed parsed-response)
  851. decode-target))
  852. (setf (erc-response.sender parsed-response)
  853. (erc-decode-string-from-target
  854. (erc-response.sender parsed-response)
  855. decode-target))
  856. (setf (erc-response.command parsed-response)
  857. (erc-decode-string-from-target
  858. (erc-response.command parsed-response)
  859. decode-target))
  860. (dolist (arg (nreverse args) nil)
  861. (push (erc-decode-string-from-target arg decode-target)
  862. decoded-args))
  863. (setf (erc-response.command-args parsed-response) decoded-args)
  864. (setf (erc-response.contents parsed-response)
  865. (erc-decode-string-from-target
  866. (erc-response.contents parsed-response)
  867. decode-target))))
  868. (defun erc-handle-parsed-server-response (process parsed-response)
  869. "Handle a pre-parsed PARSED-RESPONSE from PROCESS.
  870. Hands off to helper functions via `erc-call-hooks'."
  871. (if (member (erc-response.command parsed-response)
  872. erc-server-prevent-duplicates)
  873. (let ((m (erc-response.unparsed parsed-response)))
  874. ;; duplicate suppression
  875. (if (< (or (gethash m erc-server-duplicates) 0)
  876. (- (erc-current-time) erc-server-duplicate-timeout))
  877. (erc-call-hooks process parsed-response))
  878. (puthash m (erc-current-time) erc-server-duplicates))
  879. ;; Hand off to the relevant handler.
  880. (erc-call-hooks process parsed-response)))
  881. (defun erc-get-hook (command)
  882. "Return the hook variable associated with COMMAND.
  883. See also `erc-server-responses'."
  884. (gethash (format (if (numberp command) "%03i" "%s") command)
  885. erc-server-responses))
  886. (defun erc-call-hooks (process message)
  887. "Call hooks associated with MESSAGE in PROCESS.
  888. Finds hooks by looking in the `erc-server-responses' hashtable."
  889. (let ((hook (or (erc-get-hook (erc-response.command message))
  890. 'erc-default-server-functions)))
  891. (run-hook-with-args-until-success hook process message)
  892. (erc-with-server-buffer
  893. (run-hook-with-args 'erc-timer-hook (erc-current-time)))))
  894. (add-hook 'erc-default-server-functions 'erc-handle-unknown-server-response)
  895. (defun erc-handle-unknown-server-response (proc parsed)
  896. "Display unknown server response's message."
  897. (let ((line (concat (erc-response.sender parsed)
  898. " "
  899. (erc-response.command parsed)
  900. " "
  901. (mapconcat 'identity (erc-response.command-args parsed)
  902. " "))))
  903. (erc-display-message parsed 'notice proc line)))
  904. (put 'define-erc-response-handler 'edebug-form-spec
  905. '(&define :name erc-response-handler
  906. (name &rest name)
  907. &optional sexp sexp def-body))
  908. (cl-defmacro define-erc-response-handler ((name &rest aliases)
  909. &optional extra-fn-doc extra-var-doc
  910. &rest fn-body)
  911. "Define an ERC handler hook/function pair.
  912. NAME is the response name as sent by the server (see the IRC RFC for
  913. meanings).
  914. This creates:
  915. - a hook variable `erc-server-NAME-functions' initialized to `erc-server-NAME'.
  916. - a function `erc-server-NAME' with body FN-BODY.
  917. If ALIASES is non-nil, each alias in ALIASES is `defalias'ed to
  918. `erc-server-NAME'.
  919. Alias hook variables are created as `erc-server-ALIAS-functions' and
  920. initialized to the same default value as `erc-server-NAME-functions'.
  921. FN-BODY is the body of `erc-server-NAME' it may refer to the two
  922. function arguments PROC and PARSED.
  923. If EXTRA-FN-DOC is non-nil, it is inserted at the beginning of the
  924. defined function's docstring.
  925. If EXTRA-VAR-DOC is non-nil, it is inserted at the beginning of the
  926. defined variable's docstring.
  927. As an example:
  928. (define-erc-response-handler (311 WHOIS WI)
  929. \"Some non-generic function documentation.\"
  930. \"Some non-generic variable documentation.\"
  931. (do-stuff-with-whois proc parsed))
  932. Would expand to:
  933. (prog2
  934. (defvar erc-server-311-functions 'erc-server-311
  935. \"Some non-generic variable documentation.
  936. Hook called upon receiving a 311 server response.
  937. Each function is called with two arguments, the process associated
  938. with the response and the parsed response.
  939. See also `erc-server-311'.\")
  940. (defun erc-server-311 (proc parsed)
  941. \"Some non-generic function documentation.
  942. Handler for a 311 server response.
  943. PROC is the server process which returned the response.
  944. PARSED is the actual response as an `erc-response' struct.
  945. If you want to add responses don't modify this function, but rather
  946. add things to `erc-server-311-functions' instead.\"
  947. (do-stuff-with-whois proc parsed))
  948. (puthash \"311\" 'erc-server-311-functions erc-server-responses)
  949. (puthash \"WHOIS\" 'erc-server-WHOIS-functions erc-server-responses)
  950. (puthash \"WI\" 'erc-server-WI-functions erc-server-responses)
  951. (defalias 'erc-server-WHOIS 'erc-server-311)
  952. (defvar erc-server-WHOIS-functions 'erc-server-311
  953. \"Some non-generic variable documentation.
  954. Hook called upon receiving a WHOIS server response.
  955. Each function is called with two arguments, the process associated
  956. with the response and the parsed response. If the function returns
  957. non-nil, stop processing the hook. Otherwise, continue.
  958. See also `erc-server-311'.\")
  959. (defalias 'erc-server-WI 'erc-server-311)
  960. (defvar erc-server-WI-functions 'erc-server-311
  961. \"Some non-generic variable documentation.
  962. Hook called upon receiving a WI server response.
  963. Each function is called with two arguments, the process associated
  964. with the response and the parsed response. If the function returns
  965. non-nil, stop processing the hook. Otherwise, continue.
  966. See also `erc-server-311'.\"))
  967. \(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)"
  968. (if (numberp name) (setq name (intern (format "%03i" name))))
  969. (setq aliases (mapcar (lambda (a)
  970. (if (numberp a)
  971. (format "%03i" a)
  972. a))
  973. aliases))
  974. (let* ((hook-name (intern (format "erc-server-%s-functions" name)))
  975. (fn-name (intern (format "erc-server-%s" name)))
  976. (hook-doc (format "%sHook called upon receiving a %%s server response.
  977. Each function is called with two arguments, the process associated
  978. with the response and the parsed response. If the function returns
  979. non-nil, stop processing the hook. Otherwise, continue.
  980. See also `%s'."
  981. (if extra-var-doc
  982. (concat extra-var-doc "\n\n")
  983. "")
  984. fn-name))
  985. (fn-doc (format "%sHandler for a %s server response.
  986. PROC is the server process which returned the response.
  987. PARSED is the actual response as an `erc-response' struct.
  988. If you want to add responses don't modify this function, but rather
  989. add things to `%s' instead."
  990. (if extra-fn-doc
  991. (concat extra-fn-doc "\n\n")
  992. "")
  993. name hook-name))
  994. (fn-alternates
  995. (cl-loop for alias in aliases
  996. collect (intern (format "erc-server-%s" alias))))
  997. (var-alternates
  998. (cl-loop for alias in aliases
  999. collect (intern (format "erc-server-%s-functions" alias)))))
  1000. `(prog2
  1001. ;; Normal hook variable. The variable may already have a
  1002. ;; value at this point, so I default to nil, and (add-hook)
  1003. ;; unconditionally
  1004. (defvar ,hook-name nil ,(format hook-doc name))
  1005. (add-to-list ',hook-name ',fn-name)
  1006. ;; Handler function
  1007. (defun ,fn-name (proc parsed)
  1008. ,fn-doc
  1009. ,@fn-body)
  1010. ;; Make find-function and find-variable find them
  1011. (put ',fn-name 'definition-name ',name)
  1012. (put ',hook-name 'definition-name ',name)
  1013. ;; Hashtable map of responses to hook variables
  1014. ,@(cl-loop for response in (cons name aliases)
  1015. for var in (cons hook-name var-alternates)
  1016. collect `(puthash ,(format "%s" response) ',var
  1017. erc-server-responses))
  1018. ;; Alternates.
  1019. ;; Functions are defaliased, hook variables are defvared so we
  1020. ;; can add hooks to one alias, but not another.
  1021. ,@(cl-loop for fn in fn-alternates
  1022. for var in var-alternates
  1023. for a in aliases
  1024. nconc (list `(defalias ',fn ',fn-name)
  1025. `(defvar ,var ',fn-name ,(format hook-doc a))
  1026. `(put ',var 'definition-name ',hook-name))))))
  1027. (define-erc-response-handler (ERROR)
  1028. "Handle an ERROR command from the server." nil
  1029. (setq erc-server-error-occurred t)
  1030. (erc-display-message
  1031. parsed 'error nil 'ERROR
  1032. ?s (erc-response.sender parsed) ?c (erc-response.contents parsed)))
  1033. (define-erc-response-handler (INVITE)
  1034. "Handle invitation messages."
  1035. nil
  1036. (let ((target (car (erc-response.command-args parsed)))
  1037. (chnl (erc-response.contents parsed)))
  1038. (pcase-let ((`(,nick ,login ,host)
  1039. (erc-parse-user (erc-response.sender parsed))))
  1040. (setq erc-invitation chnl)
  1041. (when (string= target (erc-current-nick))
  1042. (erc-display-message
  1043. parsed 'notice 'active
  1044. 'INVITE ?n nick ?u login ?h host ?c chnl)))))
  1045. (define-erc-response-handler (JOIN)
  1046. "Handle join messages."
  1047. nil
  1048. (let ((chnl (erc-response.contents parsed))
  1049. (buffer nil))
  1050. (pcase-let ((`(,nick ,login ,host)
  1051. (erc-parse-user (erc-response.sender parsed))))
  1052. ;; strip the stupid combined JOIN facility (IRC 2.9)
  1053. (if (string-match "^\\(.*\\)?\^g.*$" chnl)
  1054. (setq chnl (match-string 1 chnl)))
  1055. (save-excursion
  1056. (let* ((str (cond
  1057. ;; If I have joined a channel
  1058. ((erc-current-nick-p nick)
  1059. (setq buffer (erc-open erc-session-server erc-session-port
  1060. nick erc-session-user-full-name
  1061. nil nil
  1062. (list chnl) chnl
  1063. erc-server-process))
  1064. (when buffer
  1065. (set-buffer buffer)
  1066. (erc-add-default-channel chnl)
  1067. (erc-server-send (format "MODE %s" chnl)))
  1068. (erc-with-buffer (chnl proc)
  1069. (erc-channel-begin-receiving-names))
  1070. (erc-update-mode-line)
  1071. (run-hooks 'erc-join-hook)
  1072. (erc-make-notice
  1073. (erc-format-message 'JOIN-you ?c chnl)))
  1074. (t
  1075. (setq buffer (erc-get-buffer chnl proc))
  1076. (erc-make-notice
  1077. (erc-format-message
  1078. 'JOIN ?n nick ?u login ?h host ?c chnl))))))
  1079. (when buffer (set-buffer buffer))
  1080. (erc-update-channel-member chnl nick nick t nil nil nil nil nil host login)
  1081. ;; on join, we want to stay in the new channel buffer
  1082. ;;(set-buffer ob)
  1083. (erc-display-message parsed nil buffer str))))))
  1084. (define-erc-response-handler (KICK)
  1085. "Handle kick messages received from the server." nil
  1086. (let* ((ch (nth 0 (erc-response.command-args parsed)))
  1087. (tgt (nth 1 (erc-response.command-args parsed)))
  1088. (reason (erc-trim-string (erc-response.contents parsed)))
  1089. (buffer (erc-get-buffer ch proc)))
  1090. (pcase-let ((`(,nick ,login ,host)
  1091. (erc-parse-user (erc-response.sender parsed))))
  1092. (erc-remove-channel-member buffer tgt)
  1093. (cond
  1094. ((string= tgt (erc-current-nick))
  1095. (erc-display-message
  1096. parsed 'notice buffer
  1097. 'KICK-you ?n nick ?u login ?h host ?c ch ?r reason)
  1098. (run-hook-with-args 'erc-kick-hook buffer)
  1099. (erc-with-buffer
  1100. (buffer)
  1101. (erc-remove-channel-users))
  1102. (erc-delete-default-channel ch buffer)
  1103. (erc-update-mode-line buffer))
  1104. ((string= nick (erc-current-nick))
  1105. (erc-display-message
  1106. parsed 'notice buffer
  1107. 'KICK-by-you ?k tgt ?c ch ?r reason))
  1108. (t (erc-display-message
  1109. parsed 'notice buffer
  1110. 'KICK ?k tgt ?n nick ?u login ?h host ?c ch ?r reason))))))
  1111. (define-erc-response-handler (MODE)
  1112. "Handle server mode changes." nil
  1113. (let ((tgt (car (erc-response.command-args parsed)))
  1114. (mode (mapconcat 'identity (cdr (erc-response.command-args parsed))
  1115. " ")))
  1116. (pcase-let ((`(,nick ,login ,host)
  1117. (erc-parse-user (erc-response.sender parsed))))
  1118. (erc-log (format "MODE: %s -> %s: %s" nick tgt mode))
  1119. ;; dirty hack
  1120. (let ((buf (cond ((erc-channel-p tgt)
  1121. (erc-get-buffer tgt proc))
  1122. ((string= tgt (erc-current-nick)) nil)
  1123. ((erc-active-buffer) (erc-active-buffer))
  1124. (t (erc-get-buffer tgt)))))
  1125. (with-current-buffer (or buf
  1126. (current-buffer))
  1127. (erc-update-modes tgt mode nick host login))
  1128. (if (or (string= login "") (string= host ""))
  1129. (erc-display-message parsed 'notice buf
  1130. 'MODE-nick ?n nick
  1131. ?t tgt ?m mode)
  1132. (erc-display-message parsed 'notice buf
  1133. 'MODE ?n nick ?u login
  1134. ?h host ?t tgt ?m mode)))
  1135. (erc-banlist-update proc parsed))))
  1136. (define-erc-response-handler (NICK)
  1137. "Handle nick change messages." nil
  1138. (let ((nn (erc-response.contents parsed))
  1139. bufs)
  1140. (pcase-let ((`(,nick ,login ,host)
  1141. (erc-parse-user (erc-response.sender parsed))))
  1142. (setq bufs (erc-buffer-list-with-nick nick proc))
  1143. (erc-log (format "NICK: %s -> %s" nick nn))
  1144. ;; if we had a query with this user, make sure future messages will be
  1145. ;; sent to the correct nick. also add to bufs, since the user will want
  1146. ;; to see the nick change in the query, and if it's a newly begun query,
  1147. ;; erc-channel-users won't contain it
  1148. (erc-buffer-filter
  1149. (lambda ()
  1150. (when (equal (erc-default-target) nick)
  1151. (setq erc-default-recipients
  1152. (cons nn (cdr erc-default-recipients)))
  1153. (rename-buffer nn t) ; bug#12002
  1154. (erc-update-mode-line)
  1155. (add-to-list 'bufs (current-buffer)))))
  1156. (erc-update-user-nick nick nn host nil nil login)
  1157. (cond
  1158. ((string= nick (erc-current-nick))
  1159. (add-to-list 'bufs (erc-server-buffer))
  1160. (erc-set-current-nick nn)
  1161. (erc-update-mode-line)
  1162. (setq erc-nick-change-attempt-count 0)
  1163. (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
  1164. (erc-display-message
  1165. parsed 'notice bufs
  1166. 'NICK-you ?n nick ?N nn)
  1167. (run-hook-with-args 'erc-nick-changed-functions nn nick))
  1168. (t
  1169. (erc-handle-user-status-change 'nick (list nick login host) (list nn))
  1170. (erc-display-message parsed 'notice bufs 'NICK ?n nick
  1171. ?u login ?h host ?N nn))))))
  1172. (define-erc-response-handler (PART)
  1173. "Handle part messages." nil
  1174. (let* ((chnl (car (erc-response.command-args parsed)))
  1175. (reason (erc-trim-string (erc-response.contents parsed)))
  1176. (buffer (erc-get-buffer chnl proc)))
  1177. (pcase-let ((`(,nick ,login ,host)
  1178. (erc-parse-user (erc-response.sender parsed))))
  1179. (erc-remove-channel-member buffer nick)
  1180. (erc-display-message parsed 'notice buffer
  1181. 'PART ?n nick ?u login
  1182. ?h host ?c chnl ?r (or reason ""))
  1183. (when (string= nick (erc-current-nick))
  1184. (run-hook-with-args 'erc-part-hook buffer)
  1185. (erc-with-buffer
  1186. (buffer)
  1187. (erc-remove-channel-users))
  1188. (erc-delete-default-channel chnl buffer)
  1189. (erc-update-mode-line buffer)
  1190. (when erc-kill-buffer-on-part
  1191. (kill-buffer buffer))))))
  1192. (define-erc-response-handler (PING)
  1193. "Handle ping messages." nil
  1194. (let ((pinger (car (erc-response.command-args parsed))))
  1195. (erc-log (format "PING: %s" pinger))
  1196. ;; ping response to the server MUST be forced, or you can lose big
  1197. (erc-server-send (format "PONG :%s" pinger) t)
  1198. (when erc-verbose-server-ping
  1199. (erc-display-message
  1200. parsed 'error proc
  1201. 'PING ?s (erc-time-diff erc-server-last-ping-time (erc-current-time))))
  1202. (setq erc-server-last-ping-time (erc-current-time))))
  1203. (define-erc-response-handler (PONG)
  1204. "Handle pong messages." nil
  1205. (let ((time (string-to-number (erc-response.contents parsed))))
  1206. (when (> time 0)
  1207. (setq erc-server-lag (erc-time-diff time (erc-current-time)))
  1208. (when erc-verbose-server-ping
  1209. (erc-display-message
  1210. parsed 'notice proc 'PONG
  1211. ?h (car (erc-response.command-args parsed)) ?i erc-server-lag
  1212. ?s (if (/= erc-server-lag 1) "s" "")))
  1213. (erc-update-mode-line))))
  1214. (define-erc-response-handler (PRIVMSG NOTICE)
  1215. "Handle private messages, including messages in channels." nil
  1216. (let ((sender-spec (erc-response.sender parsed))
  1217. (cmd (erc-response.command parsed))
  1218. (tgt (car (erc-response.command-args parsed)))
  1219. (msg (erc-response.contents parsed)))
  1220. (if (or (erc-ignored-user-p sender-spec)
  1221. (erc-ignored-reply-p msg tgt proc))
  1222. (when erc-minibuffer-ignored
  1223. (message "Ignored %s from %s to %s" cmd sender-spec tgt))
  1224. (let* ((sndr (erc-parse-user sender-spec))
  1225. (nick (nth 0 sndr))
  1226. (login (nth 1 sndr))
  1227. (host (nth 2 sndr))
  1228. (msgp (string= cmd "PRIVMSG"))
  1229. (noticep (string= cmd "NOTICE"))
  1230. ;; S.B. downcase *both* tgt and current nick
  1231. (privp (erc-current-nick-p tgt))
  1232. s buffer
  1233. fnick)
  1234. (setf (erc-response.contents parsed) msg)
  1235. (setq buffer (erc-get-buffer (if privp nick tgt) proc))
  1236. (when buffer
  1237. (with-current-buffer buffer
  1238. ;; update the chat partner info. Add to the list if private
  1239. ;; message. We will accumulate private identities indefinitely
  1240. ;; at this point.
  1241. (erc-update-channel-member (if privp nick tgt) nick nick
  1242. privp nil nil nil nil nil host login nil nil t)
  1243. (let ((cdata (erc-get-channel-user nick)))
  1244. (setq fnick (funcall erc-format-nick-function
  1245. (car cdata) (cdr cdata))))))
  1246. (cond
  1247. ((erc-is-message-ctcp-p msg)
  1248. (setq s (if msgp
  1249. (erc-process-ctcp-query proc parsed nick login host)
  1250. (erc-process-ctcp-reply proc parsed nick login host
  1251. (match-string 1 msg)))))
  1252. (t
  1253. (setcar erc-server-last-peers nick)
  1254. (setq s (erc-format-privmessage
  1255. (or fnick nick) msg
  1256. ;; If buffer is a query buffer,
  1257. ;; format the nick as for a channel.
  1258. (and (not (and buffer
  1259. (erc-query-buffer-p buffer)
  1260. erc-format-query-as-channel-p))
  1261. privp)
  1262. msgp))))
  1263. (when s
  1264. (if (and noticep privp)
  1265. (progn
  1266. (run-hook-with-args 'erc-echo-notice-always-hook
  1267. s parsed buffer nick)
  1268. (run-hook-with-args-until-success
  1269. 'erc-echo-notice-hook s parsed buffer nick))
  1270. (erc-display-message parsed nil buffer s)))
  1271. (when (string= cmd "PRIVMSG")
  1272. (erc-auto-query proc parsed))))))
  1273. ;; FIXME: need clean way of specifying extra hooks in
  1274. ;; define-erc-response-handler.
  1275. (add-hook 'erc-server-PRIVMSG-functions 'erc-auto-query)
  1276. (define-erc-response-handler (QUIT)
  1277. "Another user has quit IRC." nil
  1278. (let ((reason (erc-response.contents parsed))
  1279. bufs)
  1280. (pcase-let ((`(,nick ,login ,host)
  1281. (erc-parse-user (erc-response.sender parsed))))
  1282. (setq bufs (erc-buffer-list-with-nick nick proc))
  1283. (erc-remove-user nick)
  1284. (setq reason (erc-wash-quit-reason reason nick login host))
  1285. (erc-display-message parsed 'notice bufs
  1286. 'QUIT ?n nick ?u login
  1287. ?h host ?r reason))))
  1288. (define-erc-response-handler (TOPIC)
  1289. "The channel topic has changed." nil
  1290. (let* ((ch (car (erc-response.command-args parsed)))
  1291. (topic (erc-trim-string (erc-response.contents parsed)))
  1292. (time (format-time-string erc-server-timestamp-format)))
  1293. (pcase-let ((`(,nick ,login ,host)
  1294. (erc-parse-user (erc-response.sender parsed))))
  1295. (erc-update-channel-member ch nick nick nil nil nil nil nil nil host login)
  1296. (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time))
  1297. (erc-display-message parsed 'notice (erc-get-buffer ch proc)
  1298. 'TOPIC ?n nick ?u login ?h host
  1299. ?c ch ?T topic))))
  1300. (define-erc-response-handler (WALLOPS)
  1301. "Display a WALLOPS message." nil
  1302. (let ((message (erc-response.contents parsed)))
  1303. (pcase-let ((`(,nick ,login ,host)
  1304. (erc-parse-user (erc-response.sender parsed))))
  1305. (erc-display-message
  1306. parsed 'notice nil
  1307. 'WALLOPS ?n nick ?m message))))
  1308. (define-erc-response-handler (001)
  1309. "Set `erc-server-current-nick' to reflect server settings and display the welcome message."
  1310. nil
  1311. (erc-set-current-nick (car (erc-response.command-args parsed)))
  1312. (erc-update-mode-line) ; needed here?
  1313. (setq erc-nick-change-attempt-count 0)
  1314. (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
  1315. (erc-display-message
  1316. parsed 'notice 'active (erc-response.contents parsed)))
  1317. (define-erc-response-handler (MOTD 002 003 371 372 374 375)
  1318. "Display the server's message of the day." nil
  1319. (erc-handle-login)
  1320. (erc-display-message
  1321. parsed 'notice (if erc-server-connected 'active proc)
  1322. (erc-response.contents parsed)))
  1323. (define-erc-response-handler (376 422)
  1324. "End of MOTD/MOTD is missing." nil
  1325. (erc-server-MOTD proc parsed)
  1326. (erc-connection-established proc parsed))
  1327. (define-erc-response-handler (004)
  1328. "Display the server's identification." nil
  1329. (pcase-let ((`(,server-name ,server-version)
  1330. (cdr (erc-response.command-args parsed))))
  1331. (setq erc-server-version server-version)
  1332. (setq erc-server-announced-name server-name)
  1333. (erc-update-mode-line-buffer (process-buffer proc))
  1334. (erc-display-message
  1335. parsed 'notice proc
  1336. 's004 ?s server-name ?v server-version
  1337. ?U (nth 3 (erc-response.command-args parsed))
  1338. ?C (nth 4 (erc-response.command-args parsed)))))
  1339. (define-erc-response-handler (005)
  1340. "Set the variable `erc-server-parameters' and display the received message.
  1341. According to RFC 2812, suggests alternate servers on the network.
  1342. Many servers, however, use this code to show which parameters they have set,
  1343. for example, the network identifier, maximum allowed topic length, whether
  1344. certain commands are accepted and more. See documentation for
  1345. `erc-server-parameters' for more information on the parameters sent.
  1346. A server may send more than one 005 message."
  1347. nil
  1348. (let ((line (mapconcat 'identity
  1349. (setf (erc-response.command-args parsed)
  1350. (cdr (erc-response.command-args parsed)))
  1351. " ")))
  1352. (while (erc-response.command-args parsed)
  1353. (let ((section (pop (erc-response.command-args parsed))))
  1354. ;; fill erc-server-parameters
  1355. (when (string-match "^\\([A-Z]+\\)\=\\(.*\\)$\\|^\\([A-Z]+\\)$"
  1356. section)
  1357. (add-to-list 'erc-server-parameters
  1358. `(,(or (match-string 1 section)
  1359. (match-string 3 section))
  1360. .
  1361. ,(match-string 2 section))))))
  1362. (erc-display-message parsed 'notice proc line)))
  1363. (define-erc-response-handler (221)
  1364. "Display the current user modes." nil
  1365. (let* ((nick (car (erc-response.command-args parsed)))
  1366. (modes (mapconcat 'identity
  1367. (cdr (erc-response.command-args parsed)) " ")))
  1368. (erc-set-modes nick modes)
  1369. (erc-display-message parsed 'notice 'active 's221 ?n nick ?m modes)))
  1370. (define-erc-response-handler (252)
  1371. "Display the number of IRC operators online." nil
  1372. (erc-display-message parsed 'notice 'active 's252
  1373. ?i (cadr (erc-response.command-args parsed))))
  1374. (define-erc-response-handler (253)
  1375. "Display the number of unknown connections." nil
  1376. (erc-display-message parsed 'notice 'active 's253
  1377. ?i (cadr (erc-response.command-args parsed))))
  1378. (define-erc-response-handler (254)
  1379. "Display the number of channels formed." nil
  1380. (erc-display-message parsed 'notice 'active 's254
  1381. ?i (cadr (erc-response.command-args parsed))))
  1382. (define-erc-response-handler (250 251 255 256 257 258 259 265 266 377 378)
  1383. "Generic display of server messages as notices.
  1384. See `erc-display-server-message'." nil
  1385. (erc-display-server-message proc parsed))
  1386. (define-erc-response-handler (275)
  1387. "Display secure connection message." nil
  1388. (pcase-let ((`(,nick ,user ,message)
  1389. (cdr (erc-response.command-args parsed))))
  1390. (erc-display-message
  1391. parsed 'notice 'active 's275
  1392. ?n nick
  1393. ?m (mapconcat 'identity (cddr (erc-response.command-args parsed))
  1394. " "))))
  1395. (define-erc-response-handler (290)
  1396. "Handle dancer-ircd CAPAB messages." nil nil)
  1397. (define-erc-response-handler (301)
  1398. "AWAY notice." nil
  1399. (erc-display-message parsed 'notice 'active 's301
  1400. ?n (cadr (erc-response.command-args parsed))
  1401. ?r (erc-response.contents parsed)))
  1402. (define-erc-response-handler (303)
  1403. "ISON reply" nil
  1404. (erc-display-message parsed 'notice 'active 's303
  1405. ?n (cadr (erc-response.command-args parsed))))
  1406. (define-erc-response-handler (305)
  1407. "Return from AWAYness." nil
  1408. (erc-process-away proc nil)
  1409. (erc-display-message parsed 'notice 'active
  1410. 's305 ?m (erc-response.contents parsed)))
  1411. (define-erc-response-handler (306)
  1412. "Set AWAYness." nil
  1413. (erc-process-away proc t)
  1414. (erc-display-message parsed 'notice 'active
  1415. 's306 ?m (erc-response.contents parsed)))
  1416. (define-erc-response-handler (307)
  1417. "Display nick-identified message." nil
  1418. (pcase-let ((`(,nick ,user ,message)
  1419. (cdr (erc-response.command-args parsed))))
  1420. (erc-display-message
  1421. parsed 'notice 'active 's307
  1422. ?n nick
  1423. ?m (mapconcat 'identity (cddr (erc-response.command-args parsed))
  1424. " "))))
  1425. (define-erc-response-handler (311 314)
  1426. "WHOIS/WHOWAS notices." nil
  1427. (let ((fname (erc-response.contents parsed))
  1428. (catalog-entry (intern (format "s%s" (erc-response.command parsed)))))
  1429. (pcase-let ((`(,nick ,user ,host)
  1430. (cdr (erc-response.command-args parsed))))
  1431. (erc-update-user-nick nick nick host nil fname user)
  1432. (erc-display-message
  1433. parsed 'notice 'active catalog-entry
  1434. ?n nick ?f fname ?u user ?h host))))
  1435. (define-erc-response-handler (312)
  1436. "Server name response in WHOIS." nil
  1437. (pcase-let ((`(,nick ,server-host)
  1438. (cdr (erc-response.command-args parsed))))
  1439. (erc-display-message
  1440. parsed 'notice 'active 's312
  1441. ?n nick ?s server-host ?c (erc-response.contents parsed))))
  1442. (define-erc-response-handler (313)
  1443. "IRC Operator response in WHOIS." nil
  1444. (erc-display-message
  1445. parsed 'notice 'active 's313
  1446. ?n (cadr (erc-response.command-args parsed))))
  1447. (define-erc-response-handler (315 318 323 369)
  1448. ;; 315 - End of WHO
  1449. ;; 318 - End of WHOIS list
  1450. ;; 323 - End of channel LIST
  1451. ;; 369 - End of WHOWAS
  1452. "End of WHO/WHOIS/LIST/WHOWAS notices." nil
  1453. (ignore proc parsed))
  1454. (define-erc-response-handler (317)
  1455. "IDLE notice." nil
  1456. (pcase-let ((`(,nick ,seconds-idle ,on-since ,time)
  1457. (cdr (erc-response.command-args parsed))))
  1458. (setq time (when on-since
  1459. (format-time-string erc-server-timestamp-format
  1460. (erc-string-to-emacs-time on-since))))
  1461. (erc-update-user-nick nick nick nil nil nil
  1462. (and time (format "on since %s" time)))
  1463. (if time
  1464. (erc-display-message
  1465. parsed 'notice 'active 's317-on-since
  1466. ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle)) ?t time)
  1467. (erc-display-message
  1468. parsed 'notice 'active 's317
  1469. ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle))))))
  1470. (define-erc-response-handler (319)
  1471. "Channel names in WHOIS response." nil
  1472. (erc-display-message
  1473. parsed 'notice 'active 's319
  1474. ?n (cadr (erc-response.command-args parsed))
  1475. ?c (erc-response.contents parsed)))
  1476. (define-erc-response-handler (320)
  1477. "Identified user in WHOIS." nil
  1478. (erc-display-message
  1479. parsed 'notice 'active 's320
  1480. ?n (cadr (erc-response.command-args parsed))))
  1481. (define-erc-response-handler (321)
  1482. "LIST header." nil
  1483. (setq erc-channel-list nil))
  1484. (defun erc-server-321-message (proc parsed)
  1485. "Display a message for the 321 event."
  1486. (erc-display-message parsed 'notice proc 's321)
  1487. nil)
  1488. (add-hook 'erc-server-321-functions 'erc-server-321-message t)
  1489. (define-erc-response-handler (322)
  1490. "LIST notice." nil
  1491. (let ((topic (erc-response.contents parsed)))
  1492. (pcase-let ((`(,channel ,num-users)
  1493. (cdr (erc-response.command-args parsed))))
  1494. (add-to-list 'erc-channel-list (list channel))
  1495. (erc-update-channel-topic channel topic))))
  1496. (defun erc-server-322-message (proc parsed)
  1497. "Display a message for the 322 event."
  1498. (let ((topic (erc-response.contents parsed)))
  1499. (pcase-let ((`(,channel ,num-users)
  1500. (cdr (erc-response.command-args parsed))))
  1501. (erc-display-message
  1502. parsed 'notice proc 's322
  1503. ?c channel ?u num-users ?t (or topic "")))))
  1504. (add-hook 'erc-server-322-functions 'erc-server-322-message t)
  1505. (define-erc-response-handler (324)
  1506. "Channel or nick modes." nil
  1507. (let ((channel (cadr (erc-response.command-args parsed)))
  1508. (modes (mapconcat 'identity (cddr (erc-response.command-args parsed))
  1509. " ")))
  1510. (erc-set-modes channel modes)
  1511. (erc-display-message
  1512. parsed 'notice (erc-get-buffer channel proc)
  1513. 's324 ?c channel ?m modes)))
  1514. (define-erc-response-handler (328)
  1515. "Channel URL (on freenode network)." nil
  1516. (let ((channel (cadr (erc-response.command-args parsed)))
  1517. (url (erc-response.contents parsed)))
  1518. (erc-display-message parsed 'notice (erc-get-buffer channel proc)
  1519. 's328 ?c channel ?u url)))
  1520. (define-erc-response-handler (329)
  1521. "Channel creation date." nil
  1522. (let ((channel (cadr (erc-response.command-args parsed)))
  1523. (time (erc-string-to-emacs-time
  1524. (nth 2 (erc-response.command-args parsed)))))
  1525. (erc-display-message
  1526. parsed 'notice (erc-get-buffer channel proc)
  1527. 's329 ?c channel ?t (format-time-string erc-server-timestamp-format
  1528. time))))
  1529. (define-erc-response-handler (330)
  1530. "Nick is authed as (on Quakenet network)." nil
  1531. ;; FIXME: I don't know what the magic numbers mean. Mummy, make
  1532. ;; the magic numbers go away.
  1533. ;; No seriously, I have no clue about the format of this command,
  1534. ;; and don't sit on Quakenet, so can't test. Originally we had:
  1535. ;; nick == (aref parsed 3)
  1536. ;; authaccount == (aref parsed 4)
  1537. ;; authmsg == (aref parsed 5)
  1538. ;; The guesses below are, well, just that. -- Lawrence 2004/05/10
  1539. (let ((nick (cadr (erc-response.command-args parsed)))
  1540. (authaccount (nth 2 (erc-response.command-args parsed)))
  1541. (authmsg (erc-response.contents parsed)))
  1542. (erc-display-message parsed 'notice 'active 's330
  1543. ?n nick ?a authmsg ?i authaccount)))
  1544. (define-erc-response-handler (331)
  1545. "No topic set for channel." nil
  1546. (let ((channel (cadr (erc-response.command-args parsed)))
  1547. (topic (erc-response.contents parsed)))
  1548. (erc-display-message parsed 'notice (erc-get-buffer channel proc)
  1549. 's331 ?c channel)))
  1550. (define-erc-response-handler (332)
  1551. "TOPIC notice." nil
  1552. (let ((channel (cadr (erc-response.command-args parsed)))
  1553. (topic (erc-response.contents parsed)))
  1554. (erc-update-channel-topic channel topic)
  1555. (erc-display-message parsed 'notice (erc-get-buffer channel proc)
  1556. 's332 ?c channel ?T topic)))
  1557. (define-erc-response-handler (333)
  1558. "Who set the topic, and when." nil
  1559. (pcase-let ((`(,channel ,nick ,time)
  1560. (cdr (erc-response.command-args parsed))))
  1561. (setq time (format-time-string erc-server-timestamp-format
  1562. (erc-string-to-emacs-time time)))
  1563. (erc-update-channel-topic channel
  1564. (format "\C-o (%s, %s)" nick time)
  1565. 'append)
  1566. (erc-display-message parsed 'notice (erc-get-buffer channel proc)
  1567. 's333 ?c channel ?n nick ?t time)))
  1568. (define-erc-response-handler (341)
  1569. "Let user know when an INVITE attempt has been sent successfully."
  1570. nil
  1571. (pcase-let ((`(,nick ,channel)
  1572. (cdr (erc-response.command-args parsed))))
  1573. (erc-display-message parsed 'notice (erc-get-buffer channel proc)
  1574. 's341 ?n nick ?c channel)))
  1575. (define-erc-response-handler (352)
  1576. "WHO notice." nil
  1577. (pcase-let ((`(,channel ,user ,host ,server ,nick ,away-flag)
  1578. (cdr (erc-response.command-args parsed))))
  1579. (let ((full-name (erc-response.contents parsed))
  1580. hopcount)
  1581. (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name)
  1582. (setq hopcount (match-string 1 full-name))
  1583. (setq full-name (match-string 2 full-name)))
  1584. (erc-update-channel-member channel nick nick nil nil nil nil nil nil host user full-name)
  1585. (erc-display-message parsed 'notice 'active 's352
  1586. ?c channel ?n nick ?a away-flag
  1587. ?u user ?h host ?f full-name))))
  1588. (define-erc-response-handler (353)
  1589. "NAMES notice." nil
  1590. (let ((channel (nth 2 (erc-response.command-args parsed)))
  1591. (users (erc-response.contents parsed)))
  1592. (erc-display-message parsed 'notice (or (erc-get-buffer channel proc)
  1593. 'active)
  1594. 's353 ?c channel ?u users)
  1595. (erc-with-buffer (channel proc)
  1596. (erc-channel-receive-names users))))
  1597. (define-erc-response-handler (366)
  1598. "End of NAMES." nil
  1599. (erc-with-buffer ((cadr (erc-response.command-args parsed)) proc)
  1600. (erc-channel-end-receiving-names)))
  1601. (define-erc-response-handler (367)
  1602. "Channel ban list entries." nil
  1603. (pcase-let ((`(,channel ,banmask ,setter ,time)
  1604. (cdr (erc-response.command-args parsed))))
  1605. ;; setter and time are not standard
  1606. (if setter
  1607. (erc-display-message parsed 'notice 'active 's367-set-by
  1608. ?c channel
  1609. ?b banmask
  1610. ?s setter
  1611. ?t (or time ""))
  1612. (erc-display-message parsed 'notice 'active 's367
  1613. ?c channel
  1614. ?b banmask))))
  1615. (define-erc-response-handler (368)
  1616. "End of channel ban list." nil
  1617. (let ((channel (cadr (erc-response.command-args parsed))))
  1618. (erc-display-message parsed 'notice 'active 's368
  1619. ?c channel)))
  1620. (define-erc-response-handler (379)
  1621. "Forwarding to another channel." nil
  1622. ;; FIXME: Yet more magic numbers in original code, I'm guessing this
  1623. ;; command takes two arguments, and doesn't have any "contents". --
  1624. ;; Lawrence 2004/05/10
  1625. (pcase-let ((`(,from ,to)
  1626. (cdr (erc-response.command-args parsed))))
  1627. (erc-display-message parsed 'notice 'active
  1628. 's379 ?c from ?f to)))
  1629. (define-erc-response-handler (391)
  1630. "Server's time string." nil
  1631. (erc-display-message
  1632. parsed 'notice 'active
  1633. 's391 ?s (cadr (erc-response.command-args parsed))
  1634. ?t (nth 2 (erc-response.command-args parsed))))
  1635. (define-erc-response-handler (401)
  1636. "No such nick/channel." nil
  1637. (let ((nick/channel (cadr (erc-response.command-args parsed))))
  1638. (when erc-whowas-on-nosuchnick
  1639. (erc-log (format "cmd: WHOWAS: %s" nick/channel))
  1640. (erc-server-send (format "WHOWAS %s 1" nick/channel)))
  1641. (erc-display-message parsed '(notice error) 'active
  1642. 's401 ?n nick/channel)))
  1643. (define-erc-response-handler (403)
  1644. "No such channel." nil
  1645. (erc-display-message parsed '(notice error) 'active
  1646. 's403 ?c (cadr (erc-response.command-args parsed))))
  1647. (define-erc-response-handler (404)
  1648. "Cannot send to channel." nil
  1649. (erc-display-message parsed '(notice error) 'active
  1650. 's404 ?c (cadr (erc-response.command-args parsed))))
  1651. (define-erc-response-handler (405)
  1652. "Can't join that many channels." nil
  1653. (erc-display-message parsed '(notice error) 'active
  1654. 's405 ?c (cadr (erc-response.command-args parsed))))
  1655. (define-erc-response-handler (406)
  1656. "No such nick." nil
  1657. (erc-display-message parsed '(notice error) 'active
  1658. 's406 ?n (cadr (erc-response.command-args parsed))))
  1659. (define-erc-response-handler (412)
  1660. "No text to send." nil
  1661. (erc-display-message parsed '(notice error) 'active 's412))
  1662. (define-erc-response-handler (421)
  1663. "Unknown command." nil
  1664. (erc-display-message parsed '(notice error) 'active 's421
  1665. ?c (cadr (erc-response.command-args parsed))))
  1666. (define-erc-response-handler (432)
  1667. "Bad nick." nil
  1668. (erc-display-message parsed '(notice error) 'active 's432
  1669. ?n (cadr (erc-response.command-args parsed))))
  1670. (define-erc-response-handler (433)
  1671. "Login-time \"nick in use\"." nil
  1672. (erc-nickname-in-use (cadr (erc-response.command-args parsed))
  1673. "already in use"))
  1674. (define-erc-response-handler (437)
  1675. "Nick temporarily unavailable (on IRCnet)." nil
  1676. (let ((nick/channel (cadr (erc-response.command-args parsed))))
  1677. (unless (erc-channel-p nick/channel)
  1678. (erc-nickname-in-use nick/channel "temporarily unavailable"))))
  1679. (define-erc-response-handler (442)
  1680. "Not on channel." nil
  1681. (erc-display-message parsed '(notice error) 'active 's442
  1682. ?c (cadr (erc-response.command-args parsed))))
  1683. (define-erc-response-handler (461)
  1684. "Not enough parameters for command." nil
  1685. (erc-display-message parsed '(notice error) 'active 's461
  1686. ?c (cadr (erc-response.command-args parsed))
  1687. ?m (erc-response.contents parsed)))
  1688. (define-erc-response-handler (465)
  1689. "You are banned from this server." nil
  1690. (setq erc-server-banned t)
  1691. ;; show the server's message, as a reason might be provided
  1692. (erc-display-error-notice
  1693. parsed
  1694. (erc-response.contents parsed)))
  1695. (define-erc-response-handler (474)
  1696. "Banned from channel errors." nil
  1697. (erc-display-message parsed '(notice error) nil
  1698. (intern (format "s%s"
  1699. (erc-response.command parsed)))
  1700. ?c (cadr (erc-response.command-args parsed))))
  1701. (define-erc-response-handler (475)
  1702. "Channel key needed." nil
  1703. (erc-display-message parsed '(notice error) nil 's475
  1704. ?c (cadr (erc-response.command-args parsed)))
  1705. (when erc-prompt-for-channel-key
  1706. (let ((channel (cadr (erc-response.command-args parsed)))
  1707. (key (read-from-minibuffer
  1708. (format "Channel %s is mode +k. Enter key (RET to cancel): "
  1709. (cadr (erc-response.command-args parsed))))))
  1710. (when (and key (> (length key) 0))
  1711. (erc-cmd-JOIN channel key)))))
  1712. (define-erc-response-handler (477)
  1713. "Channel doesn't support modes." nil
  1714. (let ((channel (cadr (erc-response.command-args parsed)))
  1715. (message (erc-response.contents parsed)))
  1716. (erc-display-message parsed 'notice (erc-get-buffer channel proc)
  1717. (format "%s: %s" channel message))))
  1718. (define-erc-response-handler (482)
  1719. "You need to be a channel operator to do that." nil
  1720. (let ((channel (cadr (erc-response.command-args parsed)))
  1721. (message (erc-response.contents parsed)))
  1722. (erc-display-message parsed '(error notice) 'active 's482
  1723. ?c channel ?m message)))
  1724. (define-erc-response-handler (671)
  1725. "Secure connection response in WHOIS." nil
  1726. (let ((nick (cadr (erc-response.command-args parsed)))
  1727. (securemsg (erc-response.contents parsed)))
  1728. (erc-display-message parsed 'notice 'active 's671
  1729. ?n nick ?a securemsg)))
  1730. (define-erc-response-handler (431 445 446 451 462 463 464 481 483 484 485
  1731. 491 501 502)
  1732. ;; 431 - No nickname given
  1733. ;; 445 - SUMMON has been disabled
  1734. ;; 446 - USERS has been disabled
  1735. ;; 451 - You have not registered
  1736. ;; 462 - Unauthorized command (already registered)
  1737. ;; 463 - Your host isn't among the privileged
  1738. ;; 464 - Password incorrect
  1739. ;; 481 - Need IRCop privileges
  1740. ;; 483 - You can't kill a server!
  1741. ;; 484 - Your connection is restricted!
  1742. ;; 485 - You're not the original channel operator
  1743. ;; 491 - No O-lines for your host
  1744. ;; 501 - Unknown MODE flag
  1745. ;; 502 - Cannot change mode for other users
  1746. "Generic display of server error messages.
  1747. See `erc-display-error-notice'." nil
  1748. (erc-display-error-notice
  1749. parsed
  1750. (intern (format "s%s" (erc-response.command parsed)))))
  1751. ;; FIXME: These are yet to be implemented, they're just stubs for now
  1752. ;; -- Lawrence 2004/05/12
  1753. ;; response numbers left here for reference
  1754. ;; (define-erc-response-handler (323 364 365 381 382 392 393 394 395
  1755. ;; 200 201 202 203 204 205 206 208 209 211 212 213
  1756. ;; 214 215 216 217 218 219 241 242 243 244 249 261
  1757. ;; 262 302 342 351 402 407 409 411 413 414 415
  1758. ;; 423 424 436 441 443 444 467 471 472 473 KILL)
  1759. ;; nil nil
  1760. ;; (ignore proc parsed))
  1761. (provide 'erc-backend)
  1762. ;;; erc-backend.el ends here
  1763. ;; Local Variables:
  1764. ;; indent-tabs-mode: nil
  1765. ;; End: