Newsgroups: comp.sys.apollo
From: anthonyb@comm.mot.com (UK478 Anthony Bowles)
Subject: Emacs 19.19 x-apollo.el update
Organization: Motorola LMPS Basingstoke
Date: Wed, 29 Sep 1993 18:10:16 GMT

I've change apollo-copy-region and apollo-cut-region to deactivate the
mark when the functions have finished copying/cutting.

This lets me use transient mark mode (which highlights a region when
there is one) without the side-affect of the highlighting remaining
after the Copy or Cut key has been pressed.

This gives a similar look and feel to Display Manager Copy and Cut.
However it still won't select to the end of the line if mark isn't set.

FYI

To enable transient mark mode place :

;; highlight marked regions
(transient-mark-mode 1)
(delete-selection-mode 1)

in your .emacs .

Below is the updated version of x-apollo.el.

If anyone could explain why C-Help doesn't work I'd appreciate it.
On my node it says 'Autoloading failed to load function insert-man-file'
within the minibuffer.

Regards,
Anthony

;;; File:  x-apollo.el
;;;
;;;		       GNU Emacs Apollo Support Functions
;;;                       for Emacs 19 in X Windows
;;;
;;;                            Kevin Gallagher
;;;
;;; This is a modified version of apollo.el, which was written by
;;; Leonard N. Zubkoff for Emacs 19.57.  It provides support for
;;; running Emacs 19 under X Windows only.  Support for the Apollo
;;; Display Manager (DM) has been dropped. 
;;;

(if (string= window-system "x")
    (progn

;;; Commands to COPY, CUT, and PASTE.

      (defun apollo-copy-region ()
	"Copy region between point and mark to kill buffer."
	(interactive)
        (setq deactivate-mark t)
	(copy-region-as-kill (mark) (point))
	(message "Region Copied"))
      
      (defun apollo-cut-region ()
	"Cut region between point and mark to kill buffer."
	(interactive)
        (setq deactivate-mark t)
	(kill-region (mark) (point))
	(message "Region Cut"))
      
      (defun apollo-paste ()
	"Copy region between point and mark to the default DM paste buffer."
	(interactive)
	(yank)
	(message "Pasted and Mark set"))
      
      
;;; Miscellaneous Commands.
      
      (defun extract-file-or-buffer-name-around-point (&optional buffer-flag)
	(let ((skip-characters (if buffer-flag
				   "!#-%*-9=?-{}~:<>"
				 "!#-%*-9=?-{}~:"))
	      (skip-at-end (if buffer-flag
			       '(?@ ?. ?, ?: ?<)
			     '(?* ?@ ?. ?, ?:))))
	  (save-excursion
	    (skip-chars-backward skip-characters)
	    (let ((start (point)))
	      (skip-chars-forward skip-characters)
	      (let* ((filename (buffer-substring start (point)))
		     (last-char (aref filename (- (length filename) 1))))
		(if (memq last-char skip-at-end)
		    (substring filename 0 -1)
		  filename))))))
      
      (defun apollo-find-file (&optional find-buffer-flag other-window)
	"Find the file or buffer whose name the cursor is over.  Buffer names are
matched only if the optional argument FIND-BUFFER-FLAG is non-NIL.  If the
optional argument OTHER-WINDOW is non-NIL, the file is displayed in the other
window.  When matching file names, ignores trailing '*' or '@' as in 'ls -F'
output."
	(interactive)
	(let* ((file-or-buffer-name
		(extract-file-or-buffer-name-around-point find-buffer-flag))
	       (buffer (and find-buffer-flag (get-buffer file-or-buffer-name))))
	  (if (or buffer (file-exists-p file-or-buffer-name))
	      (funcall (if other-window
			   'switch-to-buffer-other-window
			 'switch-to-buffer)
		       (or buffer (find-file-noselect file-or-buffer-name)))
	    (error "Cannot find %s \"%s\""
		   (if find-buffer-flag "buffer or file" "file")
		   file-or-buffer-name))))
      
      (defun apollo-again ()
	"Copy the remainder of the current line to the end of the buffer."
	(interactive)
	(set-mark-command nil)
	(end-of-line)
	(copy-region-as-kill (mark) (point))
	(end-of-buffer)
	(yank))
      
      (defun apollo-exit ()
	"Kill current buffer after saving changes."
	(interactive)
	(save-buffer)
	(kill-buffer (current-buffer)))
      
      (defun apollo-abort ()
	"Kill current buffer without saving changes."
	(interactive)
	(kill-buffer (current-buffer)))
      
      (defun apollo-aegis-help (filename)
	"Prompt for topic and find the Apollo help file."
	(interactive "sHelp on: ")
	(let ((help-file (concat "/sys/help/" filename ".hlp")))
	  (with-output-to-temp-buffer "*Help File*"
	    (buffer-flush-undo standard-output)
	    (save-excursion
	      (set-buffer standard-output)
	      (insert-man-file help-file)
	      (if (> (buffer-size) 0)
		  (progn
		    (message "Cleaning help file entry...")
		    (apollo-clean-help-file)
		    (message ""))
		(message "No help found in %s" help-file))
	      (set-buffer-modified-p nil)))))
      
;;; Make sure this will be loaded if necessary.
      
      (autoload 'insert-man-file "man")
      
      (defun apollo-clean-help-file ()
	(interactive "*")
	;; Remove underlining and overstriking by the same letter.
	(goto-char (point-min))
	(while (search-forward "\b" nil t)
	  (let ((preceding (char-after (- (point) 2)))
		(following (following-char)))
	    (cond ((= preceding following)	; x\bx
		   (delete-char -2))
		  ((= preceding ?\_)		; _\b
		   (delete-char -2))
		  ((= following ?\_)		; \b_
		   (delete-region (1- (point)) (1+ (point)))))))
	;; Remove overstriking and carriage returns before newline.
	(goto-char (point-min))
	(while (re-search-forward "\r$" nil t)
	  (replace-match ""))
	(goto-char (point-min))
	(while (re-search-forward "^.*\r" nil t)
	  (replace-match ""))
	;; Fit in 79 cols rather than 80.
	(indent-rigidly (point-min) (point-max) -1)
	;; Delete excess multiple blank lines.
	(goto-char (point-min))
	(while (re-search-forward "\n\n\n\n*" nil t)
	  (replace-match "\n\n"))
	;; Remove blank lines at the beginning.
	(goto-char (point-min))
	(skip-chars-forward "\n")
	(delete-region (point-min) (point))
	;; Separate the header from the main subject line.
	(end-of-line)
	(insert "\n")
	(goto-char (point-min)))
      
      (defun kill-whole-line ()
	"Kill the line containing point.  Try to retain column cursor is on."
	(interactive)
	(let ((old-column (current-column)))
	  (beginning-of-line)
	  (kill-line 1)
	  (move-to-column old-column)))
      
      (defun apollo-scroll-right-10 ()
	"Scroll selected window display 10 columns right."
	(interactive)
	(scroll-left 10))
      
      (defun apollo-scroll-left-10 ()
	"Scroll selected window display 10 columns left."
	(interactive)
	(scroll-right 10))
      
      (defun apollo-scroll-up-1 ()
	"Scroll selected window up one row."
	(interactive)
	(scroll-down 1))
      
      (defun apollo-scroll-down-1 ()
	"Scroll selected window up down row."
	(interactive)
	(scroll-up 1))
      
      (defun apollo-key-undefined ()
	"Signal that an Apollo Function Key is undefined."
	(interactive)
	(error "Apollo Function Key undefined"))
      
      
;;; Define and Enable the Function Key Bindings.
      
      (global-set-key [S-tab] "\C-I") ;Shift TAB
      (global-set-key [C-tab] "\C-I") ;Control TAB
      (global-set-key [S-return] "\C-M") ;Shift RET
      (global-set-key [C-return] "\C-M") ;Control RET
      (global-set-key [linedel] 'kill-whole-line) ;LINE DEL
      (global-set-key [chardel] 'delete-char) ;CHAR DEL
      (global-set-key [leftbar] 'beginning-of-line) ;LEFT BAR ARROW
      (global-set-key [rightbar] 'end-of-line) ;RIGHT BAR ARROW
      (global-set-key [leftbox] 'apollo-scroll-left-10) ;LEFT BOX ARROW
      (global-set-key [rightbox] 'apollo-scroll-right-10) ;RIGHT BOX ARROW
      (global-set-key [S-up] 'apollo-scroll-up-1) ;Shift UP ARROW
      (global-set-key [S-down] 'apollo-scroll-down-1) ;Shift DOWN ARROW
      (global-set-key [S-read] 'apollo-find-file) ;Shift READ
      (global-set-key [select] 'set-mark-command) ;MARK
      (global-set-key [S-insert] 'overwrite-mode) ;INS MODE
      (global-set-key [S-linedel] 'yank)	;Shift LINE DEL
      (global-set-key [S-chardel] 'delete-char)	;Shift CHAR DEL
      (global-set-key [copy] 'apollo-copy-region) ;COPY
      (global-set-key [S-cut] 'apollo-cut-region) ;CUT
      (global-set-key [paste] 'apollo-paste) ;PASTE
      (global-set-key [S-undo] 'undo) ;UNDO
      (global-set-key [S-left] 'backward-word) ;Shift LEFT ARROW
      (global-set-key [S-right] 'forward-word) ;Shift RIGHT ARROW
      (global-set-key [upbox] 'scroll-down) ;UP BOX ARROW
      (global-set-key [S-upbox] 'beginning-of-buffer) ;Shift UP BOX ARROW
      (global-set-key [downbox] 'scroll-up) ;DOWN BOX ARROW
      (global-set-key [S-downbox] 'end-of-buffer) ;Shift DOWN BOX ARROW
      (global-set-key [redo] 'apollo-again) ;AGAIN
      (global-set-key [S-redo] 'toggle-read-only) ;Shift AGAIN
      (global-set-key [exit] 'apollo-exit) ;EXIT
      (global-set-key [S-cancel] 'apollo-abort) ;ABORT
      (global-set-key [S-save] 'save-buffer) ;SAVE
      (global-set-key [pause] 'apollo-key-undefined) ;HOLD
      (global-set-key [S-leftbar] 'beginning-of-buffer) ;Shift LEFT BAR ARROW
      (global-set-key [cmd] 'execute-extended-command) ;CMD
      (global-set-key [S-rightbar] 'end-of-buffer) ;Shift RIGHT BAR ARROW
      (global-set-key [next] 'other-window) ;NEXT WNDW
      (global-set-key [S-next] 'delete-window) ;Shift NEXT WNDW
      (global-set-key [read] 'find-file-read-only) ;READ
      (global-set-key [edit] 'find-file) ;EDIT
      (global-set-key [S-shell] 'shell) ;SHELL
      (global-set-key [S-help] 'manual-entry) ;HELP
      (global-set-key [C-pause] 'apollo-aegis-help) ;HELP
      )
  )