From: Taylor R Campbell Date: Wed, 29 May 2019 22:17:25 +0000 (+0000) Subject: lisppaste is dead. X-Git-Tag: mit-scheme-pucked-10.1.11~6^2~7 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d8bd5518a2839d21a565fd3d494973260272ccdb;p=mit-scheme.git lisppaste is dead. --- diff --git a/src/edwin/decls.scm b/src/edwin/decls.scm index 41415ff3c..5081cc508 100644 --- a/src/edwin/decls.scm +++ b/src/edwin/decls.scm @@ -168,7 +168,6 @@ USA. "kmacro" "lincom" "linden" - "lisppaste" "loadef" "lspcom" "malias" diff --git a/src/edwin/ed-ffi.scm b/src/edwin/ed-ffi.scm index 7aa7f8d1e..075fdfdb0 100644 --- a/src/edwin/ed-ffi.scm +++ b/src/edwin/ed-ffi.scm @@ -102,7 +102,6 @@ USA. ("kmacro" (edwin)) ("lincom" (edwin)) ("linden" (edwin lisp-indentation)) - ("lisppaste" (edwin lisppaste)) ("loadef" (edwin)) ("lspcom" (edwin)) ("macros" (edwin macros)) diff --git a/src/edwin/edwin.pkg b/src/edwin/edwin.pkg index fc73b5ec5..90ef42ceb 100644 --- a/src/edwin/edwin.pkg +++ b/src/edwin/edwin.pkg @@ -1917,54 +1917,3 @@ USA. edwin-variable$add-log-full-name edwin-variable$add-log-mailing-address edwin-variable$debian-changelog-mode-hook)) - -(define-package (edwin lisppaste) - (files "lisppaste") - (parent (edwin)) - (export (edwin) - ;; All of the lisppaste-related variables are defined in - ;; loadefs.scm in order to be available before the lisppaste - ;; library is loaded, and are therefore not listed here. - edwin-command$lisppaste-annotate-with-buffer - edwin-command$lisppaste-annotate-with-region - edwin-command$lisppaste-buffer - edwin-command$lisppaste-channels - edwin-command$lisppaste-insert-paste - edwin-command$lisppaste-insert-annotation - edwin-command$lisppaste-region - - ;; Edwin lisppaste operations - lisppaste-annotate - lisppaste-create - lisppaste-default-annotation-number - lisppaste-default-channel - lisppaste-default-nickname - lisppaste-default-number - lisppaste-insert-paste - lisppaste-list-pastes - prompt-for-lisppaste-annotation-number - maybe-prompt-for-lisppaste-channel - maybe-prompt-for-lisppaste-nickname - maybe-prompt-for-lisppaste-number - prompt-for-lisppaste-annotation-title - prompt-for-lisppaste-title - show-lisppaste - - ;; Edwin-independent RPC interface - lisppaste-entry/channel - lisppaste-entry/components - lisppaste-entry/annotations - lisppaste-entry/content - lisppaste-entry/nickname - lisppaste-entry/number - lisppaste-entry/time - lisppaste-entry/title - lisppaste-rpc ;Generic RPC interface - lisppaste:new-paste ;RPC commands - lisppaste:paste-header - lisppaste:paste-headers - lisppaste:paste-headers-by-channel - lisppaste:paste-annotation-headers - lisppaste:paste-details - lisppaste:list-channels - )) diff --git a/src/edwin/lisppaste.scm b/src/edwin/lisppaste.scm deleted file mode 100644 index 039d03813..000000000 --- a/src/edwin/lisppaste.scm +++ /dev/null @@ -1,359 +0,0 @@ -#| -*-Scheme-*- - -This code is written by Taylor R. Campbell and placed in the Public -Domain. - -|# - -;;;; Lisppaste XML-RPC Interface - -;;; For details, see -;;; -;;; - -(declare (usual-integrations)) - -(load-option 'XML) - -;;;; Paste Creation and Annotation - -(define (lisppaste-insert-paste paste-number #!optional annotation-number) - (let ((entry (lisppaste:paste-details paste-number annotation-number))) - (if (command-argument) - (show-lisppaste entry (mark->output-port (current-point))) - (insert-string (lisppaste-entry/content entry))))) - -(define-command lisppaste-insert-paste - "Insert the numbered paste at the point. -With a prefix argument, also show a header describing the paste." - "nPaste number" - lisppaste-insert-paste) - -(define-command lisppaste-insert-annotation - "Insert the annotation of the numbered paste at the point. -With a prefix argument, also show a header describing the annotation." - (lambda () - (let* ((paste-number (maybe-prompt-for-lisppaste-number #f)) - (annotation-number (prompt-for-lisppaste-annotation-number))) - (list paste-number annotation-number))) - lisppaste-insert-paste) - -(define (lisppaste-create channel nickname title content) - (message-or-pop-up (lisppaste:new-paste channel nickname title content))) - -(define-command lisppaste-buffer - "Create a new paste of the current buffer." - (lambda () - (read-lisppaste-creation-arguments)) - (lambda (channel nickname title) - (lisppaste-create channel nickname title - (buffer-string (current-buffer))))) - -(define-command lisppaste-region - "Create a new paste of the current region." - (lambda () - (cons (current-region) (read-lisppaste-creation-arguments))) - (lambda (region channel nickname title) - (lisppaste-create channel nickname title (region->string region)))) - -(define (read-lisppaste-creation-arguments) - (let ((argument (command-argument))) - (let* ((channel (maybe-prompt-for-lisppaste-channel argument)) - (nickname (maybe-prompt-for-lisppaste-nickname argument)) - (title (prompt-for-lisppaste-title))) - (list channel nickname title)))) - -(define (lisppaste-annotate number nickname title content) - (message-or-pop-up - (lisppaste:new-paste - (lisppaste-entry/channel (lisppaste:paste-header number)) - nickname - title - content - number))) - -(define-command lisppaste-annotate-with-buffer - "Annotate an existing paste with the current buffer." - (lambda () - (read-lisppaste-annotation-arguments)) - (lambda (number nickname title) - (lisppaste-annotate number nickname title - (buffer-string (current-buffer))))) - -(define-command lisppaste-annotate-with-region - "Annotate an existing paste with the region." - (lambda () - (cons (current-region) (read-lisppaste-annotation-arguments))) - (lambda (region number nickname title) - (lisppaste-annotate number nickname title - (region->string region)))) - -(define (read-lisppaste-annotation-arguments) - (let ((argument (command-argument))) - (let* ((number (maybe-prompt-for-lisppaste-number argument)) - (nickname (maybe-prompt-for-lisppaste-nickname argument)) - (title (prompt-for-lisppaste-annotation-title))) - (list number nickname title)))) - -;;;; Paste Listing - -(define-command lisppaste-channels - "List all the channels supported by lisppaste in a temporary buffer." - () - (lambda () - (call-with-output-to-temporary-buffer " *lisppaste channels*" - '(READ-ONLY SHRINK-WINDOW FLUSH-ON-SPACE) - (lambda (port) - (write-strings-densely (lisppaste:list-channels) port))))) - -(define (lisppaste-list-pastes entries) - (call-with-output-to-temporary-buffer " *lisppastes*" - '(READ-ONLY SHRINK-WINDOW FLUSH-ON-SPACE) - (lambda (port) - (for-each (lambda (entry) - (show-lisppaste entry port)) - entries)))) - -(define-command lisppaste-list-pastes - "List the headers of the last number of pastes. -With a prefix argument, list pastes starting at a certain number." - (lambda () - (read-lisppaste-listing-arguments)) - (lambda (count #!optional start-number) - (lisppaste-list-pastes - (lisppaste:paste-headers count start-number)))) - -(define-command lisppaste-list-channel-pastes - "List the headers of the last few pastes in a certain channel. -With a prefix argument, list pastes starting at a certain number." - (lambda () - (let ((channel (maybe-prompt-for-lisppaste-channel #t))) - (cons channel (read-lisppaste-listing-arguments)))) - (lambda (channel start-number #!optional count) - (lisppaste-list-pastes - (lisppaste:paste-headers-by-channel channel start-number count)))) - -(define (read-lisppaste-listing-arguments) - (let ((count (prompt-for-number "Number of pastes to list" #f))) - (cond ((command-argument) - => (lambda (argument) - (list count - (if (command-argument-multiplier-only? argument) - (prompt-for-number "Starting paste" #f) - (command-argument-numeric-value argument))))) - (else (list count))))) - -(define (show-lisppaste entry #!optional port) - (let ((port - (if (default-object? port) - (current-output-port) - (guarantee textual-output-port? port 'SHOW-LISPPASTE)))) - (receive (number time author channel title annotations content) - (lisppaste-entry/components entry) - (write-string "Paste " port) - (write number port) - (write-string " in " port) - (write-string channel port) - (write-string " by " port) - (write-string author port) - (write-string " at " port) - (write-string (decoded-time->iso8601-string time) port) - (newline port) - (write-string " " port) - (write-string title port) - (if (positive? annotations) - (begin - (newline port) - (write-string " (" port) - (write annotations port) - (write-string " annotations)" port))) - (newline port) - (newline port) - (if content (write-string content port))))) - -;;;; Argument Reading - -(define lisppaste-last-channel #f) - -(define (lisppaste-default-channel) - (or lisppaste-last-channel - (ref-variable lisppaste-default-channel))) - -(define (maybe-prompt-for-lisppaste-channel argument) - ((lambda (channel) - (set! lisppaste-last-channel channel) - channel) - (or (and (not argument) - (lisppaste-default-channel)) - (prompt-for-lazy-string-table-name - "Channel" - (lisppaste-default-channel) - (delay - (alist->string-table - (map (lambda (channel-name) - (cons channel-name #f)) - (lisppaste:list-channels)))) - 'CASE-INSENSITIVE-COMPLETION? #t)))) - -(define lisppaste-last-nickname #f) - -(define (lisppaste-default-nickname) - (or lisppaste-last-nickname - (ref-variable lisppaste-default-nickname))) - -(define (maybe-prompt-for-lisppaste-nickname argument) - ((lambda (nickname) - (set! lisppaste-last-nickname nickname) - nickname) - (or (and (not argument) - (lisppaste-default-nickname)) - (prompt-for-string "Nickname" - (lisppaste-default-nickname))))) - -(define (prompt-for-lisppaste-title) - (prompt-for-string "Title" - ;; No default string - #f)) - -(define (prompt-for-lisppaste-annotation-title) - (prompt-for-lisppaste-title)) - -(define lisppaste-last-number #f) - -(define (lisppaste-default-number) - lisppaste-last-number) - -(define (maybe-prompt-for-lisppaste-number argument) - ((lambda (number) - (set! lisppaste-last-number number) - number) - (or (and argument - (not (command-argument-multiplier-only? argument)) - (command-argument-numeric-value argument)) - (prompt-for-number "Paste number" - (lisppaste-default-number))))) - -(define lisppaste-last-annotation-number #f) - -(define (lisppaste-default-annotation-number) - lisppaste-last-annotation-number) - -(define (prompt-for-lisppaste-annotation-number) - ((lambda (number) - (set! lisppaste-last-annotation-number number) - number) - (prompt-for-number "Annotation number" - (lisppaste-default-annotation-number)))) - -;;;; Lisppaste RPC - -;;; This could be used outside of Edwin if it made no reference to the -;;; Edwin variable LISPPASTE-RPC-URI or the procedure EDITOR-ERROR. - -(define (lisppaste-rpc method-name required-arguments optional-argument) - (let ((result - (xml-rpc (ref-variable lisppaste-rpc-uri) - (lisppaste-request method-name - required-arguments - optional-argument)))) - (if (and (string? result) - (string-prefix? "Error" result)) - (editor-error result) - result))) - -(define (lisppaste-request method-name required-arguments optional-argument) - (make-xml-document (make-xml-declaration "1.0" "UTF-8" #f) - '() ;misc-1 - #f ;DTD - '() ;misc-2 - (apply xml-rpc:request method-name - (if (and (not (default-object? optional-argument)) - optional-argument) - (append required-arguments - (list optional-argument)) - required-arguments)) - '())) ;misc-3 - -(define (lisppaste:new-paste channel nickname title content - #!optional number-of-paste-to-annotate) - (lisppaste-rpc "newpaste" (list channel nickname title content) - number-of-paste-to-annotate)) - -(define (lisppaste:paste-header number) - (car (lisppaste:paste-headers 1 number))) - -(define (lisppaste:paste-headers count #!optional start-number) - (lisppaste-rpc "pasteheaders" (list count) - start-number)) - -(define (lisppaste:paste-headers-by-channel channel count - #!optional start-number) - (lisppaste-rpc "pasteheadersbychannel" (list channel count) - start-number)) - -(define (lisppaste:paste-annotation-headers paste-number) - (lisppaste-rpc "pasteannotationheaders" (list paste-number) - #f)) - -(define (lisppaste:paste-details paste-number #!optional annotation-number) - (lisppaste-rpc "pastedetails" (list paste-number) - annotation-number)) - -(define (lisppaste:list-channels) - (lisppaste-rpc "listchannels" '() #f)) - -(define (lisppaste-entry/number entry) (list-ref entry 0)) -(define (lisppaste-entry/time entry) (list-ref entry 1)) -(define (lisppaste-entry/nickname entry) (list-ref entry 2)) -(define (lisppaste-entry/channel entry) (list-ref entry 3)) -(define (lisppaste-entry/title entry) (list-ref entry 4)) -(define (lisppaste-entry/annotations entry) (list-ref entry 5)) -(define (lisppaste-entry/content entry) - (if (> (length entry) 6) - (list-ref entry 6) - #f)) - -(define (lisppaste-entry/components entry) - (values (lisppaste-entry/number entry) - (lisppaste-entry/time entry) - (lisppaste-entry/nickname entry) - (lisppaste-entry/channel entry) - (lisppaste-entry/title entry) - (lisppaste-entry/annotations entry) - (lisppaste-entry/content entry))) - -;;;; Random Utilities - -(define (prompt-for-lazy-string-table-name prompt - default-string - string-table-promise - . options) - (apply prompt-for-completed-string - prompt - default-string - (lambda (string if-unique if-not-unique if-not-found) - (string-table-complete (force string-table-promise) - string - if-unique - if-not-unique - if-not-found)) - (lambda (string) - (string-table-completions (force string-table-promise) string)) - (lambda (string) - (let ((default (list 'DEFAULT))) - (not (eq? (string-table-get (force string-table-promise) - string - (lambda (index) index default)) - default)))) - options)) - -(define (message-or-pop-up string) - (if (and (not (string-find-next-char string #\newline)) - (let ((tab-width (ref-variable tab-width #f)) - (char-image-strings (ref-variable char-image-strings #f))) - (< (string-columns string 0 tab-width char-image-strings) - (window-x-size (typein-window))))) - (message string) - (string->temporary-buffer string - " *lisppaste*" - '(READ-ONLY SHRINK-WINDOW FLUSH-ON-SPACE)))) diff --git a/src/edwin/loadef.scm b/src/edwin/loadef.scm index 52f8f2af8..52b5a0774 100644 --- a/src/edwin/loadef.scm +++ b/src/edwin/loadef.scm @@ -349,57 +349,6 @@ This is usually 103 or 2627." ;;; **************** -(define-library 'LISPPASTE - '("lisppaste" (EDWIN LISPPASTE))) - -(define-autoload-command 'lisppaste-channels 'LISPPASTE - "List all the channels supported by lisppaste in a temporary buffer.") - -(define-autoload-command 'lisppaste-insert-paste 'LISPPASTE - "Insert the numbered paste at the point. -With a prefix argument, also show a header describing the paste.") - -(define-autoload-command 'lisppaste-insert-annotation 'LISPPASTE - "Insert the annotation of the numbered paste at the point. -With a prefix argument, also show a header describing the annotation.") - -(define-autoload-command 'lisppaste-buffer 'LISPPASTE - "Create a new paste of the current buffer.") - -(define-autoload-command 'lisppaste-region 'LISPPASTE - "Create a new paste of the current region.") - -(define-autoload-command 'lisppaste-annotate-with-buffer 'LISPPASTE - "Annotate an existing paste with the current buffer.") - -(define-autoload-command 'lisppaste-annotate-with-region 'LISPPASTE - "Annotate an existing paste with the region.") - -(define-autoload-command 'lisppaste-list-pastes 'LISPPASTE - "List the headers of the last number of pastes. -With a prefix argument, list pastes starting at a certain number.") - -(define-autoload-command 'lisppaste-list-channel-pastes 'LISPPASTE - "List the headers of the last few pastes in a certain channel. -With a prefix argument, list pastes starting at a certain number.") - -(define-variable lisppaste-rpc-uri - "URI of the lisppaste XML-RPC service." - "http://common-lisp.net:8185/RPC2" - ->uri) - -(define-variable lisppaste-default-channel - "Default channel for lisppaste requests." - #f - string?) - -(define-variable lisppaste-default-nickname - "Default IRC nickname for lisppaste requests." - #f - string?) - -;;; **************** - (define-library 'PASSWORD-EDIT '("pwedit" (EDWIN PASSWORD-EDIT)) '("pwparse" (EDWIN PASSWORD-EDIT))) diff --git a/src/edwin/sources.scm b/src/edwin/sources.scm index a1643ce82..a42de59a0 100644 --- a/src/edwin/sources.scm +++ b/src/edwin/sources.scm @@ -40,7 +40,7 @@ USA. "dosshell" "ed-ffi" "editor" "edtfrm" "edtstr" "evlcom" "eystep" "filcom" "fileio" "fill" "grpops" "hlpcom" "htmlmode" "image" "info" "input" "intmod" "iserch" "javamode" "key-w32" "keymap" - "keyparse" "kilcom" "kmacro" "lincom" "linden" "lisppaste" + "keyparse" "kilcom" "kmacro" "lincom" "linden" "loadef" "lspcom" "macros" "make" "malias" "manual" "midas" "modefs" "modes" "modlin" "modwin" "motcom" "motion" "mousecom" "nntp" "notify" "nvector" "occur" "outline" "paredit" "pasmod"