From 0e31267fe4042feaf31d309dac905e33284711e1 Mon Sep 17 00:00:00 2001 From: Vaidheeswaran C Date: Tue, 22 Dec 2015 10:58:28 +0530 Subject: [PATCH] *** empty log message *** --- edictc.el | 1654 ------------------------------------------------------------- 1 file changed, 1654 deletions(-) rewrite edictc.el (100%) diff --git a/edictc.el b/edictc.el dissimilarity index 100% index de6a8a5..e69de29 100644 --- a/edictc.el +++ b/edictc.el @@ -1,1654 +0,0 @@ -;;; edictc.el --- DICT client for Emacs - -;; Author: Vaidheeswaran C -;; Keywords: - -;; This file is not part of GNU Emacs. - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;;; Code: - -;;; Dependencies - -(eval-when-compile - (require 'cl)) - -(require 'thingatpt) -(require 'tabulated-list) -(require 'outline) -(require 'easymenu) -(require 'help-mode) - -;;; Regex for parsing command responses - -(defvar edictc-ws-re - `(or " " "\t")) - -(defvar edictc-dqtext-re - `(one-or-more (not (in "\"" "\\" control)))) - -(defvar edictc-quoted-pair-re - '(and "\\" anything)) - -(defvar edictc-dqstring-re - `(and "\"" (zero-or-more (or ,edictc-dqtext-re ,edictc-quoted-pair-re)) "\"")) - -(defvar edictc-sqtext-re - `(one-or-more (not (in "'" "\\" control)))) - -(defvar edictc-sqstring-re - `(and "'" (zero-or-more (or ,edictc-dqtext-re ,edictc-quoted-pair-re)) "'")) - -(defvar edictc-atom-re - `(one-or-more (not (in " " "\t" "\"" "'" "\\")))) - -(defvar edictc-string-re - `(zero-or-more (or ,edictc-dqstring-re ,edictc-sqstring-re ,edictc-quoted-pair-re))) - -(defvar edictc-word-re - `(zero-or-more (or ,edictc-atom-re ,edictc-string-re))) - -(defvar edictc-description-re - `(zero-or-more (or ,edictc-word-re ,edictc-ws-re))) - -(defvar edictc-text-re - `(zero-or-more (or ,edictc-word-re ,edictc-ws-re))) - -(defvar edictc-status-re - '(and (group-n 1 (and (zero-or-more "0") - (in (?1 . ?9)) - (repeat 2 digit))) - (zero-or-more " ") - (group-n 2 (zero-or-more anything)))) - -(defvar edictc-msg-atom-re - '(one-or-more (not (in " " control "<" ">" "." "\\")))) - -(defvar edictc-capabilities-re - `(and "<" ,edictc-msg-atom-re (zero-or-more (and "." ,edictc-msg-atom-re)) ">")) - -(defvar edictc-local-part-re - `(and ,edictc-msg-atom-re (zero-or-more (and "." ,edictc-msg-atom-re)))) - -(defvar edictc-domain-re - `(and ,edictc-msg-atom-re (zero-or-more (and "." ,edictc-msg-atom-re)))) - -(defvar edictc-spec-re - `(and ,edictc-local-part-re "@" ,edictc-domain-re)) - -(defvar edictc-msg-id-re - `(and "<" ,edictc-spec-re ">")) - -(defvar edictc-param-text-re - `(or ,edictc-atom-re ,edictc-dqstring-re)) - -(defvar edictc-banner-re - `(and "220" - " " (group-n 1 ,edictc-text-re) - " " (group-n 2 (zero-or-one ,edictc-capabilities-re)) - " " (group-n 3 ,edictc-msg-id-re) - )) - -(defvar edictc-database-description-re - `(and (group-n 1 (or ,edictc-atom-re ,edictc-dqstring-re)) - (one-or-more " ") - (group-n 2 (or ,edictc-atom-re ,edictc-dqstring-re)))) - -(defvar edictc-strategy-description-re - `(and (group-n 1 (or ,edictc-atom-re ,edictc-dqstring-re)) - (one-or-more " ") - (group-n 2 (or ,edictc-atom-re ,edictc-dqstring-re)))) - -(defvar edictc-word-definition-re - `(and (group-n 1 (or ,edictc-atom-re ,edictc-dqstring-re)) - (one-or-more " ") - (group-n 2 (or ,edictc-atom-re ,edictc-dqstring-re)) - (one-or-more " ") - (group-n 3 (or ,edictc-atom-re ,edictc-dqstring-re)))) - -(defvar edictc-match-description-re - `(and (group-n 1 (or ,edictc-atom-re ,edictc-dqstring-re)) - (one-or-more " ") - (group-n 2 (or ,edictc-atom-re ,edictc-dqstring-re)))) - -;;; Global Constants - -(defconst edictc-port 2628) - -(defvar edictc-process-name "edictc") - -(defvar edictc-output-buffer-name "edictc") -(defvar edictc-debug-buffer-name "edictc debug") - -;;; User Customization - -(defgroup edictc nil - "Emacs DICT client." - :link '(custom-manual "(emacs)Highlight Interactively") - :group 'processes) - -(defcustom edictc-servers - `(("DICT Dev. Group" :server "dict.org" :about "http://www.dict.org/") - ("GNU Dico" :server "dicoweb.gnu.org.ua" :about "http://dicoweb.gnu.org.ua") - ("FreeDict" :server "dict.freedict.org" :about "http://freedict.org/dict") - ("localhost" :server "localhost")) - "List of DICT servers." - :type '(repeat (cons (string :tag "Dict server name") - (plist :options ((:server string) - (:port integer) - (:about string) - (:user-name string) - (:password string))))) - :group 'edictc) - -(defcustom edictc-server (caar edictc-servers) - "Default DICT Server." - :type '(choice (const :tag "None" nil) - (string :tag "DICT Server")) - :group 'edictc) - -;; "*" ; retrieve matches from ALL databases that provide a match. -;; "!" ; retrieve matches from database that provides the first match. - -(defcustom edictc-default-database "*" - "Default Database." - :type '(choice (const :tag "Retrieve from ALL databases" "*") - (const :tag "Retrieve match from the first databases" "!")) - :group 'edictc) - -(defcustom edictc-default-strategy "prefix" - "Default Match strategy." - :type '(choice (const :tag "Exact match" "exact") - (const :tag "Prefix" "prefix") - (const :tag "Server default" ".")) - :group 'edictc) - -;;; DICT protocol handling - -(defvar edictc-process nil) -(put 'edictc-process 'permanent-local t) - -(defvar edictc-process-list nil) - -(defstruct (edictc-database (:type list) :named) - handle - description) - -(defstruct (edictc-strategy (:type list) :named) - handle - description) - -;; (defstruct (edictc-connection (:type list) :named) -;; server -;; port -;; about -;; user-name -;; password - -;; process -;; process-buffer - -;; state - -;; receivef -;; filterf - -;; server-string -;; server-capabilities -;; msg-id - -;; databases -;; strategies - -;; database -;; strategy - -;; num-responses -;; responses - -;; cmdq-head -;; cmdq-tail - -;; owner-buffer - -;; output-buffer -;; debug-buffer -;; ) - -(defstruct (edictc-word-definition (:type list) :named) - word - db-handle - db-description - text) - -(defstruct (edictc-word-match (:type list) :named) - db-handle - text) - -;;;; Debugging - -(defcustom edictc-debug t - "Enable debugging" - :type '(choice (const :tag "none" nil) - (const :tag "all" t)) - :group 'edictc) - -(defun edictc-get-create-debug-buffer (ep) - (let ((buffer (process-get ep :debug-buffer))) - (unless (buffer-live-p buffer) - (setq buffer (generate-new-buffer edictc-debug-buffer-name)) - (process-put ep :debug-buffer buffer) - (with-current-buffer buffer - (setq-local edictc-process ep) - (edictc-mode))) - buffer)) - -(defun edictc--debug (ep &rest args) - (if quit-flag - (error "Interrupted!")) - (if (eq edictc-debug t) - (with-current-buffer (edictc-get-create-debug-buffer ep) - (goto-char (point-max)) - (insert - (format "%s -> %s\n" (process-name (process-get ep :process)) - (apply 'format args)))))) - -(defsubst edictc-debug (ep &rest args) - (if quit-flag - (let* ((proc (process-get ep :process))) - ;; The user hit C-g, honor it! Some things can get in an - ;; incredibly tight loop (chunked encoding) - (if proc - (progn - (set-process-sentinel proc nil) - (set-process-filter proc nil))) - (error "Transfer interrupted!"))) - (apply 'edictc--debug ep args)) - -;;; DICT Commands - -(defun edictc-send-command (ep &optional request) - (when (eq (process-get ep :state) 'READY) - (unless request - (setq request (caar (process-get ep :cmdq-head)))) - - (when request - (let* ((string (edictc-request->string request)) - (tag (edictc-request->tag request)) - (command (concat string "\r\n"))) - (process-put ep :state tag) - (message "[%s] <- %s" (process-get ep :server-nick) - string) - (edictc-debug ep "COMMAND SENT: %S" string) - (process-send-string (process-get ep :process) command))))) - -(defun edictc-queue-command (ep request &rest request-context) - (let ((r request)) - (while r - (when (stringp (car r)) - (setcar r (edictc-quote-parameter (car r)))) - (setq r (cdr r)))) - - (let* ((send-immediate nil) - (elt (cons request request-context))) - (edictc-debug ep "STATE: %s" (process-get ep :state)) - (edictc-debug ep "COMMAND QUEUED: %s, %S" - (edictc-request->string request) - request-context) - (if (derived-mode-p 'edictc-debug-mode) - ;; In debug mode, send the command immediately. - (edictc-send-command ep request) - ;; Otherwise, queue the command. - (cond - ((process-get ep :cmdq-head) - ;; There is a pending command. - (edictc-debug ep "COMMAND HEAD before ENQUEUE: %S" (process-get ep :cmdq-head)) - (edictc-debug ep "COMMAND TAIL before ENQUEUE: %S" (process-get ep :cmdq-tail)) - (process-put ep :cmdq-tail - (setcdr (process-get ep :cmdq-tail) (list elt)))) - (t - ;; This is the only outstanding command - (process-put ep :cmdq-head (list elt)) - (process-put ep :cmdq-tail - (process-get ep :cmdq-head)) - ;; Send it immediately. - (setq send-immediate t))) - (edictc-debug ep "COMMAND HEAD after ENQUEUE: %S" (process-get ep :cmdq-head)) - (edictc-debug ep "COMMAND TAIL after ENQUEUE: %S" (process-get ep :cmdq-tail)) - (edictc-debug ep "STATE: %s SEND IMMEDIATE: %s" - (process-get ep :state) send-immediate) - (when (and (eq (process-get ep :state) 'READY) send-immediate) - ;; Initial handshake is done and there is no pending command. - (edictc-send-command ep))))) - -(defun edictc-response-type (status-code) - (or (and (numberp status-code) (> status-code 99) (< status-code 600) - (assoc-default (/ status-code 100) - '((1 . positive-preliminary) - (2 . positive) - (3 . positive-intermediate) - (4 . transient-negative) - (5 . permanent-negative)))) - 'invalid)) - -(defun edictc-unqueue-command (ep) - (assert (numberp (process-get ep :state))) - (let* ((gratis-response (= (process-get ep :state) 220)) - (response-type (edictc-response-type (process-get ep :state)))) - - (when (memq response-type '(positive permanent-negative)) - ;; Ready for next command. - (process-put ep :state 'READY)) - - (when (and (null gratis-response) - (eq (process-get ep :state) 'READY)) - ;; A command is now finished. Unqueue it from the pending list. - (assert (process-get ep :cmdq-head)) - (let* ((elt (pop (process-get ep :cmdq-head))) - (last-request (car elt)) - (last-command (edictc-request->string last-request)) - (last-command-tag (edictc-request->tag last-request)) - (last-request-context (cdr elt)) - (success-callback (car last-request-context)) - (success-callback-args (cdr last-request-context))) - - (message "[%s] -> %s (%s)" (process-get ep :server-nick) - last-command - response-type) - (edictc-debug ep "COMMAND DONE: %s STAUS: %s" last-command response-type) - - (unless (process-get ep :cmdq-head) - ;; No more pending commands. - (process-put ep :cmdq-tail nil)) - - (when last-request - (edictc-debug ep "COMMAND DONE: %s STATUS: %s" last-command response-type)) - - (edictc-debug ep "COMMAND HEAD after UNQUEUE: %S" - (process-get ep :cmdq-head)) - (edictc-debug ep "COMMAND TAIL after UNQUEUE: %S" - (process-get ep :cmdq-tail)) - - (case response-type - (positive - (when success-callback - (apply success-callback ep last-request success-callback-args))) - (permanent-negative - (edictc-display-error ep last-request)) - (otherwise - (error "Don't know how to handle %s" response-type))) - ;; Clear the current responses. - (process-put ep :num-responses nil) - (process-put ep :responses nil)))) - - ;; Send over the pending command, if any - (edictc-send-command ep)) - -;;;; Interactive helpers - -(defun edictc-quote-parameter (parameter) - (cond - ((string-match (rx-to-string `(and bos ,edictc-atom-re eos)) parameter) parameter) - ((string-match (rx-to-string `(and bos ,edictc-dqstring-re eos)) parameter) parameter) - ((string-match (rx-to-string '(and bos (zero-or-one "\"") - (group-n 1 (minimal-match - (zero-or-more not-newline))) - (zero-or-one "\"") eos)) - parameter) - (let ((retval (concat "\"" (replace-regexp-in-string "\"" "\\\"" - (match-string 1 parameter) t t) - "\""))) - (prog1 retval - (assert (string-match (rx-to-string `(or ,edictc-atom-re - ,edictc-dqstring-re)) - retval))))))) - -(defun edictc-select-database (ep &optional include-wild-cards-p) - ;; "*" ; retrieve matches from ALL databases - ;; ; that provide a match. - ;; "!" ; retrieve matches from database that - ;; ; provides the first match. - (let ((db (completing-read "Use Database: " - (nconc - (and include-wild-cards-p - (list "*" "!")) - (mapcar - (lambda (entity) - (edictc-database-handle entity)) - (process-get ep :databases))) - nil t))) - db)) - -(defun edictc-select-strategy (ep) - - ;; (or "prefix" "exact") ; well-known strategies supported by all DICT - ;; ; servers - - (let ((strategy (completing-read - "Use Match Strategy: " - (nconc - (list "prefix" "exact") - (mapcar - (lambda (entity) - (edictc-strategy-handle entity)) - (process-get ep :strategies))) - nil t))) - strategy)) - -;;;; CLIENT text - -(defun edictc-command-client (&optional ep text) - "Set client string." - (interactive (list (edictc))) - (let ((text (or text "edictc"))) - (edictc-queue-command ep (list 'CLIENT text)))) - -;;;; DEFINE database word - -(defun edictc-command-define (ep word &optional database) - "Lookup WORD in DATABASE." - (interactive - (let* ((word (or (and (region-active-p) - (buffer-substring (region-beginning) (region-end))) - (word-at-point))) - (word (and word (substring-no-properties word))) - (prompt (format "Define word%s: " (if word (format " (%s)" word) ""))) - (word (read-string prompt nil nil word)) - (ep (edictc))) - (list ep word - (if current-prefix-arg - (edictc-select-database ep 'include-wild-cards) - (or (process-get ep :database) - edictc-default-database))))) - (edictc-queue-command ep (list 'DEFINE database word) - 'edictc-display-definition)) - -;;;; HELP - -(defun edictc-command-help (&optional ep) - "Show commands accepted by DICT server." - (interactive (list (edictc))) - (edictc-queue-command ep (list 'HELP) - 'edictc-display-information)) - -;;;; MATCH database strategy word - -(defun edictc-command-match (ep word &optional strategy database) - "Match WORD in DATABASE using STRATEGY." - (interactive - (let* ((default (word-at-point)) - (prompt (format "Match word%s: " (if default (format " (%s)" default) ""))) - (word (read-string prompt nil nil default)) - (ep (edictc))) - (list ep word - (if current-prefix-arg - (edictc-select-strategy ep) - (or (process-get ep :strategy) - edictc-default-strategy)) - (if current-prefix-arg - (edictc-select-database ep 'include-wild-cards) - (or (process-get ep :database) - edictc-default-database))))) - (edictc-queue-command ep (list 'MATCH database strategy word) - 'edictc-display-match )) - -;;;; OPTION - -(defun edictc-command-option (&optional ep) - (interactive (list (edictc))) - (edictc-queue-command ep (list 'OPTION))) - -;;;; QUIT - -(defun edictc-command-quit (&optional ep) - "Close connection to the DICT server." - (interactive (list (edictc))) - (edictc-queue-command ep (list 'QUIT))) - -;;;; SHOW DATABASES -(defun edictc-command-show-databases (&optional ep) - (interactive (list (edictc))) - (edictc-queue-command ep (list 'SHOW 'DATABASES) - 'edictc-display-databases - (not (called-interactively-p 'any)))) - -;;;; SHOW INFO database - -(defun edictc-command-show-info (ep database) - (interactive - (let ((ep (edictc))) - (list ep (edictc-select-database ep)))) - (edictc-queue-command ep (list 'SHOW 'INFO database) - 'edictc-display-information)) - -;;;; SHOW SERVER - -(defun edictc-command-show-server (&optional ep suppress-display) - (interactive (list (edictc) nil)) - (edictc-queue-command ep (list 'SHOW 'SERVER) - 'edictc-display-server - suppress-display)) - -;;;; SHOW STRATEGIES - -(defun edictc-command-show-strategies (&optional ep) - (interactive (list (edictc))) - (edictc-queue-command ep (list 'SHOW 'STRATEGIES) - 'edictc-display-strategies - (not (called-interactively-p 'any)))) - -;;;; STATUS - -(defun edictc-command-status (&optional ep) - "Show timing or debugging information." - (interactive (list (edictc))) - (edictc-queue-command ep (list 'STATUS) - 'edictc-display-information)) - -;;; Developer Commands - -(defun edictc-command-kill (&optional ep) - "Kill connection to the DICT server." - (interactive (list (edictc))) - (delete-process (process-get ep :process))) - -(defun edictc--devel-command-unknown-command (&optional ep) - "Trigger 500 Syntax error, command not recognized" - (interactive (list (edictc))) - (edictc-queue-command ep (list 'HELLO 'WORLD) - 'edictc-display-information)) - -(defun edictc--devel-command-invalid-database (&optional ep) - "Trigger 500 Syntax error, command not recognized" - (interactive (list (edictc))) - (edictc-command-define ep "hello" "junk-database")) - -(defun edictc--devel-command-invalid-strategy (&optional ep) - "Trigger 500 Syntax error, command not recognized" - (interactive (list (edictc))) - (edictc-command-match ep "hello" "junk-strategy" "*")) - -(defun edictc--devel-command-invalid-parameters (&optional ep) - "Trigger 500 Syntax error, command not recognized" - (interactive (list (edictc))) - (edictc-command-define ep "hello" "")) - -;;; DICT Response Handling - -(defun edictc-request->tag (request) - (intern (mapconcat (lambda (s) - (when (symbolp s) - (symbol-name s))) request ""))) - -(defun edictc-request->string (request) - (mapconcat (lambda (s) (format "%s" s)) request " ")) - -(defvar edictc-status-codes - '( - ;; 110 n databases present - text follows - (110 n-dbs-present textual-response) - ;; 111 n strategies available - text follows - (111 n-strategies-available textual-response) - ;; 112 database information follows - (112 database-info textual-response) - ;; 113 help text follows - (113 help-text textual-response) - ;; 114 server information follows - (114 server-info textual-response) - ;; 130 challenge follows - (130 challenge) - ;; 150 n definitions retrieved - definitions follow - (150 n-definitions-retrieved) - ;; 151 word database name - text follows - (151 word-db-name textual-response) - ;; 152 n matches found - text follows - (152 n-matches-found textual-response) - ;; 210 (optional timing and statistical information here) - (210 timing-and-statistical-information-here) - ;; 220 text msg-id - (220 text-msg-id) - ;; 221 Closing Connection - (221 closing-connection) - ;; 230 Authentication successful - (230 authentication-successful) - ;; 250 ok (optional timing information here) - (250 ok) - ;; 330 send response - (330 send-response) - ;; 420 Server temporarily unavailable - (420 server-temporarily-unavailable) - ;; 421 Server shutting down at operator request - (421 server-shutting-down-at-operator-request) - ;; 500 Syntax error, command not recognized - (500 syntax-error--command-not-recognized) - ;; 501 Syntax error, illegal parameters - (501 syntax-error--illegal-parameters) - ;; 502 Command not implemented - (502 command-not-implemented) - ;; 503 Command parameter not implemented - (503 command-parameter-not-implemented) - ;; 530 Access denied - (530 access-denied) - ;; 531 Access denied, use "SHOW INFO" for server information - (531 access-denied--use--show-info--for-server-info) - ;; 532 Access denied, unknown mechanism - (532 access-denied--unknown-mechanism) - ;; 550 Invalid database, use "SHOW DB" for list of databases - (550 invalid-db) - ;; 551 Invalid strategy, use "SHOW STRAT" for a list of strategies - (551 invalid-strategy) - ;; 552 No match - (552 no-match) - ;; 554 No databases present - (554 no-dbs-present) - ;; 555 No strategies available - (555 no-strategies-available))) - -(defvar edictc-in-out-states - '((START . (220 420 421)) - (READY . nil) - (DEFINE . (150)) - (150 . (151)) - (151 . (151 250)) - (MATCH . (152)) - (152 . (250)) - (SHOWDATABASES . (110)) - (110 . (250)) - (SHOWSTRATEGIES . (111)) - (111 . (250)) - (SHOWINFO . (112)) - (112 . (250)) - (SHOWSERVER . (114)) - (114 . (250)) - (CLIENT . (250)) - (STATUS . (210)) - (HELP . (113)) - (113 . (250)) - (QUIT . (221)))) - -(defun edictc-receive (ep &optional st nd length) - (unless length - (edictc-debug ep "DATA RECEIVED")) - (edictc-debug ep "DATA OUTSTANDING:\n%s<-" (buffer-substring (point-min) (point-max))) - - (goto-char (point-min)) - (when (looking-at - (rx-to-string - '(and (group-n 1 (and (group-n 2 (one-or-more digit)) - (zero-or-more " ") - (group-n 3 (minimal-match (one-or-more anything))))) - "\r\n"))) - ;; Received a status response. - (let* ((status-response (match-string 1)) - (status-code (string-to-number (match-string 2))) - (response-type (edictc-response-type status-code)) - (status-rest (match-string 3)) - (end-of-status-response (match-end 0)) - - (textual-response-codes '(110 111 112 113 114 151 152)) - (text nil)) - (edictc-debug ep "Peeking at status code: %s" status-code) - - ;; Check if status code falls in the expected range. - (when (eq response-type 'invalid) - (error "Invalid status code: %d" status-code)) - - (unless (memq response-type '(permanent-negative)) - ;; Check if the status code agrees with what we expect. - (let ((expected-status-codes - (assoc-default (process-get ep :state) edictc-in-out-states))) - (unless (memq status-code expected-status-codes) - (error - (concat - (format "Unexpected status code %d while in %s state;" - status-code (process-get ep :state)) - (format "\nExpecting one of the following status codes: %S" - expected-status-codes)))))) - - (cond - ((member status-code textual-response-codes) - (goto-char end-of-status-response) - (when (re-search-forward "\r\n\\.\r\n" nil t) - (process-put ep :state status-code) - ;; Recieved full textual response. - (setq text (replace-regexp-in-string - "\r\n" "\n" (buffer-substring end-of-status-response - (match-beginning 0)) - t t)) - ;; Erase the whole response. - (delete-region (point-min) (match-end 0)) - (edictc-debug ep "STATE: %s" (process-get ep :state)))) - (t - (delete-region (point-min) end-of-status-response) - (process-put ep :state status-code))) - - ;; Take a peek at the code. - (case status-code - ;; * 110 n databases present - text follows - (110 - (when text - (when (string-match (rx-to-string '(and bos (one-or-more digit))) status-rest) - (process-put ep :num-responses - (string-to-number (match-string 0 status-rest)))) - - (let ((dbs (split-string text "\n"))) - (process-put ep :responses - (mapcar - (lambda (db) ; database description - (if (string-match (rx-to-string edictc-database-description-re) db) - (make-edictc-database - :handle (match-string 1 db) - :description (match-string 2 db)) - (error "Unable to parse database list: %s" db))) - dbs))) - ;; Start processing rest of text. - (edictc-receive ep))) - ;; * 111 n strategies available - text follows - (111 - (when text - (when (string-match (rx-to-string '(and bos (one-or-more digit))) status-rest) - (process-put ep :num-responses - (string-to-number (match-string 0 status-rest)))) - - (let ((strategies (split-string text "\n"))) - (process-put ep :responses - (mapcar - (lambda (strategy) ; strategy description - (if (string-match (rx-to-string edictc-strategy-description-re) strategy) - (make-edictc-strategy - :handle (match-string 1 strategy) - :description (match-string 2 strategy)) - (error "Unable to parse database list: %s" strategy))) - strategies))) - (edictc-receive ep))) - ;; 112 database information follows - (112 - (when text - (process-put ep :responses (cons status-rest text)) - (edictc-receive ep))) - ;; 113 help text follows - (113 - (when text - (process-put ep :responses (cons status-rest text)) - (edictc-receive ep))) - ;; 114 server information follows - (114 - (when text - (process-put ep :responses (cons status-rest text)) - (edictc-receive ep))) - ;; 130 challenge follows - (130 - - ) - ;; * 150 n definitions retrieved - definitions follow - (150 - (when (string-match (rx-to-string '(and bos (one-or-more digit))) status-rest) - (process-put ep :num-responses - (string-to-number (match-string 0 status-rest)))) - (edictc-receive ep)) - ;; * 151 word database name - text follows - (151 - (when text - (let (word database name) - (when (string-match (rx-to-string edictc-word-definition-re) status-rest) - (setq word (match-string 1 status-rest)) - (setq database (match-string 2 status-rest)) - (setq name (match-string 3 status-rest))) - - (let ((word-definition - (make-edictc-word-definition - :word word :db-handle database :db-description name - :text text))) - (push word-definition (process-get ep :responses)))) - (edictc-receive ep))) - ;; * 152 n matches found - text follows - (152 - (when text - (when (string-match (rx-to-string '(and bos (one-or-more digit))) status-rest) - (process-put ep :num-responses - (string-to-number (match-string 0 status-rest)))) - (let* ((matches (split-string text "\n")) - (matches-list - (mapcar - (lambda (match) ; database word - (if (string-match (rx-to-string edictc-match-description-re) match) - (make-edictc-word-match - :db-handle (match-string 1 match) - :text (match-string 2 match)) - (error "Unable to parse match list: %s" match))) - matches))) - (process-put ep :responses matches-list)) - (edictc-receive ep))) - ;; 210 (optional timing and statistical information here) - (210 - (process-put ep :responses status-rest) - (edictc-unqueue-command ep) - (process-put ep :num-responses nil) - (process-put ep :responses nil)) - ;; * 220 text msg-id - (220 - (when (string-match (rx-to-string edictc-banner-re) status-response) - (process-put ep :server-string - (match-string 1 status-response)) - (process-put ep :server-capabilities - (match-string 2 status-response)) - (process-put ep :msg-id - (match-string 3 status-response))) - (edictc-debug ep "EDICTC ACTIVE") - (edictc-unqueue-command ep)) - ;; 221 Closing Connection - (221 - - ) - ;; 230 Authentication successful - (230 - - ) - ;; 250 ok (optional timing information here) - (250 - (edictc-unqueue-command ep)) - ;; 330 send response - (330 - - ) - ;; 420 Server temporarily unavailable - (420 - - ) - ;; 421 Server shutting down at operator request - (421 - - ) - ;; 500 Syntax error, command not recognized - ;; 501 Syntax error, illegal parameters - ;; 502 Command not implemented - ;; 503 Command parameter not implemented - ;; 530 Access denied - ;; 531 Access denied, use "SHOW INFO" for server information - ;; 532 Access denied, unknown mechanism - ;; 550 Invalid database, use "SHOW DB" for list of databases - ;; 551 Invalid strategy, use "SHOW STRAT" for a list of strategies - ;; 552 No match - ;; 554 No databases present - ;; 555 No strategies available - ((500 501 501 501 502 503 530 531 532 550 551 552 554 555) - (process-put ep :responses status-rest) - (edictc-unqueue-command ep)) - (otherwise - (error "Received unknown status response: %s" status-response)))))) - -(defun edictc-process-filter (proc data) - ;; (edictc-debug ep "FILTER RECEIVED: %s" data) - (let* ((ep proc) - (buffer (process-get ep :process-buffer))) - (assert ep) - (when buffer - ;; (display-buffer buffer) - (with-current-buffer (process-buffer proc) - (let* ((start (point-max)) - (inhibit-read-only t)) - ;; Append received data in to process buffer. - (goto-char (point-max)) - (insert data) - ;; Hand over the data for protocol processing, when not in - ;; debug mode. - (unless (derived-mode-p 'edictc-debug-mode) - (let* ((end (point-max)) - (length (length data))) - (assert (not (zerop length))) - (funcall (process-get ep :receivef) ep start end length)))))))) - -(defun edictc-cleanup (ep why) - (let* ((process-buffer (process-get ep :process-buffer)) - (output-buffer (process-get ep :output-buffer)) - (debug-buffer (process-get ep :debug-buffer)) - (owner-buffer (process-get ep :owner-buffer))) - - (when (eq edictc-process ep) - (setq edictc-process nil)) - - (with-current-buffer debug-buffer - (setq-local edictc-process nil)) - - (with-current-buffer output-buffer - (setq-local edictc-process nil)) - - (cond - (owner-buffer - (message "[%s] CONNECTION RESET" (process-get ep :server-nick)) - - (with-current-buffer owner-buffer - (kill-local-variable 'edictc-process))) - (t - (message "[%s] QUIT, %s" (process-get ep :server-nick) why) - (set-default 'edictc-process nil))) - - (with-current-buffer debug-buffer - (setq edictc-process nil)) - - ;; FIXME: Remove it from connection list. - - (when process-buffer - (kill-buffer process-buffer)) - - ;; (when output-buffer - ;; (kill-buffer output-buffer)) - - (if (get-buffer-window-list output-buffer) - (when (y-or-n-p (format "DICT buffer %s is orphaned. Kill it?" output-buffer)) - (kill-buffer output-buffer)) - (kill-buffer output-buffer)) - - (when debug-buffer - (let ((debug-output (with-current-buffer debug-buffer - (prog1 (buffer-string) - (kill-buffer (current-buffer)))))) - ;; (with-current-buffer-window (get-buffer-create "*debug*") nil nil - ;; (erase-buffer) - ;; (insert debug-output)) - )))) - -(defun edictc-process-sentinel (ep why) - (edictc-debug ep "edictc-process-sentinel in buffer (%s). REASON %s" - (process-buffer ep) why) - (let ((why (format "[%s: %s]" (process-status ep) why))) - (case (process-status ep) - ;; Kill => closed: deleted. - ;; Quit => closed: connection broken by remote peer. - (closed - (edictc-cleanup ep why)) - (otherwise - (error "FIXME: Don't know how to handle process-status %s" why))))) - -(defun edictc () - (if edictc-process edictc-process - (edictc-connect edictc-server))) - -(defun edictc-connect (&optional server-nick type) - (interactive (list edictc-server)) - - (assert (memq type '(nil this-buffer-only orphan))) - (setq server-nick (or server-nick edictc-server)) - - (when edictc-process - (when (and (memq type '(orphan this-buffer-only)) - (local-variable-p 'edictc-process)) - (user-error (concat - "Refusing to start another local connection.\n" - "First, shutdown the existing connection."))) - - (when (and (null type) (default-value 'edictc-process)) - (user-error (concat - "Refusing to start another default connection.\n" - "First shutdown the existing connection or\n" - "Start a connection specific to this buffer.")))) - - (let* ((server-settings (assoc server-nick edictc-servers)) - (server-plist (cdr server-settings)) - (host (plist-get server-plist :server)) - (port (or (plist-get server-plist :port) edictc-port)) - (ep (open-network-stream edictc-process-name nil host port)) - (buffer (generate-new-buffer - (format " *%s %s:%d*" edictc-process-name host port)))) - (if (not ep) - ;; Failed to open the connection for some reason - (progn - (kill-buffer buffer) - (setq buffer nil) - (error "Could not create connection to %s:%d" host port)) - (set-process-plist ep - (append - (list :server-nick server-nick) - server-plist - (list - :state 'START - :process ep - :database (or (plist-get server-plist :database) - edictc-default-database) - :strategy (or (plist-get server-plist :strategy) - edictc-default-strategy) - :process-buffer buffer - :receivef 'edictc-receive))) - - (with-current-buffer buffer - (setq mode-line-format "%b [%s]") - (setq-local edictc-process ep) - (edictc-mode)) - - (with-current-buffer (edictc-get-create-output-buffer ep) - (erase-buffer)) - - (with-current-buffer (edictc-get-create-debug-buffer ep) - (erase-buffer)) - - (case type - (orphan - (process-put ep :owner-buffer - (process-get ep :output-buffer))) - (this-buffer-only - (setq-local edictc-process ep) - (process-put ep :owner-buffer (current-buffer))) - (otherwise - (setq edictc-process ep) - (process-put ep :owner-buffer nil))) - - ;; (edictc-debug-mode) - - (push ep edictc-process-list) - - (set-process-buffer ep buffer) - (set-process-filter ep 'edictc-process-filter) - (set-process-coding-system ep 'utf-8-unix 'utf-8-unix) - (pcase (process-status ep) - (`connect - ;; Asynchronous connection - (set-process-sentinel ep 'edictc-async-sentinel)) - (`failed - ;; Asynchronous connection failed - (error "Could not create connection to %s:%d" host port)) - (_ - (message "Connected to %s:%s" host port) - (set-process-sentinel ep - 'edictc-process-sentinel) - ;; (process-send-string connection (edictc-create-request)) - )) - ;; Queue some commands. - (edictc-command-client ep) - (edictc-command-show-databases ep) - (edictc-command-show-strategies ep) - (edictc-command-show-server ep)) - ep)) - -(defvar edictc-mode-map - (let ((map (copy-keymap special-mode-map))) - (define-key map "h" 'edictc-command-show-server) - (define-key map "d" 'edictc-command-show-databases) - (define-key map "s" 'edictc-command-show-strategies) - (define-key map "c" 'edictc-command-help) - (define-key map "q" 'edictc-command-quit) - (define-key map "i" 'edictc-command-show-info) - map) - "Local keymap for `tabulated-list-mode' buffers.") - -(defvar-local edictc-mode-line nil) - -(defun edictc-describe-process-or-nick (ep-or-nick &optional for) - (cond - ((processp ep-or-nick) - (case for - (mode-line - (format "%s (%s--%s) {%d Dbs/%d Strats}" - (process-get ep-or-nick :server-nick) - (process-get ep-or-nick :database) - (process-get ep-or-nick :strategy) - (length (process-get ep-or-nick :databases)) - (length (process-get ep-or-nick :strategies)))) - (menubar - (format "%s (%s--%s) [Active %s]" - (process-get edictc-process :server-nick) - (process-get edictc-process :database) - (process-get edictc-process :strategy) - (if (local-variable-p 'edictc-process) - "locally" - "globally"))) - (otherwise - (user-error "This should not happen")))) - ((stringp ep-or-nick) - (let ((server-plist (assoc-default ep-or-nick edictc-servers))) - (format "%s (%s--%s)" - ep-or-nick - (or (plist-get server-plist :database) - edictc-default-database) - (or (plist-get server-plist :strategy) - edictc-default-strategy)))) - (t nil))) - -(define-minor-mode edictc-mode - "Edictc Mode" - :lighter (" " edictc-mode-line) - (setq edictc-mode-line - (edictc-describe-process-or-nick edictc-process 'mode-line))) - -(defvar edictc-debug-mode-map edictc-mode-map) - -(define-derived-mode edictc-debug-mode edictc-mode "DICTC Debug" - "Control buffer for interacting with DICT servers. -Use it to interact with DICT server as via telnet." - - ) - -;;; Display Results - -;;;; Display Helpers - -(defun edictc-get-create-output-buffer (ep) - (if (null ep) - (generate-new-buffer edictc-output-buffer-name) - (let ((buffer (process-get ep :output-buffer))) - (unless (buffer-live-p buffer) - (setq buffer (generate-new-buffer edictc-output-buffer-name)) - (process-put ep :output-buffer buffer) - (with-current-buffer buffer - (setq-local edictc-process ep) - (edictc-mode))) - buffer))) - -(defmacro edictc-display-text (ep &rest body) - (declare (indent 1) (debug t)) - `(with-current-buffer (edictc-get-create-output-buffer ep) - (erase-buffer) - (progn - ,@body) - (edictc-mode) - (goto-char (point-min)) - (display-buffer (current-buffer)))) - -(defun edictc-normalize-text (text &optional indent) - ;; Delete trailing whitespace - (setq text (replace-regexp-in-string - (rx-to-string '(and (one-or-more blank) eol)) "" text t t)) - - ;; Replace 2 or more newlines with just 2 newlines - (setq text (replace-regexp-in-string - (rx-to-string '(>= 2 "\n")) "\n\n" text t t)) - - ;; No leading or trailing newlines - (setq text (replace-regexp-in-string - (rx-to-string '(or (and bos (one-or-more "\n")) - (and (one-or-more "\n") eos))) "" text t t)) - - ;; Optionally indent the text. - (when indent - (let ((leading-space (make-string indent (string-to-char " ")))) - (setq text (replace-regexp-in-string - (rx-to-string '(and bol (group-n 1 nonl))) - (concat leading-space "\\1") text t)))) - - ;; Return normalized text. - text) - -;;;; DEFINE database word - -(defun edictc-display-definition (ep request) - (edictc-display-text ep - (outline-mode) - (let* ((word-definitions (process-get ep :responses)) - ;; (list 'DEFINE database word) - (database (nth 1 request)) - (word (nth 2 request))) - (cond - (word-definitions - (message "Displaying all %d definitions for %s" (length word-definitions) word) - (insert (format "* Definition for %s\n\n" word)) - (insert (mapconcat - (lambda (definition) - (format "** Definition for %s from %s\n\n%s" - (edictc-word-definition-word definition) - (edictc-word-definition-db-description definition) - (edictc-normalize-text - (edictc-word-definition-text definition) 1))) - word-definitions "\n\n"))) - (t (edictc-display-information ep request)))))) - -;;;; MATCH database strategy word - -(defun edictc-display-match (ep request) - (edictc-display-text ep - (outline-mode) - (let* ((word-matches (process-get ep :responses)) - ;; (list 'MATCH database strategy word) - (database (nth 1 request)) - (strategy (nth 2 request)) - (word (nth 3 request))) - (cond - (word-matches - (message "Displaying all %d matches for %s" (length word-matches) word) - (insert (format "* Match for %s\n\n" word)) - (insert (mapconcat - (lambda (match) - (format "** Match for %s from %s\n\n%s" - word - (edictc-word-match-db-handle match) - (edictc-normalize-text (edictc-word-match-text match) 1))) - word-matches "\n\n"))) - (t (insert (format "No matches found for %s" word))))))) - -;;; Interactive functions - -;;;; Buttons - -(define-button-type 'edictc-browse-server - :supertype 'help-xref - 'help-function (lambda (server-nick) - (let ((ep (edictc-connect server-nick 'orphan))) - (lambda (ep) (edictc-command-show-server ep nil)))) - ;; 'help-echo (purecopy "mouse-2, RET: customize variable") - ) - -(define-button-type 'edictc-help-server - :supertype 'help-xref - 'help-function (lambda (ep) - (edictc-command-show-server ep nil)) - ;; 'help-echo (purecopy "mouse-2, RET: customize variable") - ) - -(define-button-type 'edictc-help-server-commands - :supertype 'help-xref - 'help-function (lambda (ep) - (edictc-command-help ep)) - ;; 'help-echo (purecopy "mouse-2, RET: customize variable") - ) - -(define-button-type 'edictc-help-server-status - :supertype 'help-xref - 'help-function (lambda (ep) - (edictc-command-status ep)) - ;; 'help-echo (purecopy "mouse-2, RET: customize variable") - ) - -(define-button-type 'edictc-help-databases - :supertype 'help-xref - 'help-function (lambda (ep) - (call-interactively 'edictc-command-show-databases)) - ;; 'help-echo (purecopy "mouse-2, RET: customize variable") - ) - -(define-button-type 'edictc-help-strategies - :supertype 'help-xref - 'help-function (lambda (ep) - (call-interactively 'edictc-command-show-strategies)) - ;; 'help-echo (purecopy "mouse-2, RET: customize variable") - ) - -(define-button-type 'edictc-help-database - :supertype 'help-xref - 'help-function (lambda (ep database) - (edictc-command-show-info ep database)) - ;; 'help-echo (purecopy "mouse-2, RET: customize variable") - ) - -;;;; SHOW DATABASES - -(defvar edictc-databases-menu-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Font Family"))) - (set-keymap-parent map tabulated-list-mode-map) - (define-key map "\C-m" 'edictc-databases-menu-set-default-database) - map) - "Local keymap for `font-family-menu-mode' buffers.") - -(define-derived-mode edictc-databases-menu-mode tabulated-list-mode "DICT" - (edictc-mode) - (setq tabulated-list-format - `[("Database" 30 t) - ("Text" 30 t)]) - (setq tabulated-list-padding 2) - (setq tabulated-list-sort-key (cons "Database" nil)) - (setq tabulated-list-use-header-line nil) - (setq header-line-format - (make-text-button "Show Server" nil 'type 'edictc-help-server - 'help-args (list (edictc)))) - (add-hook 'tabulated-list-revert-hook 'edictc-databases-menu--refresh nil t) - (edictc-databases-menu--refresh) - (tabulated-list-init-header) - (tabulated-list-print)) - -(defun edictc-menu-show-database (&optional button) - (interactive) - (let* (;; (context (list tabulated-list-sort-key (point) (window-start))) - (ep (button-get button 'ep)) - (database-handle (button-get button 'database-handle))) - (edictc-command-show-info ep database-handle))) - -(defun edictc-databases-menu--refresh () - (setq tabulated-list-entries - (let* ((ep (edictc))) - (mapcar - (lambda (entity) - (list (edictc-database-handle entity) - (vector - (list (edictc-database-handle entity) - 'type 'edictc-help-database - 'help-args (list ep (edictc-database-handle entity))) - (edictc-database-description entity)))) - (process-get ep :databases))))) - -(defun edictc-display-databases (ep request &optional suppress-display) - (interactive) - - (unless (process-get ep :databases) - (process-put ep :databases - (process-get ep :responses)) - (with-current-buffer (edictc-get-create-output-buffer ep) - ;; Update `edictc-mode-line' - (edictc-mode))) - - (unless suppress-display - (with-current-buffer (edictc-get-create-output-buffer ep) - (edictc-databases-menu-mode) - (pop-to-buffer (current-buffer))))) - -;;;; Selecting a Database - -(defun edictc-database-set-default-database (ep database-handle) - (let ((current-database (or (process-get ep :database) - edictc-default-database))) - (when (y-or-n-p (format "Switch Database from %s to %s?" - current-database database-handle)) - (message "Database set to %s" database-handle) - (process-put ep :database database-handle) - ;; Update mode line. - (edictc-mode)))) - -;;;; SHOW INFO database & Other commands - -(defun edictc-display-information (ep request) - (edictc-display-text ep - (setq header-line-format - (make-text-button "Databases" nil 'type - 'edictc-help-databases 'help-args (list ep))) - (let* ((response (process-get ep :responses))) - (cond - ((stringp response) - (insert (edictc-normalize-text response))) - ((consp response) - (insert (format "* %s\n\n%s" - (propertize (capitalize (car response)) 'face 'bold) - (edictc-normalize-text (cdr response) 1)))) - (t (insert "This should not happen")))))) - -(defun edictc-display-error (ep request) - (edictc-display-text ep - (let* ((response (process-get ep :responses))) - (cond - ((stringp response) - (insert (edictc-normalize-text response))) - ((consp response) - (insert (format "* %s\n\n%s" - (propertize (capitalize (car response)) 'face 'bold) - (edictc-normalize-text (cdr response) 1)))) - (t (insert "This should not happen")))))) - -;;;; SHOW SERVER - -(defun edictc-display-server (ep request suppress-display) - (unless suppress-display - (edictc-display-text ep - (let* ((response (process-get ep :responses))) - (when (stringp response) - (setq response (cons "Server Information" response))) - (setq header-line-format - (concat - (make-text-button "Databases" nil 'type - 'edictc-help-databases 'help-args (list ep)) - (propertize " " 'display `(space :align-to 20)) - (make-text-button "Match Strategies" nil 'type - 'edictc-help-strategies 'help-args (list ep)) - - (when edictc-debug - (concat - (propertize " " 'display `(space :align-to 40)) - (make-text-button "Server Commands" nil 'type - 'edictc-help-server-commands 'help-args (list ep)))) - - (when edictc-debug - (concat - (propertize " " 'display `(space :align-to 60)) - (make-text-button "Server Status" nil 'type - 'edictc-help-server-status 'help-args (list ep)))))) - - (insert "\n") - (insert (propertize (capitalize (car response)) 'face 'bold) "\n\n") - (insert (cdr response)))))) - -;;;; SHOW STRATEGIES - -(defvar edictc-strategies-menu-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Font Family"))) - (set-keymap-parent map tabulated-list-mode-map) - (define-key map "\C-m" 'edictc-strategies-menu-set-default-strategy) - map) - "Local keymap for `font-family-menu-mode' buffers.") - -(define-derived-mode edictc-strategies-menu-mode tabulated-list-mode "DICT Strategies" - (edictc-mode) - (setq tabulated-list-format - `[("Strategy" 30 t) - ("Text" 30 t)]) - (setq tabulated-list-padding 2) - (setq tabulated-list-sort-key (cons "Strategy" nil)) - (add-hook 'tabulated-list-revert-hook 'edictc-strategies-menu--refresh nil t) - (setq tabulated-list-use-header-line nil) - (setq header-line-format - (make-text-button "Show Server" nil 'type 'edictc-help-server - 'help-args (list (edictc)))) - (edictc-strategies-menu--refresh) - (tabulated-list-init-header) - (tabulated-list-print)) - -(defun edictc-strategies-menu--refresh () - (setq tabulated-list-entries - (let* ((ep (edictc))) - (mapcar - (lambda (entity) - (list (edictc-strategy-handle entity) - (vector (edictc-strategy-handle entity) - (edictc-strategy-description entity)))) - (process-get ep :strategies))))) - -(defun edictc-display-strategies (ep request &optional suppress-display) - (interactive) - - (unless (process-get ep :strategies) - (process-put ep :strategies - (process-get ep :responses)) - ;; Update `edictc-mode-line' - (with-current-buffer (edictc-get-create-output-buffer ep) - (edictc-mode))) - - (unless suppress-display - (with-current-buffer (edictc-get-create-output-buffer ep) - (edictc-strategies-menu-mode) - (pop-to-buffer (current-buffer))))) - -(defun edictc-databases-menu-set-default-database () - (interactive) - (when (derived-mode-p 'edictc-databases-menu-mode) - (let ((database-handle (tabulated-list-get-id))) - (edictc-database-set-default-database (edictc) database-handle)))) - -;;;; Selecting a Strategy - -(defun edictc-strategies-menu-set-default-strategy () - (interactive) - (when (derived-mode-p 'edictc-strategies-menu-mode) - (let ((strategy-handle (tabulated-list-get-id))) - (when (and strategy-handle - (y-or-n-p (concat "Set match strategy to " strategy-handle))) - (message "Match strategy set to %s" strategy-handle) - (process-put (edictc) :strategy strategy-handle) - ;; Update mode line. - (edictc-mode))))) - -;;;; SHOW SERVERS - -(defvar edictc-servers-menu-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Font Family"))) - (set-keymap-parent map tabulated-list-mode-map) - (define-key map "\C-m" 'edictc-servers-menu-set-default-server) - map) - "Local keymap for `font-family-menu-mode' buffers.") - -(define-derived-mode edictc-servers-menu-mode tabulated-list-mode "DICT Servers" - (setq tabulated-list-format - `[("Name" 20 t) - ("DICT Host" 30) - ("About" 30)]) - (setq tabulated-list-padding 2) - (setq tabulated-list-sort-key (cons "Name" nil)) - (add-hook 'tabulated-list-revert-hook 'edictc-servers-menu--refresh nil t) - (edictc-servers-menu--refresh) - (tabulated-list-init-header) - (tabulated-list-print)) - -(defun edictc-servers-menu--refresh () - (setq tabulated-list-entries - (mapcar - (lambda (server) - (list (car server) - (vector (list (car server) - 'type 'edictc-browse-server - 'help-args (list (car server))) - (or (plist-get (cdr server) :server) "Unknown") - (or (plist-get (cdr server) :about) "Unknown")))) - edictc-servers))) - -(put 'edictc-display-servers 'disabled t) -(defun edictc-display-servers (&optional suppress-display) - (interactive) - (unless suppress-display - (with-current-buffer (edictc-get-create-output-buffer nil) - (edictc-servers-menu-mode) - (pop-to-buffer (current-buffer))))) - -;;;; Selecting a Server - -(defun edictc-servers-menu-set-default-server () - (interactive) - (when (derived-mode-p 'edictc-servers-menu-mode) - (let ((server-nick (tabulated-list-get-id))) - (when (and server-nick - (y-or-n-p (concat "Set match server to " server-nick))) - (customize-save-variable 'edictc-server server-nick) - (message "Match server set to %s" server-nick))))) - -;;;; Easy Menu - -(easy-menu-define edictc-menu edictc-mode "Dictionary menu" - `("Dict" - ["Define word" edictc-command-define t] - ["Match word" edictc-command-match t] - ["--" nil :visible edictc-process] - ["About Server" edictc-command-show-server :visible edictc-process] - ["Available Databases" edictc-command-show-databases :visible edictc-process] - ["Available Strategies" edictc-command-show-strategies :visible edictc-process] - ["Server Status" edictc-command-status :visible (and edictc-debug edictc-process)] - ["Server Commands" edictc-command-help :visible edictc-process] - ["About a Database" edictc-command-show-info :visible (and edictc-debug edictc-process)] - ["Shutdown" edictc-command-quit :visible edictc-process] - ["Save Session Options" - (lambda nil - (interactive) - (let* ((default-settings (assoc (process-get edictc-process :server-nick) - edictc-servers))) - (unless (string= (process-get edictc-process :database) - (plist-get (cdr default-settings) :database)) - (plist-put (cdr default-settings) :database - (process-get edictc-process :database))) - (unless (string= (process-get edictc-process :strategy) - (plist-get (cdr default-settings) :strategy)) - (plist-put (cdr default-settings) :strategy - (process-get edictc-process :strategy))) - (customize-save-variable 'edictc-servers edictc-servers) - (edictc-update-menu))) - :visible (let ((default-settings (assoc (process-get edictc-process :server-nick) - edictc-servers))) - (not (and (string= (process-get edictc-process :database) - (plist-get (cdr default-settings) :database)) - (string= (process-get edictc-process :strategy) - (plist-get (cdr default-settings) :strategy)))))] - ["Kill" edictc-command-kill :visible (and edictc-debug edictc-process)] - ["--" nil :visible (or (null edictc-process) - (null (default-value 'edictc-process)) - (null (local-variable-p 'edictc-process)))] - ["Start" edictc-connect :visible (null (default-value 'edictc-process))] - ["Start for this buffer" (lambda nil - (interactive) - (edictc-connect nil 'this-buffer-only)) - :visible (null (local-variable-p 'edictc-process))] - "--" - ("Select DICT Server") - ("Save Option") - ["--" nil :visible edictc-debug] - ("Developer Commands" :visible edictc-debug - "--" - ["EDICTC Dashboard" edictc-display-servers t] - ["Client string" edictc-command-client t] - ["Option" edictc-command-option t] - ["Show Debug" (lambda (ep) - (interactive (list edictc-process)) - (if ep - (pop-to-buffer (process-get ep :debug-buffer)) - (user-error "No running instance of edictc"))) - t] - ["Trigger Unknown Command" edictc--devel-command-unknown-command t] - ["Trigger Invalid Database" edictc--devel-command-invalid-database t] - ["Trigger Invalid Strategy" edictc--devel-command-invalid-strategy t] - ["Trigger Invalid Parameters" edictc--devel-command-invalid-parameters t] - ))) - -(easy-menu-add-item menu-bar-tools-menu nil edictc-menu "Spell checking") - -(add-hook 'menu-bar-update-hook 'edictc-update-menu) - -(defun edictc-update-menu () - (easy-menu-define edictc-servers-menu nil "DICT Server menu" - (cons "Select DICT Server" - (mapcar (lambda (server) - (vector (edictc-describe-process-or-nick (car server)) - (list (lambda (server-nick) - (customize-save-variable - 'edictc-server server-nick)) - (car server)) - :style 'radio - :selected `(string= ,(car server) - edictc-server))) - edictc-servers))) - - (easy-menu-add-item edictc-menu nil edictc-servers-menu) - - (easy-menu-add-item - edictc-menu nil - (vector "Active Server" nil - :enable nil - :label (when edictc-process - (edictc-describe-process-or-nick edictc-process 'menubar))) - - "About Server") - - (easy-menu-add-item - edictc-menu nil - (vector "Default Server" nil - :enable nil - :visible (or (null edictc-process) - (null (default-value 'edictc-process)) - (null (local-variable-p 'edictc-process))) - :label (edictc-describe-process-or-nick edictc-server)) - "Start")) - -(edictc-update-menu) - -;;; Global Bindings - -(define-key esc-map "#" 'edictc-command-define) -(define-key esc-map "*" 'edictc-command-match) - -(provide 'edictc) - -;;; edictc.el ends here -- 2.11.4.GIT