;; -*- sawfish -*-
;; services.jl v1.5 -- send mouse selection to shell
;; Time-stamp: <2002/06/01 08:49:00 sfarrell>
;;
;; Copyright (C) 2000 Stephen Farrell <steve@farrell.org>
;;
;; This file 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 2, or (at your option)
;; any later version.

;;; Commentary:

;; Send mouse selection to shell program -- similar to "Services" in
;; NeXTSTEP.  The idea is as follows: Say you want to look up a word
;; in your dictionary program, but the current application doesn't
;; know about the dictionary.  Normally, this would require putting
;; the selection in the clipboard, locating and launching the
;; dictionary application, pasting the selection into the dictionary
;; (if you're using X, good luck that it's still in your PRIMARY
;; selection!), and finally telling the dictionary application to look
;; up the word.  With NeXTSTEP services, the dictionary could add a
;; global keybinding that would act on the current selection.  So
;; "Command-=" would send the current selection to Webster.app.   
;;
;; services.jl is not as elegant as the NeXT design since it requires
;; the user to set up the bindings and hook up the wiring to get the
;; selection to the desired application.  Sometimes this is trivial,
;; but sometimes it is not.  In particular, the example I give assumes
;; you have one of those handy netscape launcher scripts that check if
;; netscape is running and uses -remote if necessary.  If you don't,
;; get it... here's something that looks appropriate:
;; http://www.best.com/~lanning/released/ (on FreeBSD, it's
;; /usr/ports/www/netscape-wrapper).
;;
;; To add actions, call services-add.  The first argument is the entry
;; that will appear in the menu, the second is the format of the shell
;; command.  All instances of '#' will be replaced with the selection.
;; The final (optional) argument is some code to run on the selection
;; to clean it up before sending it to the shell.  I've defined a
;; sample function, services-clean-for-browser, which does basic URL
;; encoding, but you can insert your own function or lambda.
;;
;; Sample usage:
;;
;; put both waffle.jl and string2.jl in your load-path
;; 
;; (require 'services)
;; (services-add "Google" 
;;	      "netscape 'http://www.google.com/search?q=#'" 
;;	      services-clean-url-query-escaping)
;; (services-add "Google: I'm Feeling Lucky"  
;;	      "netscape 'http://www.google.com/search?q=#&sa=I%27m+Feeling+Lucky'"  
;;	      services-clean-url-query-escaping) 
;; (services-add "Netscape" "netscape '#'" 
;;	      services-clean-url)
;; (services-add "Dictionary" "xterm -T 'dict: #' -e dict #")
;; (services-add "Unix man" "xterm -T 'man: #' -e sh -c 'man #; read'")
;;
;; *NOTE* You must add some actions (as above) or else it won't do anything!
;;
;; Of course you'll want a keybinding to activate services.  I use C-M-SPC
;; (bind-keys global-keymap "C-M-SPC" services) or else you can use the 
;; sawfish configuration GUI to set up the keybinding.
;;
;; I've hacked up some string manipulation routines and use them as a
;; separate library... I've included them inline in this package, but
;; would be happy to contribute them to who/whatever is appropriate.
;; 

;;; Thanks: 

;; Dave Pearson <davep@davep.org>  
;; -- For code to allow actions to be functions, not strings
;; 
;; Matthew Hawkins <matthew@topic.com.au>
;; -- Who pointed out a bug with shell escaping and got me to fix url 
;;    escaping


(require 'string2)

(defvar services-action-alist nil "")
(defvar services-binding-alist nil)
(defvar services-last "?")
(defconst services-max-show 25)
(defvar services-debugging nil)

(defun services-reset ()
  "reset all state"
  (interactive)
  (setq services-binding-alist nil)
  (setq services-action-alist nil))

(defun services ()
  "pop up a menu allowing the user to chose to which action to send the current selection"
  (interactive)
  (require 'selection)
  (let ((selection (or (x-get-selection 'PRIMARY) services-last))
	(key "")
	(read-event (lambda () (throw 'read (event-name (current-event))))))
    (setq services-last selection)
    (when (grab-keyboard)
      (unwind-protect
	  (progn
	    (add-hook 'unbound-key-hook read-event)
	    (display-message (services-message selection))
	    (setq key (catch 'read (recursive-edit)))
	    (when (assoc (string-downcase key) services-action-alist)
	      (services-internal (assoc key services-action-alist)
				 selection)))
	(remove-hook 'unbound-key-hook read-event)
	(if (not services-debugging) (display-message nil))
	(ungrab-keyboard)))))


(defun services-message (selection)
  (let ((ls services-action-alist)
	(actions ""))
    (while ls
      (let ((action (car ls)))
	(setq actions (concat 
		       actions
		       (nth 1 action)
		       (if (cdr ls) "\n")))
	(setq ls (cdr ls))))
    (concat "Selection: \"" 
	    (string2-replace 
	     (string2-elipsis selection services-max-show) "\n" "\\n")
	    "\"\n\n"
	    actions)))


(defun services-infer-binding (menu)
  (let ((found nil)
	(idx -1))
    (while (and (< idx (length menu)) (not found))
      (setq idx (+ 1 idx))
      (let ((c (aref menu idx)))
	(unless (and services-binding-alist
		     (assoc (char-downcase c) services-binding-alist))
	  (setq found c))))
    (if found
	(progn
	  (setq services-binding-alist
		(append services-binding-alist
			(list (cons (char-downcase found) nil))))
	  (make-string 1 found))
      nil)))


(defun services-menu-with-binding (binding menu)
  (let ((idx (string2-index menu binding)))
    (concat (substring menu 0 idx) "[" binding "]" (substring menu (+ 1 idx)))))
      
(defun services-add (menu action &optional code)
  "Add the menu/format to the list of selections.

The parameter MENU is the string to appear in the pop-up menu.

The parameter ACTION is either a shell command to execute (all instances of
'#' are replaced with the contents of the selection) or a function that will
accept the selection as a parameter.

The optional CODE parameter cleans the selection (its only argument) before
sending to the shell"
  (let ((binding (services-infer-binding menu)))
    (if binding
	(setq services-action-alist 
	      (append services-action-alist 
		      (list (list (string-downcase binding)
				  (services-menu-with-binding binding 
                                                              menu) 
				  action
				  code)))))))

(defun services-internal (service selection)
  (let ((action (nth 2 service)))
    (if (stringp action)
        (let* ((code (nth 3 service))
	       (exe (string2-replace action "#" 
				    (services-clean-for-shell 
				     (if code (code selection) selection)))))
          (if services-debugging
              (display-message exe)
            (system (concat exe "&"))))
      (action selection))))

(defun services-clean-for-shell-noquote (str)
  "make a decent attempt to clean the command before sending it out to the command line"
  ;; XXX Be more rigorous about this... the user could really bugger himself
  (setq str (string2-replace str "\\" "\\\\"))
;;  (setq str (string2-replace str "?" "\\?"))
  (setq str (string2-replace str "&" "\\&"))
  (setq str (string2-replace str ";" "\\;"))
;;  (setq str (string2-replace str "\n" " "))
;;  (setq str (string2-replace str "\r" " "))
  (setq str (string2-replace str "\t" "\\\t"))
  (setq str (string2-replace str "'" "\\'"))
  (setq str (string2-replace str "`" "\\`"))
  (setq str (string2-replace str "\"" "\\\""))
  (setq str (string2-replace str "(" "\\("))
  (setq str (string2-replace str ")" "\\)"))
 
  (setq str (string2-replace str "<" "\\<"))
  (setq str (string2-replace str ">" "\\>"))
  (setq str (string2-replace str " " "\\ "))
  (setq str (string2-replace str "#" "\\#"))
 str)

(defun services-clean-for-shell (str)
  "escape content from clipboard so that shell interprets it literally *when* inside of double quotes"
  (setq str (string2-replace str "\\" "\\\\")) 
  (setq str (string2-replace str "$" "\\$")) 
  (setq str (string2-replace str "`" "\\`")) 
  (setq str (string2-replace str "\"" "\\\"")) 
  str)

(defun services-clean-url (str) 
  "Assume that the user has selected a URL.  Strip leading and trailing
whitespace, and replace spaces with %20 just to be safe"
  (string2-replace (string2-trim str) " " "%20"))
      
    

(defun services-clean-url-query-escaping (str)
  "Do URL escaping appropriate for components of a GET query.  Do not
do this with a full url -- if selection is a complete url then use
services-clean-url"
  ;; Uses some code by "Sen Nagata" <sen@eccosys.com>, which in turn
  ;; was a port of code by url.el from w3 package by "William
  ;; M. Perry" <wmperry@cs.indiana.edu>
  (mapconcat
   (lambda (char)
     (cond ((eq char 32)
	    "+")
	   ((or (and (>= char 65) (<= char 90)) 
		(and (>= char 97) (<= char 122)))
	    make-string 1 char)
	   ((< char 16)
	    (string-upcase (format nil "%%0%x" char)))
	   (t
	    (string-upcase (format nil "%%%x" char)))))
   str ""))

(provide 'services)